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