# 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). Jul 28, 2019 at 22:27