Mercurial > repos > icfp2012

comparison src/lifter.tp @ 53:fbeedb3aa239

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add heuristic for evaluating non-terminal states. Cull to 8 states based on heuristic rather than just a single one based on score.
author Mike Pavone <pavone@retrodev.com>
date Sun, 15 Jul 2012 21:42:46 -0700
parents 9f1ca5ba2684
children 397089dccb32
comparison
equal deleted inserted replaced
52:b0d89ee419c1 53:fbeedb3aa239
1 #{ 1 #{
2 pqueue <- { 2 swap <- :arr from to {
3 normalnode <- :pri val { 3 a <- arr get: from
4 #{ 4 b <- arr get: to
5 priority <- pri 5 arr set: from b
6 value <- val 6 arr set: to a
7 next <- false 7 }
8 higherPriority? <- :other { 8
9 priority > (other priority) 9 median <- :arr idx1 idx2 idx3 {
10 val1 <- (arr get: idx1) heuristic
11 val2 <- (arr get: idx2) heuristic
12 val3 <- (arr get: idx3) heuristic
13
14 if: val2 > val1 {
15 if: val3 > val2 {
16 idx2
17 } else: {
18 if: val3 > val1 {
19 idx3
20 } else: {
21 idx1
10 } 22 }
11 if:else <- :self trueblock :elseblock { 23 }
12 trueblock: 24 } else: {
25 //val1 >= val2
26 if: val3 > val1 {
27 idx1
28 } else: {
29 //val1 >= val3
30 if: val3 > val2 {
31 idx3
32 } else: {
33 idx2
13 } 34 }
14 } 35 }
15 } 36 }
16 head <- #{ 37 }
17 higherPriority? <- :other {false} 38
18 next <- { self } 39 partition <- :arr left right pivotidx {
19 value <- { false } 40 pivotval <- (arr get: pivotidx) heuristic
41 //move pivot to end
42 swap: arr pivotidx right
43 i <- left
44 storeidx <- left
45 while: { i < right } do: {
46 if: ((arr get: i) heuristic) < pivotval {
47 swap: arr storeidx i
48 storeidx <- storeidx + 1
49 }
50 i <- i + 1
20 } 51 }
21 #{ 52 swap: arr storeidx right
22 take <- { 53 storeidx
23 cur <- head 54 }
24 head <- cur next 55
25 cur value 56 //quickselect shamelessly translated from pseudocode on Wikipedia
57 select <- :arr left right n {
58 pivotidx <- median: arr left right (left + (right - left) / 2)
59 newpivotidx <- partition: arr left right pivotidx
60 pivotdist <- newpivotidx - left + 1
61 while: { pivotdist != n } do: {
62 if: n < pivotdist {
63 right <- newpivotidx - 1
64 } else: {
65 n <- n - pivotdist
66 left <- newpivotidx + 1
26 } 67 }
27 insert:atPriority <- :val pri { 68 pivotidx <- median: arr left right (left + (right - right) / 2)
28 node <- normalnode: pri val 69 newpivotidx <- partition: arr left right pivotidx
29 cur <- head 70 pivotdist <- newpivotidx - left + 1
30 last <- false 71 }
31 while: {cur higherPriority?: node} do: { 72 newpivotidx
32 last <- cur 73 }
33 cur <- cur next 74
34 } 75 topN <- :arr n {
35 if: last { 76 curidx <- (select: arr 0 (arr length) - 1 ((arr length) - n)) + 1
36 node next!: (last next) 77 newarr <- #[]
37 last next!: node 78 while: { curidx < (arr length) } do: {
38 } else: { 79 newarr append: (arr get: curidx)
39 node next!: head 80 curidx <- curidx + 1
40 head <- node 81 }
41 } 82 newarr
42 self 83 }
43 } 84
85 printArr <- :arr {
86 foreach: arr :idx el {
87 print: "" . idx . ": " . (el heuristic) . "\n"
44 } 88 }
45 } 89 }
46 90
47 abs <- :val { 91 abs <- :val {
48 if: val < 0 { 0 - val } else: { val } 92 if: val < 0 { 0 - val } else: { val }
53 } 97 }
54 98
55 moveFinder <- :field { 99 moveFinder <- :field {
56 #{ 100 #{
57 curbest <- (field clone) advance: "A" 101 curbest <- (field clone) advance: "A"
58 playfield <- field 102 states <- #[field]
59 bestMove:withMaxSteps <- :self :max{ 103 bestMove:withMaxSteps <- :self :max{
60 n <- 0 104 n <- 0
61 states <- #[playfield]
62 while: { if: (states length) > 0 { if: n < max { not: (curbest succeeded) } } } do: { 105 while: { if: (states length) > 0 { if: n < max { not: (curbest succeeded) } } } do: {
63 nextstates <- #[] 106 nextstates <- #[]
64 foreach: states :idx curstate { 107 foreach: states :idx curstate {
65 me <-curstate getRobot 108 me <-curstate getRobot
66 candidates <- curstate validMoves: (me x) (me y) 109 candidates <- curstate validMoves: (me x) (me y)
84 n <- n + 1 127 n <- n + 1
85 } 128 }
86 if: (curbest succeeded) { 129 if: (curbest succeeded) {
87 false 130 false
88 } else: { 131 } else: {
89 if: (states length) > 0 { 132 (states length) > 0
90 bestofcur <- states get: 0
91 n <- 1
92 while: { n < (states length) } do: {
93 curstate <- states get: n
94 if: ((curstate score) > (bestofcur score)) {
95 bestofcur <- curstate
96 }
97 n <- n + 1
98 }
99 playfield <- bestofcur
100 true
101 }
102 } 133 }
134 }
135 cullStatesTo <- :n {
136 print: "culling " . (states length) . " to " . n . "\n"
137 states <- topN: states n
138 print: "states length is now " . (states length) . "\n"
103 } 139 }
104 } 140 }
105 } 141 }
106 142
107 main <- { 143 main <- {
110 os write: 2 text 146 os write: 2 text
111 os write: 2 "width: " . (string: (initial width)) . "\n" 147 os write: 2 "width: " . (string: (initial width)) . "\n"
112 os write: 2 "height: " . (string: (initial height)) . "\n" 148 os write: 2 "height: " . (string: (initial height)) . "\n"
113 149
114 finder <- moveFinder: initial 150 finder <- moveFinder: initial
115 while: { bestMove: finder withMaxSteps: 5 } do: { 151 initmaxsteps <- 6
152 maxsteps <- initmaxsteps
153 while: { bestMove: finder withMaxSteps: maxsteps } do: {
154 best <- -1000000
155 bestscore <- -1000000
156 foreach: (finder states) :idx el {
157 h <- (el heuristic)
158 s <- (el score)
159 if: (h > best) {
160 best <- h
161 }
162 if: (s > bestscore) {
163 bestscore <- s
164 }
165 }
166 finder cullStatesTo: 8
167 maxsteps <- initmaxsteps - 1
116 os write: 2 "--------iteration results-------\n" 168 os write: 2 "--------iteration results-------\n"
117 os write: 2 "Best:\n" 169 os write: 2 "Best:\n"
118 (finder curbest) printGrid 170 (finder curbest) printGrid
119 os write: 2 "Current:\n" 171 os write: 2 "Current before cull\n"
120 (finder playfield) printGrid 172 os write: 2 " Best Heuristic: " . best . "\n"
173 os write: 2 " Best Score: " . bestscore . "\n"
174 os write: 2 "After cull:\n"
175 foreach: (finder states) :idx el{
176 os write: 2 " " . idx . " Heuristic: " . (el heuristic) . "\n"
177 os write: 2 " " . idx . " Score: " . (el score) . "\n"
178 }
179 //os write: 2 "Current:\n"
180 //(finder playfield) printGrid
121 } 181 }
122 os write: 2 "---------------\n" 182 os write: 2 "---------------\n"
123 os write: 2 "End Best:\n" 183 os write: 2 "End Best:\n"
124 (finder curbest) printGrid 184 (finder curbest) printGrid
185
125 } 186 }
126 } 187 }