view src/lifter.tp @ 57:397089dccb32

Compile with -O2. Add tuning parameters and tuning results script
author Mike Pavone <pavone@retrodev.com>
date Sun, 15 Jul 2012 23:55:29 -0700
parents fbeedb3aa239
children 7d4e51b4769a
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]
			bestMove:withMaxSteps <- :self :max{
				n <- 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) {
									nextstates append: curfield
								}
							}
						}
					}
					states <- nextstates
					n <- n + 1
				}
				if: (curbest succeeded) {
					false
				} else: {
					(states length) > 0
				}
			}
			cullStatesTo <- :n {
				print: "culling " . (states length) . " to " . n . "\n"
				if: n < (states length) {
					states <- topN: states n
				}
				print: "states length is now " . (states length) . "\n"
			}
		}
	}
	
	main <- :args {
		initmaxsteps <- 6
		aftermaxsteps <- 5
		cullstates <- 8
		curarg <- 1
		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)
						}
					}
				}
			}
			curarg <- curarg + 1
		}
		
		text <- sim readFd: 0
		initial <- (sim state) fromStr: text
		os write: 2 text
		os write: 2 "width: " . (string: (initial width)) . "\n"
		os write: 2 "height: " . (string: (initial height)) . "\n"
		
		finder <- moveFinder: initial
		
		maxsteps <- initmaxsteps
		while: { bestMove: finder withMaxSteps: maxsteps } do: {
			best <- -1000000
			bestscore <- -1000000
			foreach: (finder states) :idx el {
				h <- (el heuristic)
				s <- (el score)
				if: (h > best) {
					best <- h
				}
				if: (s > bestscore) {
					bestscore <- s
				}
			}
			finder cullStatesTo: cullstates
			maxsteps <- aftermaxsteps
			os write: 2 "--------iteration results-------\n"
			os write: 2 "Best:\n"
			(finder curbest) printGrid
			os write: 2 "Current before cull\n"
			os write: 2 " Best Heuristic: " . best . "\n"
			os write: 2 " Best Score: " . bestscore . "\n"
			os write: 2 "After cull:\n"
			foreach: (finder states) :idx el{
				os write: 2 " " . idx . " Heuristic: " . (el heuristic) . "\n"
				os write: 2 " " . idx . " Score: " . (el score) . "\n"
			}
			//os write: 2 "Current:\n"
			//(finder playfield) printGrid
		}
		os write: 2 "---------------\n"
		os write: 2 "End Best:\n"
		(finder curbest) printGrid
		0
	}
}