-
Notifications
You must be signed in to change notification settings - Fork 1
/
Main.elm
139 lines (113 loc) · 3.83 KB
/
Main.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
module Main exposing (..)
import Browser
import Browser.Events
import Dict exposing (Dict)
import Html exposing (..)
import Json.Decode
import Problem exposing (Problem)
import Problem.Example exposing (Queens, SlidingPuzzle, complexEightPuzzle, mediumEightPuzzle, queens, routeFinding, simpleEightPuzzle, slidingPuzzleVisual)
import Problem.Search as Search exposing (Result(..))
import Problem.Search.Visual as Visual
import Process
import Task
main =
Browser.document
{ view =
\model ->
{ title = "Search"
, body = view model
}
, init = init
, update = update
, subscriptions = \_ -> Visual.tooltip.sub Move
}
type alias ProblemState =
SlidingPuzzle
problem : Problem ProblemState
problem =
complexEightPuzzle
type Msg
= NewModel1 (Search.Model ProblemState)
| NewModel2 (Search.Model ProblemState)
| NewModel3 (Search.Model ProblemState)
| Show (Maybe (Search.Node ProblemState))
| Move { x : Float, y : Float }
type alias Model =
{ searchModel1 : Search.Model ProblemState
, searchModel2 : Search.Model ProblemState
, searchModel3 : Search.Model ProblemState
, tooltipModel : Visual.TooltipModel Msg ProblemState
}
view : Model -> List (Html Msg)
view { searchModel1, searchModel2, searchModel3, tooltipModel } =
[ Visual.tooltip.view tooltipModel
, table []
[ tr []
[ th [] [ text "Uniform-cost" ]
, th [] [ text "Best-first" ]
, th [] [ text "Greedy" ]
]
, tr []
[ td [] [ Visual.scatter (Just tooltipModel) searchModel1 ]
, td [] [ Visual.scatter (Just tooltipModel) searchModel2 ]
, td [] [ Visual.scatter (Just tooltipModel) searchModel3 ]
]
, tr []
[ td [] [ Visual.tree (Just tooltipModel) searchModel1 ]
, td [] [ Visual.tree (Just tooltipModel) searchModel2 ]
, td [] [ Visual.tree (Just tooltipModel) searchModel3 ]
]
, tr []
[ td [] [ Visual.treeMap (Just tooltipModel) searchModel1 ]
, td [] [ Visual.treeMap (Just tooltipModel) searchModel2 ]
, td [] [ Visual.treeMap (Just tooltipModel) searchModel3 ]
]
]
]
init : () -> ( Model, Cmd Msg )
init =
\_ ->
let
m1 =
Search.uniformCost problem
m2 =
Search.bestFirst problem
m3 =
Search.greedy problem
in
( { searchModel1 = m1
, searchModel2 = m2
, searchModel3 = m3
, tooltipModel = Visual.tooltip.init problem Show (Just Problem.Example.slidingPuzzleVisual)
}
, Cmd.batch
[ searchTask NewModel1 m1
, searchTask NewModel2 m2
, searchTask NewModel3 m3
]
)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg ({ tooltipModel } as model) =
case msg of
NewModel1 m ->
( { model | searchModel1 = m }, searchTask NewModel1 m )
NewModel2 m ->
( { model | searchModel2 = m }, searchTask NewModel2 m )
NewModel3 m ->
( { model | searchModel3 = m }, searchTask NewModel3 m )
Show s ->
( { model | tooltipModel = { tooltipModel | node = s } }, Cmd.none )
Move p ->
( { model | tooltipModel = { tooltipModel | position = p } }, Cmd.none )
searchTask : (Search.Model ProblemState -> Msg) -> Search.Model ProblemState -> Cmd Msg
searchTask msg model =
case model.result of
Pending ->
Task.perform
msg
(Process.sleep 1000
|> Task.andThen
(\_ -> Task.succeed (Search.next model))
)
_ ->
Cmd.none