add AStar test

This commit is contained in:
Folkert 2020-03-06 13:28:02 +01:00
parent 4d061bd932
commit b9b2f70673
2 changed files with 131 additions and 0 deletions

View file

@ -240,6 +240,26 @@ mod test_load {
});
}
#[test]
fn load_astar() {
test_async(async {
let subs_by_module = MutMap::default();
let loaded_module = load_fixture("interface_with_deps", "AStar", subs_by_module).await;
expect_types(
loaded_module,
hashmap! {
"findPath" => "{ costFunction : (position, position -> Float), end : position, moveFunction : (position -> Set position), start : position } -> Result (List position) [ KeyNotFound ]*",
"initialModel" => "position -> Model position",
"reconstructPath" => "Map position position, position -> List position",
"updateCost" => "position, position, Model position -> Model position",
"cheapestOpen" => "(position -> Float), Model position -> Result position [ KeyNotFound ]*",
"astar" => "(position, position -> Float), (position -> Set position), position, Model position -> [ Err [ KeyNotFound ]*, Ok (List position) ]*",
},
);
});
}
#[test]
fn load_principal_types() {
test_async(async {

View file

@ -0,0 +1,111 @@
interface AStar
exposes [ initialModel, reconstructPath, updateCost, cheapestOpen, astar, findPath ]
imports []
# a port of https://github.com/krisajenkins/elm-astar/blob/2.1.3/src/AStar/Generalised.elm
Model xyz :
{ evaluated : Set xyz
, openSet : Set xyz
, costs : Map.Map xyz Float
, cameFrom : Map.Map xyz xyz
}
initialModel : position -> Model position
initialModel = \start ->
{ evaluated : Set.empty
, openSet : Set.singleton start
, costs : Map.singleton start 0.0
, cameFrom : Map.empty
}
cheapestOpen : (position -> Float), Model position -> Result position [ KeyNotFound ]*
cheapestOpen = \costFunction, model ->
folder = \position, resSmallestSoFar ->
when Map.get model.costs position is
Err e ->
Err e
Ok cost ->
positionCost = costFunction position
when resSmallestSoFar is
Err _ -> Ok { position, cost: cost + positionCost }
Ok smallestSoFar ->
if positionCost + cost < smallestSoFar.cost then
Ok { position, cost: cost + positionCost }
else
Ok smallestSoFar
Set.foldl model.openSet folder (Err KeyNotFound)
|> Result.map (\x -> x.position)
reconstructPath : Map position position, position -> List position
reconstructPath = \cameFrom, goal ->
when Map.get cameFrom goal is
Err KeyNotFound ->
[]
Ok next ->
List.push (reconstructPath cameFrom next) goal
updateCost : position, position, Model position -> Model position
updateCost = \current, neighbour, model ->
newCameFrom = Map.insert model.cameFrom neighbour current
newCosts = Map.insert model.costs neighbour distanceTo
distanceTo = reconstructPath newCameFrom neighbour
|> List.length
|> Num.toFloat
newModel = { model & costs : newCosts , cameFrom : newCameFrom }
when Map.get model.costs neighbour is
Err KeyNotFound ->
newModel
Ok previousDistance ->
if distanceTo < previousDistance then
newModel
else
model
findPath : { costFunction: (position, position -> Float), moveFunction: (position -> Set position), start : position, end : position } -> Result (List position) [ KeyNotFound ]*
findPath = \{ costFunction, moveFunction, start, end } ->
astar costFunction moveFunction end (initialModel start)
astar : (position, position -> Float), (position -> Set position), position, Model position -> [ Err [ KeyNotFound ]*, Ok (List position) ]*
astar = \costFn, moveFn, goal, model ->
when cheapestOpen (\position -> costFn goal position) model is
Err _ ->
Err KeyNotFound
Ok current ->
if current == goal then
Ok (reconstructPath model.cameFrom goal)
else
modelPopped = { model & openSet : Set.remove model.openSet current, evaluated : Set.insert model.evaluated current }
neighbours = moveFn current
newNeighbours = Set.diff neighbours modelPopped.evaluated
modelWithNeighbours = { modelPopped & openSet : Set.union modelPopped.openSet newNeighbours }
modelWithCosts = Set.foldl newNeighbours (\nb, md -> updateCost current nb md) modelWithNeighbours
astar costFn moveFn goal modelWithCosts