view src/lifter.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 9f1ca5ba2684
children 397089dccb32
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"
				states <- topN: states n
				print: "states length is now " . (states length) . "\n"
			}
		}
	}
	
	main <- {
		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
		initmaxsteps <- 6
		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: 8
			maxsteps <- initmaxsteps - 1
			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
		
	}
}