about summary refs log tree commit diff stats
path: root/js/games/nluqo.github.io/~bh/v1ch14/pour.lg
blob: ee561e798d23b487bd8cb2ecda1fd30ea987e0ee (plain) (blame)
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
;; Initialization

to pour :sizes :goal
local [oldstates pitchers won]
make "oldstates (list all.empty :sizes)
make "pitchers fput 0 (map [#] :sizes)
make "won "false
win breadth.first make.path [] all.empty :sizes
end

to all.empty :list
output map [0] :list
end

;; Tree search

to breadth.first :root
op breadth.descend (list :root)
end

to breadth.descend :queue
if emptyp :queue [output []]
if :won [output last :queue]
op breadth.descend sentence (butfirst :queue) ~
                            (children first :queue)
end

;; Generate children

to children :path
output map.se [children1 :path ?] :pitchers
end

to children1 :path :from
output map.se [child :path :from ?] :pitchers
end

to child :path :from :to
local [state newstate]
if :won [output []]
if equalp :from :to [output []]
make "state path.state :path
if not riverp :from ~
   [if equalp (water :from) 0 [output []]]
if not riverp :to ~
   [if equalp (water :to) (size :to) [output []]]
make "newstate (newstate :state :from :to)
if memberp :newstate :oldstates [output []]
make "oldstates fput :newstate :oldstates
if memberp :goal :newstate [make "won "true]
output (list make.path (fput list :from :to path.moves :path) :newstate)
end

to newstate :state :from :to
if riverp :to [output replace :state :from 0]
if riverp :from [output replace :state :to (size :to)]
if (water :from) < (room :to) ~
   [output replace2 :state ~
                    :from 0 ~
                    :to ((water :from)+(water :to))]
output replace2 :state ~
                :from ((water :from)-(room :to)) ~
                :to (size :to)
end

;; Printing the result

to win :path
if emptyp :path [print [Can't do it!] stop]
foreach (reverse path.moves :path) "win1
print sentence [Final quantities are] (path.state :path)
end

to win1 :move
print (sentence [Pour from] (printform first :move)
                [to] (printform last :move))
end

to printform :pitcher
if riverp :pitcher [output "river]
output size :pitcher
end

;; Path data abstraction

to make.path :moves :state
output fput :moves :state
end

to path.moves :path
output first :path
end

to path.state :path
output butfirst :path
end

;; Pitcher data abstraction

to riverp :pitcher
output equalp :pitcher 0
end

to size :pitcher
output item :pitcher :sizes
end

to water :pitcher
output item :pitcher :state
end

to room :pitcher
output (size :pitcher)-(water :pitcher)
end

;; List processing utilities

to replace :list :index :value
if equalp :index 1 [output fput :value butfirst :list]
output fput first :list (replace butfirst :list :index-1 :value)
end

to replace2 :list :index1 :value1 :index2 :value2
if equalp :index1 1 ~
   [output fput :value1 replace butfirst :list :index2-1 :value2]
if equalp :index2 1 ~
   [output fput :value2 replace butfirst :list :index1-1 :value1]
output fput first :list ~
            replace2 butfirst :list :index1-1 :value1 :index2-1 :value2
end