-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathstate_search.sml
executable file
·105 lines (85 loc) · 4.93 KB
/
state_search.sml
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
(*======================================================================
A functor that takes a state-space implementation and produces
a state-space-search implementation.
=======================================================================*)
functor MakeStateSearch (structure state_space: STATE_SPACE): STATE_SPACE_SEARCH =
struct
structure state_space = state_space
open state_space
datatype search_style = depth_first | breadth_first | best_first
type search_function = state * (state -> bool) * int -> (state * int) option
fun enterStates(states,table) = List.map (fn s => addState(s,table)) states
val silent_output = ref true
fun isSilentOutput() = !silent_output = true
fun silenceOutput() = silent_output := true
fun unSilenceOutput() = silent_output := false
fun printMsg(s) = if !silent_output then () else print(s)
val merge = Basic.merge
val mergeSort = Basic.mergeSortBuiltInComp
val no_progress_limit = 100
fun isMultiple(a,b) = Int.mod(a,b) = 0
fun makeSearchFunction(preProcess,expand,style,score_option) =
let val fringe_table = makeStateTable()
val closed_table = makeStateTable()
fun alreadySeen(s,table) = isMember(s,table)
val scoreFun = (case score_option of
SOME(score) => score
| _ => (fn s => ~1.0))
val (compareStates,sorted) =
(case score_option of
SOME(score) => ((fn (s1,s2) => (Real.<=(score(s1),score(s2)))),
fn L => true)
| _ => ((fn (s1,s2) => false), fn L => true))
val (sort,merge) = (case style of
depth_first => (fn states => states,fn (x,y,z) => x@y)
| best_first => (fn states => mergeSort(states,compareStates),merge)
| _ => raise Basic.Never)
fun noProgress(np_count) = np_count > no_progress_limit
fun breadthFirstMakeFringe(sorted_new_states,tail_states,count) = tail_states@sorted_new_states
fun allElseMakeFringe(sorted_new_states,tail_states,count) =
if isMultiple(count,10) then
let val L = sorted_new_states@tail_states
val (element_opt,rest) = let val r = MT.getRandomInt(Int.div(length(L),2))
in
Basic.decomposeNth(L,r)
end
in
(case element_opt of
SOME(x) => x::rest
| _ => L)
end
else merge(sorted_new_states,tail_states,compareStates)
val makeFringe = (case style of
breadth_first => breadthFirstMakeFringe
| _ => allElseMakeFringe)
fun search([],closed,count,_,_,_,_) = NONE
| search(first_state::more_states,closed,count,isGoalState,max,last_score,np_count) =
let val _ = remove(first_state,fringe_table)
val _ = preProcess(first_state,more_states,count)
in
if isGoalState(first_state) then
SOME(first_state,count)
else (if count > max then
(printMsg("Exceeded the maximum number of iterations: " ^ Int.toString(max));NONE)
else if noProgress(np_count) then (printMsg("\nSearch is getting stuck, no progress after: " ^
Int.toString(np_count) ^ ", aborting...\n");NONE)
else
let val new_score = scoreFun(first_state)
val np_count' = if new_score < last_score then 0 else np_count + 1
val new_states = expand(first_state)
val new_states' = List.filter (fn s => (not(alreadySeen(s,closed_table)) andalso
not(alreadySeen(s,fringe_table))))
new_states
val ns_count = length(new_states')
val _ = enterStates(new_states',fringe_table)
val _ = addState(first_state,closed_table)
val sorted_new_states = sort(new_states')
val fringe' = makeFringe(sorted_new_states,more_states,count)
in
search(fringe',first_state::closed,count+1,isGoalState,max,new_score,np_count')
end)
end
in
(fn (init_state,isGoalState,max) => search([init_state],[],1,isGoalState,max,scoreFun(init_state),0))
end
end