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
AStarAlgorithmFS
doesn't provide theINode
parameter forStateChangedEventArgs
(which is necessary for other parts of the code to function correctly). \$\endgroup\$