7
\$\begingroup\$

Inspired by this post I looked up A* on wikipedia and went on with my own implementation as seen below where I try to mimic the pseudocode on Wikipedia but in a recursive manner.

I would like any comment on functional style, recursion, workflow, event handler etc. My idea is to maintain the current state of progress in a state object that is passed as argument to, replaced and then returned by each recursion.

The code seems to work although it finds a slightly different path than an iterative C#-version. The interfaces INode, IGraph and IAlgorithm are shown in C#-code at the bottom:

namespace FSAlgorithms
open System
open GraphViewerContracts

// A record type holding the current state through the 
// recursive calls of the algorithm
type State = {
    openSet: INode list;
    gScore: (INode * float) list;
    fScore: (INode * float) list;
    currentNode: INode;
    cameFrom: (INode * INode) list;
    }    

type AStarAlgorithmFS() = 
    let mutable m_doContinue = true // The one and only mutable variable that makes it possible to cancel the process
    let name = "A* F#"
    let stateChanged = Event<EventHandler<StateChangedEventArgs>, StateChangedEventArgs>()

    // The actual A* algorithm implementation
    // Note that closedSet is replaced by setting the type of visited nodes to NodeType.Visited
    let run (graph: IGraph) (this: AStarAlgorithmFS) = 
        m_doContinue <- true
        let heuristicCostEstimate (node: INode) target = 
            node.DistanceTo target

        // Backtracks the visited nodes to find the shortest path from them
        let reconstructPath cameFrom currentNode = 
            let rec loop (node: INode) =
                node.Type <- NodeType.Path
                let next = cameFrom |> List.tryFind (fun (k, v) -> k = node)
                match next with
                | Some n -> loop (snd n)
                | None -> ignore
            loop currentNode

        // Extracting the score for a node in a INode * float list
        let getScore node scoreList = 
            scoreList |> List.find (fun (n, s) -> n = node) |> snd

        // Creates the current state from the input arguments
        let createState currentNode neighbor tentativeGScore openSet state = 
            {
                openSet = openSet;
                gScore = (neighbor, tentativeGScore) :: state.gScore;
                fScore = (neighbor, tentativeGScore + (heuristicCostEstimate neighbor graph.TargetNode)) :: state.fScore;
                currentNode = currentNode;
                cameFrom = (neighbor, currentNode) :: (state.cameFrom |> List.where (fun (k, v) -> k <> neighbor))
            }

        // Handles the neighbors for the current node
        // This function is equivalent to the inner foreach neighbor of the pseudocode
        let handleNeighbors currentNode state = 

            // Recursively handles each neighbor
            let rec handleNeighbor neighbors st = 
                if neighbors |> List.length = 0 then
                    st
                else
                    let neighbor = neighbors |> List.head
                    let tentativeGScore = (getScore currentNode st.gScore) + (currentNode.DistanceTo neighbor)
                    if not (st.openSet |> List.contains neighbor) then
                        handleNeighbor (neighbors |> List.tail) (createState currentNode neighbor tentativeGScore (neighbor :: st.openSet) st)
                    elif tentativeGScore >= getScore neighbor st.gScore then
                        handleNeighbor (neighbors |> List.tail) st
                    else
                        handleNeighbor (neighbors |> List.tail) (createState currentNode neighbor tentativeGScore st.openSet st)

            handleNeighbor (graph.GetNeighbors currentNode |> Array.where (fun n -> n.IsValidNeighbor) |> Array.toList) state


        // This is equivalent to the outer while loop in the pseudocode
        let rec handleNode state =
            // If the openSet is empty we're done
            if state.openSet |> List.length = 0 || not m_doContinue then
                state
            else
                // Finds the current node from the fScore list
                let currentNode = state.fScore
                                  |> List.where (fun (n, s) -> state.openSet |> List.contains(n))
                                  |> List.sortBy (fun (n, s) -> s)
                                  |> List.head
                                  |> fst
                // If the target node is found then the path is also found
                if currentNode = graph.TargetNode then 
                    state
                else
                    // Current node is marked as visited (substitutes the need for closedSet in the pseudocode)
                    currentNode.Type <- NodeType.Visited
                    // trigger StateChanged event
                    stateChanged.Trigger (this, new StateChangedEventArgs(currentNode))

                    // A new state is created here because the current node must be removed from state.openSet 
                    let newState = {
                        openSet = state.openSet |> List.where (fun n -> n <> currentNode);
                        gScore = state.gScore;
                        fScore = state.fScore;
                        currentNode = state.currentNode;
                        cameFrom = state.cameFrom;
                    }

                    // Recursively handle the next node in fScore/openSet
                    handleNode (handleNeighbors currentNode newState)


        // The initial state
        let seedState = {
            openSet = [ graph.StartNode ];
            gScore = [ (graph.StartNode, 0.0) ];
            fScore = [ (graph.StartNode, heuristicCostEstimate graph.StartNode graph.TargetNode) ];
            currentNode = graph.StartNode;
            cameFrom = [];
        }

        // Starting the process
        let finalState = handleNode seedState
        reconstructPath finalState.cameFrom graph.TargetNode |> ignore
        stateChanged.Trigger (this, new StateChangedEventArgs(graph.StartNode))

    [<CLIEvent>]
    member this.StateChanged = stateChanged.Publish
    // This is necessary to make the name show up in the UI-list of alogrithms
    member val Name = name with get

    // Implementation of the interface IAlgorithm
    interface IAlgorithm with 
        member val Name = name with get
        // The input IGraph object is always a rectangular grid where 
        // neighbor nodes are nodes one step away in any direction including "diagonals"
        member this.Run (graph: IGraph) = run graph this

        member this.Stop() = 
            m_doContinue <- false

        member this.add_StateChanged(handler) = this.StateChanged.AddHandler(handler)
        member this.remove_StateChanged(handler) = this.StateChanged.RemoveHandler(handler)

