Mercurial > repos > icfp2012
view src/sim.tp @ 67:ff8d7b4499f5 default tip
Submission prep
author | Mike Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 16 Jul 2012 04:48:50 -0700 |
parents | aa822c683e28 |
children |
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 } navigable <- { false } eq <- :other { id = (other id) } collected <- 0 heldBreath <- 0 razors <- 0 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 _ended <- false _maxmoves <- in_width * in_height _heuristicValid <- false _heuristic <- 0 getSafe <- :collection :index { if: index >= 0 { if: index < (collection length) { collection get: index } else: { (cellTypes wall) } } else: { (cellTypes wall) } } _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} getCell <- :x y { grid getSafe: (calcIndex: x y) } setCell <- :x y val { grid set: (calcIndex: x y) val } getNextCell <- :x y { _nextGrid getSafe: (calcIndex: x y) } setNextCell <- :x y val { _nextGrid set: (calcIndex: x y) val } validDest?:from <- :index :fromIndex { cell <- (grid getSafe: 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 getSafe: 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 cur <- #[(amove: here "A") (amove: here "W")] 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 } distanceFrom:to <- :x y celltype { //debugLog: "calculating distance from " . x . ", " . y . " to " . celltype . "\n" if: (celltype eq: (cellTypes closedLift)) { celltype navigable!: true } moves <- validMoves: x y curdist <- 0 visited <- _nextGrid foreach: grid :idx el { visited set: idx false } notfound <- true while: { if: notfound { (moves length) > 0 } } do: { nextmoves <- #[] curdist <- curdist + 1 //debugLog: "moves at distance " . curdist . "\n" foreach: moves :idx move { curpos <- move index //debugLog: "" . move . " " . (grid get: curpos) . "\n" if: (not: (visited get: curpos)) { if: ((grid get: curpos) eq: celltype) { notfound <- false } else: { visited set: curpos true foreach: (validMoves: (calcX: curpos) (calcY: curpos)) :idx move { nextmoves append: move } } } } moves <- nextmoves } if: (celltype eq: (cellTypes closedLift)) { celltype navigable!: false } if: notfound { -1 } else: { curdist } } 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 } heuristic <- { if: (not: _heuristicValid) { dest <- if: (_robot collected) = lambdaCount { dist <- (distanceFrom: (_robot x) (_robot y) to: (cellTypes openLift)) if: dist < 0 { //debugLog: "open lift unreachable\n" _heuristic <- (_robot collected) * 50 - (moves length) } else: { //debugLog: "open lift unreachable at distance" . dist . "\n" _heuristic <- (_robot collected) * 75 - dist - (moves length) } } else: { mult <- 0 liftdist <- (distanceFrom: (_robot x) (_robot y) to: (cellTypes closedLift)) if: liftdist < 0 { mult <- 50 } else: { mult <- 75 } lambdadist <- (distanceFrom: (_robot x) (_robot y) to: (cellTypes lambda)) if: lambdadist < 0 { //debugLog: "lambda unreachable with lift multilier " . mult . "\n" _heuristic <- score } else: { //debugLog: "lambda reachable at distance " . lambdadist . " lift multilier " . mult . "\n" _heuristic <- (_robot collected) * mult - lambdadist - (moves length) } } //_heuristic <- (_robot collected) * 75 - (distanceFrom: (_robot x) (_robot y) to: (cellTypes openLift) - (moves length) _heuristicValid <- true } _heuristic } addPoints <- :points { score <- score + points } ended <- {_ended} succeeded <- {_succeeded} succeeded! <- { _ended <- true _succeeded <- true addPoints: lambdaCount * 50 } doUpdate <- { foreach: grid :index value { nextValue <- value if: (value eq: (cellTypes rock)) { x <- calcX: index y <- calcY: index below <- getCell: x (y - 1) fallToSide <- :delta { side <- getCell: (x + delta) y belowSide <- getCell: (x + delta) (y - 1) if: (side eq: (cellTypes empty)) { if: (belowSide eq: (cellTypes empty)) { setNextCell: (x + delta) (y - 1) value nextValue <- (cellTypes empty) true } else: { false } } else: { false } } if: (below eq: (cellTypes empty)) { nextValue <- (cellTypes empty) setNextCell: x (y - 1) value } else: { if: (below eq: (cellTypes rock)) { if: (not: (fallToSide: 1)) {fallToSide: -1} } else: { if: (below eq: (cellTypes lambda)) { fallToSide: 1 }}} // end if } else: { if: (value eq: (cellTypes closedLift)) { if: (_robot collected) = lambdaCount { nextValue <- (cellTypes openLift) } } } _nextGrid set: index nextValue } } checkForDeath <- { robotsNewFace <- getNextCell: (_robot x) (_robot y) + 1 robotsFace <- getCell: (_robot x) (_robot y) + 1 if: (robotsNewFace eq: (cellTypes rock)) { if: (not: (robotsFace eq: (cellTypes rock))) { _ended <-true } } } swapGrids <- { tmp <- grid grid <- _nextGrid _nextGrid <- tmp } abort <- { _ended <- true addPoints: (_robot collected) * 25 } advance <- :roboCmd { if: roboCmd = "?" { os write: 2 "valid moves: " valid <- validMoves: (_robot x) (_robot y) foreach: valid :idx el { os write: 2 (el cmd) } os write: 2 "\n" } else: { if: roboCmd = "h" { os write: 2 "heuristic: " . heuristic . "\n" } else: { _heuristicValid <- false if: roboCmd = "A" { moves append: roboCmd abort } if: (not: _ended) { _robot doCmd: roboCmd score <- score - 1 moves append: roboCmd doUpdate: checkForDeath: swapGrids: if: (moves length) >= _maxmoves { abort } } } } self } printGrid <- { cur <- (grid length) - width col <- 0 while: {cur >= 0} do: { os write: 2 ((grid getSafe: 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" } printMoves <- { foreach: moves :idx m { os write: 1 m } os write: 1 "\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 } hash <- { value <- ((grid get: 0) id) * 128 foreach: grid :idx el { value <- 1000003 * value + (el id) } //TODO add in any important state from outside grid value } } 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 } } } 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) os write: 1 text os close: 1 simState <- state fromStr: text while: { not: (simState ended: ) } do: { simState advance: (getMove: ) if: verbose { simState printGrid } } } } } }