Mercurial > repos > icfp2012
view src/sim.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 | b0d89ee419c1 |
children | a37ceb0a4f5c |
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 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 _ended <- false _maxmoves <- in_width * in_height _heuristicValid <- false _heuristic <- 0 _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 get: (calcIndex: x y) } setCell <- :x y val { grid set: (calcIndex: x y) val } setNextCell <- :x y val { _nextGrid set: (calcIndex: x y) val } 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 } distanceFrom:to <- :x y celltype { //print: "calculating distance from " . x . ", " . y . " to " . celltype . "\n" 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 foreach: moves :idx move { curpos <- move index 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 } 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 { cellTypes openLift } else: { cellTypes lambda } _heuristic <- score - (distanceFrom: (_robot x) (_robot y) to: dest) _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 } swapGrids <- { tmp <- grid grid <- _nextGrid _nextGrid <- tmp } swapGrids: } abort <- { _ended <- true addPoints: (_robot collected) * 25 } advance <- :roboCmd { _heuristicValid <- false if: roboCmd = "A" { moves append: roboCmd abort } if: (not: _ended) { _robot doCmd: roboCmd score <- score - 1 moves append: roboCmd doUpdate: if: (moves length) >= _maxmoves { abort } } 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 } } } 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 } } } } } }