roc/examples/benchmarks/AStar.roc

128 lines
3.8 KiB
Plaintext
Raw Normal View History

interface AStar exposes [findPath, Model, initialModel, cheapestOpen, reconstructPath] imports [Quicksort]
2021-02-14 20:44:44 +03:00
2021-02-19 19:07:27 +03:00
findPath = \costFn, moveFn, start, end ->
2021-02-15 23:34:55 +03:00
astar costFn moveFn end (initialModel start)
2021-02-14 20:44:44 +03:00
Model position :
{
evaluated : Set position,
openSet : Set position,
costs : Dict position F64,
2021-12-22 04:17:31 +03:00
cameFrom : Dict position position,
2021-02-14 20:44:44 +03:00
}
initialModel : position -> Model position
initialModel = \start -> {
evaluated: Set.empty,
openSet: Set.single start,
costs: Dict.single start 0,
cameFrom: Dict.empty,
}
2021-02-14 20:44:44 +03:00
cheapestOpen : (position -> F64), Model position -> Result position {}
cheapestOpen = \costFn, model ->
model.openSet
|> Set.toList
2021-12-22 04:17:31 +03:00
|> List.keepOks
(\position ->
when Dict.get model.costs position is
Err _ ->
Err {}
Ok cost ->
Ok { cost: cost + costFn position, position }
)
2021-02-15 23:34:55 +03:00
|> Quicksort.sortBy .cost
2021-02-14 20:44:44 +03:00
|> List.first
|> Result.map .position
2021-02-15 03:49:25 +03:00
|> Result.mapErr (\_ -> {})
2021-02-14 20:44:44 +03:00
reconstructPath : Dict position position, position -> List position
reconstructPath = \cameFrom, goal ->
when Dict.get cameFrom goal is
Err _ ->
[]
Ok next ->
List.append (reconstructPath cameFrom next) goal
updateCost : position, position, Model position -> Model position
updateCost = \current, neighbor, model ->
2021-02-19 19:07:27 +03:00
newCameFrom =
Dict.insert model.cameFrom neighbor current
2021-02-14 20:44:44 +03:00
2021-02-19 19:07:27 +03:00
newCosts =
Dict.insert model.costs neighbor distanceTo
2021-02-15 23:34:55 +03:00
2021-02-19 19:07:27 +03:00
distanceTo =
reconstructPath newCameFrom neighbor
|> List.len
2022-05-08 20:42:12 +03:00
|> Num.toFrac
2021-02-15 23:34:55 +03:00
2021-02-19 19:07:27 +03:00
newModel =
{ model &
costs: newCosts,
2021-12-22 04:17:31 +03:00
cameFrom: newCameFrom,
2021-02-19 19:07:27 +03:00
}
2021-02-15 23:34:55 +03:00
2021-02-19 19:07:27 +03:00
when Dict.get model.costs neighbor is
Err _ ->
newModel
Ok previousDistance ->
2021-02-14 20:44:44 +03:00
if distanceTo < previousDistance then
newModel
else
model
astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {}
astar = \costFn, moveFn, goal, model ->
when cheapestOpen (\source -> costFn source goal) model is
Err {} ->
2021-02-14 20:44:44 +03:00
Err {}
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,
}
neighbors =
moveFn current
newNeighbors =
2021-02-15 23:34:55 +03:00
Set.difference neighbors modelPopped.evaluated
2021-02-14 20:44:44 +03:00
modelWithNeighbors : Model position
2021-02-14 20:44:44 +03:00
modelWithNeighbors =
{ modelPopped &
2021-12-22 04:17:31 +03:00
openSet: Set.union modelPopped.openSet newNeighbors,
2021-02-14 20:44:44 +03:00
}
walker : Model position, position -> Model position
walker = \amodel, n -> updateCost current n amodel
2021-02-14 20:44:44 +03:00
modelWithCosts =
Set.walk newNeighbors modelWithNeighbors walker
2021-02-14 20:44:44 +03:00
astar costFn moveFn goal modelWithCosts
2021-02-19 19:07:27 +03:00
# takeStep = \moveFn, _goal, model, current ->
# modelPopped =
# { model &
# openSet: Set.remove model.openSet current,
# evaluated: Set.insert model.evaluated current,
# }
#
# neighbors = moveFn current
#
# newNeighbors = Set.difference neighbors modelPopped.evaluated
#
# modelWithNeighbors = { modelPopped & openSet: Set.union modelPopped.openSet newNeighbors }
#
# # a lot goes wrong here
# modelWithCosts =
# Set.walk newNeighbors modelWithNeighbors (\n, m -> updateCost current n m)
#
# modelWithCosts