-
Notifications
You must be signed in to change notification settings - Fork 0
/
river.ml
111 lines (73 loc) · 1.91 KB
/
river.ml
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
type bank = BankA | BankB;;
type transferEl = Wolf | Goat | Cabbage | None;;
type status = {
wolf : bank;
goat : bank;
cabbage : bank;
shepherd : bank;
path : transferEl list;
};;
let isSafeStatus (s:status) =
not (s.wolf == s.goat && s.wolf != s.shepherd)
&& not (s.goat == s.cabbage && s.goat != s.shepherd);;
let isFinalStatus (s:status) =
s.wolf == BankB &&
s.goat == BankB &&
s.cabbage == BankB &&
s.shepherd == BankB;;
let init_status = { wolf = BankA; goat = BankA; cabbage = BankA; shepherd = BankA; path = []};;
isSafeStatus init_status;;
let transfer (e:bank) =
match e with
BankA -> BankB
| BankB -> BankA;;
let transferWolf (s:status) =
{
wolf = transfer s.wolf;
goat = s.goat;
cabbage = s.cabbage;
shepherd = transfer s.shepherd;
path = s.path @ [Wolf];
};;
let transferGoat (s:status) =
{
wolf = s.wolf;
goat = transfer s.goat;
cabbage = s.cabbage;
shepherd = transfer s.shepherd;
path = s.path @ [Goat];
};;
let transferCabbage (s:status) =
{
wolf = s.wolf;
goat = s.goat;
cabbage = transfer s.cabbage;
shepherd = transfer s.shepherd;
path = s.path @ [Cabbage];
};;
let transferNone (s:status) =
{
wolf = s.wolf;
goat = s.goat;
cabbage = s.cabbage;
shepherd = transfer s.shepherd;
path = s.path @ [None];
};;
let verifyPath s slist =
if isSafeStatus s
then slist @ [s]
else slist;;
let verifyPaths s slist =
verifyPath (transferWolf s) slist;;
let verifyPaths s slist =
let new_listw = verifyPath (transferWolf s) slist in
let new_listg = verifyPath (transferGoat s) new_listw in
let new_listC = verifyPath (transferCabbage s) new_listg in
let new_listN = verifyPath (transferNone s) new_listC in
new_listN;;
let rec iterateStack stack =
match stack with
s :: slist when isFinalStatus s -> s.path
| s :: slist -> iterateStack (verifyPaths s slist)
| _ -> [];;
iterateStack [init_status];;