diff --git a/compiler/tests/test_load.rs b/compiler/tests/test_load.rs index 7aadc884d8..386c599aa1 100644 --- a/compiler/tests/test_load.rs +++ b/compiler/tests/test_load.rs @@ -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 { diff --git a/tests/fixtures/build/interface_with_deps/AStar.roc b/tests/fixtures/build/interface_with_deps/AStar.roc new file mode 100644 index 0000000000..c48c171844 --- /dev/null +++ b/tests/fixtures/build/interface_with_deps/AStar.roc @@ -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 +