2021-12-22 04:17:31 +03:00
|
|
|
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 ->
|
|
|
|
{
|
2021-12-22 04:17:31 +03:00
|
|
|
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
|
2022-03-09 16:07:52 +03:00
|
|
|
(\position ->
|
|
|
|
when Dict.get model.costs position is
|
|
|
|
Err _ ->
|
|
|
|
Err {}
|
2021-12-22 04:17:31 +03:00
|
|
|
|
2022-03-09 16:07:52 +03:00
|
|
|
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
|
|
|
|
|> Num.toFloat
|
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
|
2021-02-15 23:34:55 +03:00
|
|
|
|
2021-02-19 19:07:27 +03:00
|
|
|
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
|
2021-12-22 04:17:31 +03:00
|
|
|
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
|
|
|
|
2021-10-06 23:57:11 +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
|
|
|
}
|
|
|
|
|
2021-10-06 23:57:11 +03:00
|
|
|
walker : Model position, position -> Model position
|
|
|
|
walker = \amodel, n -> updateCost current n amodel
|
|
|
|
|
2021-02-14 20:44:44 +03:00
|
|
|
modelWithCosts =
|
2021-10-06 23:57:11 +03:00
|
|
|
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
|
|
|
|
2021-08-25 23:06:43 +03:00
|
|
|
# takeStep = \moveFn, _goal, model, current ->
|
|
|
|
# modelPopped =
|
|
|
|
# { model &
|
|
|
|
# openSet: Set.remove model.openSet current,
|
|
|
|
# evaluated: Set.insert model.evaluated current,
|
|
|
|
# }
|
2021-10-06 23:57:11 +03:00
|
|
|
#
|
2021-08-25 23:06:43 +03:00
|
|
|
# neighbors = moveFn current
|
2021-10-06 23:57:11 +03:00
|
|
|
#
|
2021-08-25 23:06:43 +03:00
|
|
|
# newNeighbors = Set.difference neighbors modelPopped.evaluated
|
2021-10-06 23:57:11 +03:00
|
|
|
#
|
2021-08-25 23:06:43 +03:00
|
|
|
# modelWithNeighbors = { modelPopped & openSet: Set.union modelPopped.openSet newNeighbors }
|
2021-10-06 23:57:11 +03:00
|
|
|
#
|
2021-08-25 23:06:43 +03:00
|
|
|
# # a lot goes wrong here
|
|
|
|
# modelWithCosts =
|
2021-10-06 23:57:11 +03:00
|
|
|
# Set.walk newNeighbors modelWithNeighbors (\n, m -> updateCost current n m)
|
|
|
|
#
|
2021-08-25 23:06:43 +03:00
|
|
|
# modelWithCosts
|