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
				}
			}
		}
	}

}
}