5
\$\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())

                    // 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())

    [<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\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.