2021-02-14 20:44:44 +03:00
|
|
|
app "astar"
|
|
|
|
packages { base: "platform" }
|
|
|
|
imports [base.Task]
|
|
|
|
provides [ main ] to base
|
|
|
|
|
2021-02-15 03:49:25 +03:00
|
|
|
# astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {}
|
|
|
|
|
|
|
|
fromList : List a -> Set a
|
|
|
|
fromList = \list -> List.walk list (\x, a -> Set.insert a x) Set.empty
|
|
|
|
|
2021-02-14 20:44:44 +03:00
|
|
|
main : Task.Task {} []
|
|
|
|
main =
|
2021-02-15 03:49:25 +03:00
|
|
|
|
|
|
|
step = \n ->
|
|
|
|
when n is
|
|
|
|
1 -> fromList [ 2, 3 ]
|
|
|
|
2 -> fromList [ 4 ]
|
|
|
|
3 -> fromList [ 4 ]
|
|
|
|
4 -> fromList []
|
|
|
|
_ -> fromList []
|
|
|
|
|
|
|
|
cost = \_, _ -> 1
|
|
|
|
|
|
|
|
when astar cost step 4 (initialModel 1) is
|
|
|
|
Ok _path ->
|
|
|
|
Task.putLine "yay"
|
|
|
|
Err _ ->
|
|
|
|
Task.putLine "nay"
|
2021-02-14 20:44:44 +03:00
|
|
|
|
|
|
|
Model position :
|
|
|
|
{
|
|
|
|
evaluated : Set position,
|
|
|
|
openSet : Set position,
|
|
|
|
costs : Dict position F64,
|
|
|
|
cameFrom : Dict position position
|
|
|
|
}
|
|
|
|
|
|
|
|
initialModel : position -> Model position
|
|
|
|
initialModel = \start ->
|
|
|
|
{
|
|
|
|
evaluated : Set.empty,
|
|
|
|
openSet : Set.singleton start,
|
|
|
|
costs : Dict.singleton start 0,
|
|
|
|
cameFrom : Dict.empty
|
|
|
|
}
|
|
|
|
|
2021-02-15 03:49:25 +03:00
|
|
|
sortBy : List a, (a -> b) -> List a
|
|
|
|
sortBy = \list, _toCmp -> list
|
|
|
|
|
|
|
|
filterMap : List a, (a -> Result b *) -> List b
|
|
|
|
filterMap = \list, toResult ->
|
|
|
|
List.walk list (\element, accum ->
|
|
|
|
when toResult element is
|
|
|
|
Ok value ->
|
|
|
|
List.append accum value
|
|
|
|
|
|
|
|
Err _ ->
|
|
|
|
accum
|
|
|
|
)
|
|
|
|
[]
|
|
|
|
|
2021-02-14 20:44:44 +03:00
|
|
|
cheapestOpen : (position -> F64), Model position -> Result position {}
|
|
|
|
cheapestOpen = \costFn, model ->
|
|
|
|
model.openSet
|
|
|
|
|> Set.toList
|
2021-02-15 03:49:25 +03:00
|
|
|
|> filterMap (\position ->
|
2021-02-14 20:44:44 +03:00
|
|
|
when Dict.get model.costs position is
|
|
|
|
Err _ ->
|
|
|
|
Err {}
|
|
|
|
|
|
|
|
Ok cost ->
|
|
|
|
Ok { position, cost: cost + costFn position }
|
2021-02-15 03:49:25 +03:00
|
|
|
)
|
|
|
|
|> 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
|
|
|
|
|
|
|
|
# TODO shuffle things around so we get reuse
|
|
|
|
updateCost : position, position, Model position -> Model position
|
|
|
|
updateCost = \current, neighbor, model ->
|
|
|
|
newCameFrom =
|
|
|
|
Dict.insert model.cameFrom neighbor current
|
|
|
|
|
|
|
|
newCosts =
|
|
|
|
Dict.insert model.costs neighbor distanceTo
|
|
|
|
|
|
|
|
distanceTo =
|
|
|
|
reconstructPath newCameFrom neighbor
|
|
|
|
|> List.len
|
|
|
|
|> Num.toFloat
|
|
|
|
|
|
|
|
newModel =
|
|
|
|
{ model &
|
|
|
|
costs: newCosts,
|
|
|
|
cameFrom: newCameFrom
|
|
|
|
}
|
|
|
|
|
|
|
|
when Dict.get model.costs neighbor is
|
|
|
|
Err _ ->
|
|
|
|
newModel
|
|
|
|
|
|
|
|
Ok previousDistance ->
|
|
|
|
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 {} ->
|
|
|
|
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 =
|
|
|
|
Set.difference modelPopped.evaluated neighbors
|
|
|
|
|
|
|
|
modelWithNeighbors =
|
|
|
|
{ modelPopped &
|
|
|
|
openSet: Set.union modelPopped.openSet newNeighbors
|
|
|
|
}
|
|
|
|
|
|
|
|
modelWithCosts =
|
2021-02-15 03:49:25 +03:00
|
|
|
Set.walk newNeighbors (\n, m -> updateCost current n m) modelWithNeighbors
|
2021-02-14 20:44:44 +03:00
|
|
|
|
|
|
|
astar costFn moveFn goal modelWithCosts
|
|
|
|
|
|
|
|
|