C# interfaces:

using System;

namespace GraphViewerContracts
{
  public interface IAlgorithm
  {
    string Name { get; }

    void Run(IGraph graph);
    void Stop();
    event EventHandler<StateChangedEventArgs> StateChanged;
  }

 public class StateChangedEventArgs : EventArgs
  {
    public StateChangedEventArgs(INode node)
    {
      Node = node;
    }

    public INode Node { get; private set; }
  }

      public interface IGraph
      {
        INode[,] Nodes { get; }

        int Width { get; set; }
        int Height { get; set; }

        INode StartNode { get; }

    INode TargetNode { get; }

    void Reset();

    INode[] GetNeighbors(INode node);
  }

  public interface INode
  {
    int X { get; }
    int Y { get; }
    bool IsObstacle { get; }
    bool IsVisited { get; }
    bool IsPath { get; }
    bool IsNormal { get; }
    bool IsFixed { get; }
    bool IsValidNeighbor { get; }

    NodeType Type { get; set; }

    double DistanceTo(INode target);
    bool IsNeighborTo(INode node);
  }

  public enum NodeType
  {
    None = 0,
    Normal = 1,
    Obstacle = 2,
    Start = 3,
    Target = 4,
    Path = 5,
    Visited = 6
  }

}

INode Implementation:

module NodeModule
    open GraphViewerContracts

    type Node(x: int, y: int, nodeType: NodeType) =
        let mutable m_nodeType = nodeType

        let isFixed() = 
            match m_nodeType with
            | NodeType.Obstacle | NodeType.Start | NodeType.Target -> true
            | _ -> false
        let isObstacle() = 
            match m_nodeType with
            | NodeType.Obstacle -> true
            | _ -> false
        let isVisited() = 
            match m_nodeType with
            | NodeType.Visited -> true
            | _ -> false
        let isPath() = 
            match m_nodeType with
            | NodeType.Path -> true
            | _ -> false
        let isNormal() =
            match m_nodeType with
            | NodeType.Normal -> true
            | _ -> false
        let isValidNeighbor() = 
            match m_nodeType with
            | NodeType.Normal | NodeType.Target -> true
            | _ -> false

        let distanceTo (target: INode) = 
            sqrt(float(x - target.X)**2.0 + float(y - target.Y)**2.0)

        let isNeighborTo (node: INode) = 
            let dx = abs (x - node.X)
            let dy = abs (y - node.Y)
            dx <= 1 && dy <= 1

        interface INode with
            member val X = x with get
            member val Y = y with get
            member this.IsObstacle with get() = isObstacle()
            member this.IsVisited with get() = isVisited()
            member this.IsPath with get() = isPath()
            member this.IsNormal with get() = isNormal() 
            member this.IsFixed with get() = isFixed() 
            member this.IsValidNeighbor with get() = isValidNeighbor() 

            member this.Type 
                with get() = m_nodeType
                and set(newType) = if not (this :> INode).IsFixed then 
                                     m_nodeType <- newType 

            member this.DistanceTo(target) = distanceTo target
            member this.IsNeighborTo(node) = isNeighborTo node

