Mercurial > repos > icfp2012
diff src/lifter.tp @ 53:fbeedb3aa239
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 |
line wrap: on
line diff
--- a/src/lifter.tp Sun Jul 15 18:37:36 2012 -0700 +++ b/src/lifter.tp Sun Jul 15 21:42:46 2012 -0700 @@ -1,46 +1,90 @@ #{ - pqueue <- { - normalnode <- :pri val { - #{ - priority <- pri - value <- val - next <- false - higherPriority? <- :other { - priority > (other priority) + swap <- :arr from to { + a <- arr get: from + b <- arr get: to + arr set: from b + arr set: to a + } + + median <- :arr idx1 idx2 idx3 { + val1 <- (arr get: idx1) heuristic + val2 <- (arr get: idx2) heuristic + val3 <- (arr get: idx3) heuristic + + if: val2 > val1 { + if: val3 > val2 { + idx2 + } else: { + if: val3 > val1 { + idx3 + } else: { + idx1 } - if:else <- :self trueblock :elseblock { - trueblock: + } + } else: { + //val1 >= val2 + if: val3 > val1 { + idx1 + } else: { + //val1 >= val3 + if: val3 > val2 { + idx3 + } else: { + idx2 } } } - head <- #{ - higherPriority? <- :other {false} - next <- { self } - value <- { false } - } - #{ - take <- { - cur <- head - head <- cur next - cur value + } + + partition <- :arr left right pivotidx { + pivotval <- (arr get: pivotidx) heuristic + //move pivot to end + swap: arr pivotidx right + i <- left + storeidx <- left + while: { i < right } do: { + if: ((arr get: i) heuristic) < pivotval { + swap: arr storeidx i + storeidx <- storeidx + 1 } - insert:atPriority <- :val pri { - node <- normalnode: pri val - cur <- head - last <- false - while: {cur higherPriority?: node} do: { - last <- cur - cur <- cur next - } - if: last { - node next!: (last next) - last next!: node - } else: { - node next!: head - head <- node - } - self + i <- i + 1 + } + swap: arr storeidx right + storeidx + } + + //quickselect shamelessly translated from pseudocode on Wikipedia + select <- :arr left right n { + pivotidx <- median: arr left right (left + (right - left) / 2) + newpivotidx <- partition: arr left right pivotidx + pivotdist <- newpivotidx - left + 1 + while: { pivotdist != n } do: { + if: n < pivotdist { + right <- newpivotidx - 1 + } else: { + n <- n - pivotdist + left <- newpivotidx + 1 } + pivotidx <- median: arr left right (left + (right - right) / 2) + newpivotidx <- partition: arr left right pivotidx + pivotdist <- newpivotidx - left + 1 + } + newpivotidx + } + + topN <- :arr n { + curidx <- (select: arr 0 (arr length) - 1 ((arr length) - n)) + 1 + newarr <- #[] + while: { curidx < (arr length) } do: { + newarr append: (arr get: curidx) + curidx <- curidx + 1 + } + newarr + } + + printArr <- :arr { + foreach: arr :idx el { + print: "" . idx . ": " . (el heuristic) . "\n" } } @@ -55,10 +99,9 @@ moveFinder <- :field { #{ curbest <- (field clone) advance: "A" - playfield <- field + states <- #[field] bestMove:withMaxSteps <- :self :max{ n <- 0 - states <- #[playfield] while: { if: (states length) > 0 { if: n < max { not: (curbest succeeded) } } } do: { nextstates <- #[] foreach: states :idx curstate { @@ -86,21 +129,14 @@ if: (curbest succeeded) { false } else: { - if: (states length) > 0 { - bestofcur <- states get: 0 - n <- 1 - while: { n < (states length) } do: { - curstate <- states get: n - if: ((curstate score) > (bestofcur score)) { - bestofcur <- curstate - } - n <- n + 1 - } - playfield <- bestofcur - true - } + (states length) > 0 } } + cullStatesTo <- :n { + print: "culling " . (states length) . " to " . n . "\n" + states <- topN: states n + print: "states length is now " . (states length) . "\n" + } } } @@ -112,15 +148,40 @@ os write: 2 "height: " . (string: (initial height)) . "\n" finder <- moveFinder: initial - while: { bestMove: finder withMaxSteps: 5 } do: { + initmaxsteps <- 6 + maxsteps <- initmaxsteps + while: { bestMove: finder withMaxSteps: maxsteps } do: { + best <- -1000000 + bestscore <- -1000000 + foreach: (finder states) :idx el { + h <- (el heuristic) + s <- (el score) + if: (h > best) { + best <- h + } + if: (s > bestscore) { + bestscore <- s + } + } + finder cullStatesTo: 8 + maxsteps <- initmaxsteps - 1 os write: 2 "--------iteration results-------\n" os write: 2 "Best:\n" (finder curbest) printGrid - os write: 2 "Current:\n" - (finder playfield) printGrid + os write: 2 "Current before cull\n" + os write: 2 " Best Heuristic: " . best . "\n" + os write: 2 " Best Score: " . bestscore . "\n" + os write: 2 "After cull:\n" + foreach: (finder states) :idx el{ + os write: 2 " " . idx . " Heuristic: " . (el heuristic) . "\n" + os write: 2 " " . idx . " Score: " . (el score) . "\n" + } + //os write: 2 "Current:\n" + //(finder playfield) printGrid } os write: 2 "---------------\n" os write: 2 "End Best:\n" (finder curbest) printGrid + } }