Mercurial > repos > icfp2012
view src/lifter.tp @ 67:ff8d7b4499f5 default tip
Submission prep
author | Mike Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 16 Jul 2012 04:48:50 -0700 |
parents | ff2b38518a58 |
children |
line wrap: on
line source
#{ 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 } } } else: { //val1 >= val2 if: val3 > val1 { idx1 } else: { //val1 >= val3 if: val3 > val2 { idx3 } else: { idx2 } } } } 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 } 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" } } abs <- :val { if: val < 0 { 0 - val } else: { val } } distanceFrom:to <- :sx sy :dx dy { (abs: sx - dx) + (abs: sy - dy) } moveFinder <- :field { #{ curbest <- (field clone) advance: "A" states <- #[field] visitedStates <- sets hash bestMove:withMaxSteps <- :self :max{ n <- 0 hashelim <- 0 while: { if: (states length) > 0 { if: n < max { not: (curbest succeeded) } } } do: { nextstates <- #[] foreach: states :idx curstate { me <-curstate getRobot candidates <- curstate validMoves: (me x) (me y) foreach: candidates :idx move { curfield <- curstate clone curfield advance: (move cmd) if: (curfield ended) { if: (curfield score) > (curbest score) { curbest <- curfield } } else: { //check theoretical max score for current map state //discard paths that can never be better than our current best if: (curfield maxScore) > (curbest score) { if: (not: (visitedStates contains?: curfield)) { visitedStates add: curfield nextstates append: curfield } } } } } states <- nextstates n <- n + 1 } if: (curbest succeeded) { false } else: { (states length) > 0 } } cullStatesTo <- :n { if: n < (states length) { states <- topN: states n } } } } main <- :args { initmaxsteps <- 6 aftermaxsteps <- 5 cullstates <- 8 curarg <- 1 cullwhenover <- 0 while: { curarg < (args length) } do: { if: (args get: curarg) = "-is" { curarg <- curarg + 1 if: curarg < (args length) { initmaxsteps <- ((args get: curarg) int32) } } else: { if: (args get: curarg) = "-as" { curarg <- curarg + 1 if: curarg < (args length) { aftermaxsteps <- ((args get: curarg) int32) } } else: { if: (args get: curarg) = "-cs" { curarg <- curarg + 1 if: curarg < (args length) { cullstates <- ((args get: curarg) int32) } } else: { if: (args get: curarg) = "-co" { curarg <- curarg + 1 if: curarg < (args length) { cullwhenover <- ((args get: curarg) int32) } } } } } curarg <- curarg + 1 } text <- sim readFd: 0 initial <- (sim state) fromStr: text finder <- moveFinder: initial maxsteps <- initmaxsteps while: { bestMove: finder withMaxSteps: maxsteps } do: { if: ((finder states) length) > cullwhenover { finder cullStatesTo: cullstates } maxsteps <- aftermaxsteps } (finder curbest) printMoves 0 } }