Mercurial > repos > icfp2012
view src/sim.tp @ 45:9f1ca5ba2684
Discard entries for which we can easily tell that it will be impossible for them to be better than the current best. This allows us to terminate when we cannot solve the map
author | Mike Pavone <pavone@retrodev.com> |
---|---|
date | Sun, 15 Jul 2012 17:26:25 -0700 |
parents | 0c09730c173e |
children | 5d2e59cbbc7c |
line wrap: on
line source
{ null <- #{} eachbyte <- :string action { strLen <- string byte_length: index <- 0 while: {index < strLen} do: { element <- (string byte: index) action: index element index <- index + 1 } } debugLog <- :str { os write: 2 str } abs <- :val { if: val < 0 { 0 - val } else: { val } } makeCellTypes <- { typedict <- dict linear new <- :idStr { cannav <- if: idStr = " " {true} else: { if: idStr = "." {true} else: { if: idStr = "\\" {true} else: { if: idStr = "O" {true} else: { false }}}} ret <- #{ id <- (idStr byte: 0) string <- idStr isrobot <- { false } eq <- :other { id = (other id) } navigable <- { cannav } } typedict set: (ret id) ret ret } #{ find <- :id { if: id = ("R" byte: 0) { robot: } else: { typedict get: id withDefault: empty } } wall <- new: "#" empty <- new: " " earth <- new: "." rock <- new: "*" lambda <- new: "\\" closedLift <- new: "L" openLift <- new: "O" newline <- new: "\n" robot <- { commands <- dict linear ret <- #{ id <- ("R" byte: 0) string <- "R" x <- 0 y <- 0 isrobot <- { true } eq <- :other { id = (other id) } collected <- 0 heldBreath <- 0 razors <- 0 busted <- false mine <- null doCmd <- :cmd { action <- commands get: cmd withDefault: { null } action: } move <- :xDelta yDelta { xPrime <- x + xDelta yPrime <- y + yDelta writeMove <- { mine setCell: xPrime yPrime self mine setCell: x y empty x <- xPrime y <- yPrime } consequenceOf <- :cur { if: (cur eq: lambda) { collected <- collected + 1 mine addPoints: 25 } if: (cur eq: openLift) {mine succeeded!} } destination <- mine getCell: xPrime yPrime if: (destination navigable: ) { consequenceOf: destination writeMove: } else: { if: (destination eq: rock) { xPrimePrime <- xDelta * 2 + x rockDestination <- mine getCell: xPrimePrime y if: (rockDestination eq: empty) { mine setCell: xPrimePrime y rock writeMove: } } } } clone <- { myclone <- robot myclone collected!: collected myclone heldBreath!: heldBreath myclone razors!: razors myclone } } commands set: "L" {ret move: (-1) 0 } commands set: "R" {ret move: 1 0 } commands set: "U" {ret move: 0 1 } commands set: "D" {ret move: 0 (-1) } //commands set: "A" {mine ended!: true} ret } } } #{ cellTypes <- makeCellTypes: state <- #{ new <- :in_grid in_width in_height { nextGrid <- #[] _robot <- null endreached <- false _succeeded <- false ret <- #{ grid <- in_grid width <- in_width height <- in_height calcIndex <- :x y { x + y * width } calcX <- :index {index % width} calcY <- :index {index / width} setCell <- :x y val { grid set: (calcIndex: x y) val } getCell <- :x y { grid get: (calcIndex: x y) } validDest?:from <- :index :fromIndex { cell <- (grid get: index) if: (cell navigable) {true} else: { if: (cell eq: (cellTypes rock)) { diff <- index - fromIndex //make sure movement was horizontal if: (abs: diff) = 1 { rockdest <- index + diff if: ((grid get: rockdest) eq: (cellTypes empty)) { //make sure rock destination doesn't wrap (calcY: rockdest) = (calcY: index) } } } } } validMoves <- :x y { amove <- :idx name {#{ index <- idx cmd <- name string <- { name . "(" . idx . ")" } }} here <- calcIndex: x y //TODO: Add wait move when rocks are in motion //(amove: here "W") cur <- #[(amove: here "A")] up <- amove: (calcIndex: x y + 1) "U" down <- amove: (calcIndex: x y - 1) "D" left <- amove: (calcIndex: x - 1 y) "L" right <- amove: (calcIndex: x + 1 y) "R" foreach: #[up down left right] :idx el { if: (validDest?: (el index) from: here) { cur append: el } } cur } getRobot <- { _robot } updatePos <- :obj Index { obj x!: (calcX: Index) obj y!: (calcY: Index) } lambdaCount <- 0 water <- 0 flooding <- 0 waterproof <- 10 moves <- #[] score <- 0 maxScore <- { score + (lambdaCount - (_robot collected)) * 25 + lambdaCount * 50 } addPoints <- :points { score <- score + points } ended <- {endreached} succeeded <- {_succeeded} succeeded! <- { endreached <- true _succeeded <- true addPoints: lambdaCount * 50 } doUpdate <- { foreach: grid :index value { if: (value eq: (cellTypes rock)) { x <- calcX: index y <- calcY: index below <- getCell: x (y - 1) if: (below eq: (cellTypes empty)) { setCell: x y (cellTypes empty) setCell: x (y - 1) value } } else: { if: (value eq: (cellTypes closedLift)) { if: (_robot collected) = lambdaCount { grid set: index (cellTypes openLift) } } } } } advance <- :roboCmd { if: roboCmd = "A" { endreached <- true moves append: roboCmd addPoints: (_robot collected) * 25 } if: (not: endreached) { _robot doCmd: roboCmd score <- score - 1 moves append: roboCmd doUpdate: } self } printGrid <- { cur <- (grid length) - width col <- 0 while: {cur >= 0} do: { os write: 2 ((grid get: cur) string) cur <- cur + 1 col <- col + 1 if: col = width { col <- 0 cur <- cur - (width + width) os write: 2 "\n" } } os write: 2 "score: " . score . "\n" os write: 2 "collected: " . (_robot collected) . "\n" os write: 2 "moves: " foreach: moves :idx m { os write: 2 m } os write: 2 "\n" } clone <- { cgrid <- #[] foreach: grid :idx el { if: (el isrobot) { cgrid append: (el clone) } else: { cgrid append: el } } myclone <- state new: cgrid width height myclone water!: water myclone flooding!: flooding myclone waterproof!: waterproof movesclone <- #[] foreach: moves :idx el { movesclone append: el } myclone moves!: movesclone myclone score!: score myclone lambdaCount!: lambdaCount myclone } } foreach: in_grid :index el{ nextGrid append: el if: (el isrobot) { _robot <- el _robot mine!: ret ret updatePos: _robot index } else: { if: (el eq: (cellTypes lambda)) { ret lambdaCount!: (ret lambdaCount) + 1 } } // adding a 'new' method to robot and doing this instead // wolud allow me to treat robots and other cellTypes equaly // particularly for adding methods or state to other cellTypess. // // if: (el = (cellTypes robot)) { // robot <- el new: // (ret grid) set: index robot // robot mine!: ret // ret updatePos: robot index // nextGrid append: el // } else: { // nextGrid append: el // } } ret } fromStr <- :str { strLen <- str byte_length: maxCol <- 0 nl <- (cellTypes newline) id blank <- cellTypes empty lines <- #[] curline <- #[] eachbyte: str :index element { if: element = nl { col <- curline length maxCol <- if: col > maxCol {col} else: {maxCol} lines append: curline curline <- #[] } else: { curline append: (cellTypes find: element) } } grid <- #[] cur <- (lines length) - 1 while: { cur >= 0 } do: { curline <- (lines get: cur) foreach: curline :idx el { grid append: el } extra <- maxCol - (curline length) while: { extra > 0 } do: { grid append: blank extra <- extra - 1 } cur <- cur - 1 } new: grid maxCol (lines length) } } readFd <- :fd { if: fd < 0 { "" } else: { cur <- "" part <- "" while: { part <- os read: fd 128 part != "" } do: { cur <- cur . part } cur } } readFile <- :path { fd <- os open: path (os O_RDONLY) out <- readFd: fd os close: fd out } getMove <- { ret <- os read: 0 1 while: {ret = "\n"} do: { ret <- os read: 0 1 } ret } main <- :args { if: (args length) < 2 { print: "usage: sim filename\n" } else: { verbose <- true text <- readFile: (args get: 1) print: text //os close: 1 simState <- state fromStr: text while: { not: (simState ended: ) } do: { simState advance: (getMove: ) if: verbose { simState printGrid } } } } } }