IGraph Implementation:

module GraphModule
    open System
    open GraphViewerContracts
    open NodeModule

    type Graph(nodes: INode array, startNode: INode, targetNode: INode, width: int, height: int) =

        let nodes2d = Array2D.init height width 
                          (fun row col -> nodes.[width * row + col])

        let reset() = 0 |> ignore

        let getNeighbors(node: INode) = 
            nodes |> Array.where (fun n -> n.IsNeighborTo(node))

        interface IGraph with
            member val Nodes =  nodes2d with get //nodes with get
            member val Width = width with get, set
            member val Height = height with get, set
            member val StartNode = startNode with get
            member val TargetNode = targetNode with get

            member this.Reset() = reset()

            member this.GetNeighbors(node: INode) = getNeighbors(node)



    let createGraph(width: int, height: int, graphNo: int) : IGraph =
        let rand = 
            match graphNo with
            | -1 -> new Random()
            | _ -> new Random(graphNo)

        let getNodeType() =
            let rnd = rand.Next(0, 101)
            if rnd > 15 then
                NodeType.Normal
            else
                NodeType.Obstacle

        let nodes : INode array = 
            [| for y in 1..height do
                    for x in 1..width do
                        yield Node(x-1, y-1, getNodeType()) :> INode |]

        let startNode = nodes |> Array.find (fun n -> n.IsNormal)
        let targetNode = Array.FindLast(nodes, fun n -> n.IsNormal)

        startNode.Type <- NodeType.Start
        targetNode.Type <- NodeType.Target

        new Graph(nodes, startNode, targetNode, width, height) :> IGraph

Client Test App:

open System
open FSAlgorithms
open GraphViewerContracts
open GraphModule
open NodeModule

let getColor (node: INode) = 
    match node.Type with
    | NodeType.None -> ConsoleColor.Black
    | NodeType.Normal -> ConsoleColor.Black
    | NodeType.Obstacle -> ConsoleColor.White
    | NodeType.Start -> ConsoleColor.Red
    | NodeType.Target -> ConsoleColor.Green
    | NodeType.Path -> ConsoleColor.Blue
    | NodeType.Visited -> ConsoleColor.Yellow
    | _ -> ConsoleColor.Gray

let drawGraph (graph: IGraph) =
    for y in 0..graph.Height-1 do
        for x in 0..graph.Width-1 do
            let node = graph.Nodes.[x, y]
            Console.BackgroundColor <- getColor node
            printf "%c" ' '
            Console.BackgroundColor <- ConsoleColor.Black
        printfn ""

let updateNode (node: INode) =
    Console.CursorLeft <- node.Y
    Console.CursorTop <- node.X
    Console.BackgroundColor <- getColor node
    printf "%c" ' '
    Console.BackgroundColor <- ConsoleColor.Black

[<EntryPoint>]
let main argv = 
    let size = 30
    Console.WindowHeight <- size + 5

    let graph = createGraph(size, size, -1)
    let aStar = new AStarAlgorithmFS() :> IAlgorithm

    drawGraph graph
    printfn "\nPress Enter to run algorithm.."
    Console.ReadLine() |> ignore

    let stateChanged = new EventHandler<StateChangedEventArgs>(fun sender e  -> updateNode e.Node)

    aStar.StateChanged.AddHandler(stateChanged)
    aStar.Run(graph)

    Console.ReadLine() |> ignore

    printfn "END"
    0
\$\endgroup\$
3
  • \$\begingroup\$ Note that this code doesn't compile, because AStarAlgorithmFS doesn't provide the INode parameter for StateChangedEventArgs (which is necessary for other parts of the code to function correctly). \$\endgroup\$ Jul 28, 2019 at 22:27
  • \$\begingroup\$ @VisualMelon: It's a long time ago and the post is somewhat outdated (but should of course work any way) - it's not how I would implement that algorithm today. I've made an update now, and my local version compiles on my computer. If that doesn't help, and you still want to review, then wait - and I will make a proper review to make it work later to day. \$\endgroup\$
    – user73941
    Jul 29, 2019 at 4:52
  • \$\begingroup\$ Sorry to dredge something so old! I doubt I'll actually get around to writing a review in the near future, since I'll probably be busy during the actual working week and will inevitably forgot thereafter, so don't go to any length on my account (though perhaps it will find someone else's attention). \$\endgroup\$ Jul 29, 2019 at 10:19

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.