# A* Algorithm in F#

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)
|> 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.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.."

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


• 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). – VisualMelon Jul 28 at 22:27