view src/solver.tp @ 59:3c8d8fdd32a1 default tip

mike's changes to solver
author bill
date Sun, 11 Aug 2013 15:24:22 -0700
parents c50f0fb9a717
children
line wrap: on
line source

{
	_classifNode <- :vals prog startIdx child? {
		if: startIdx < (vals length) {
			_dict <- dict linear
			_const <- #[]
			_first <- false
			_hasFirst? <- false
			_val <- vals get: startIdx
			#{
				input <- { _val }
				valmap <- { _dict }
				allInputs <- { vals }
				constantProgs <- { _const }
				append <- :tree {
					if: child? && (tree constant?) {
						_const append: tree
					} else: {
						if: (_dict length) > 0 {
							prog root!: tree
							res <- prog run: _val
							node <- _dict get: res elseSet: {
								_classifNode: vals prog startIdx + 1 true
							}
							node append: tree
						} else: {
							if: _hasFirst? {
								prog root!: _first
								res <- prog run: _val
								node <- _classifNode: vals prog startIdx + 1 true
								_dict set: res node
								node append: _first
								append: tree
							} else: {
								_first <- tree
								_hasFirst? <- true
							}
						}
					}
				}
				length <- {
					len <- _dict length
					if: len = 0 && _hasFirst? {
						len <- 1
					}
					len + (_const length)
				}
				printwithIndent <- :indent {
					print: indent . "Input: " . (hex: _val) . "\n"
					nextindent <- indent . "    "
					if: (_const length) > 0 {
						print: indent . "Constants:\n"
						foreach: _const :idx val {
							print: nextindent . (string: val) . "\n"
						}
					}
					if: (_dict length) > 0 {
						foreach: _dict :key val {
							print: indent . (hex: key) . " ->\n"
							val printwithIndent: nextindent
						}
					} else: {
						if: _hasFirst? {
							print: nextindent . (string: _first) . "\n"
						}
					}
				}
				print <- {
					printwithIndent: ""
				}
				findMatches:at <- :outputs :startIdx {
					outVal <- outputs get: startIdx
					sub <- _dict get: outVal withDefault: #{
						length <- { 0 }
					}
					res <- #[]
					if: (sub length) > 0 {
						res <- sub findMatches: outputs at: (startIdx + 1)
						cps <- sub constantProgs
						if: (cps length) > 0 {
							isConstant <- true
							cur <- 0
							while: { isConstant && cur < (cps length)} do: {
								isConstant <- outVal = (outputs get: cur)
								cur <- cur + 1
							}
							if: isConstant {
								foreach: cps :idx tree {
									res append: cps
								}
							}
						}
					} else: {
						if: _hasFirst? {
							res append: _first
						}
					}
					res
				}
			}
		} else: {
			_arr <- #[]
			#{
				append <- :tree {
					_arr append: tree
				}
				length <- { _arr length }
				constantProgs <- { #[] }
				printwithIndent <- :indent {
					print: indent . "No more values for these:\n"
					indent <- indent . "    "
					foreach: _arr :idx val {
						print: indent . (string: val) . "\n"
					}
				}
				print <- {
					printwithIndent: ""
				}
				findMatches:at <- :outputs :startIdx {
					_arr
				}
			}
		}
	}
	#{
		classify <- :prog trees numTests {
			(os srand: (os time))
			testvals <- #[]
			i <- 0
			while: {i < numTests} do: {
				i <- i + 1
				testvals append: (uint64: (os rand64))
			}
			root <- _classifNode: testvals prog 0 false
			foreach: trees :idx tree {
				root append: tree
			}
			root
		}

		solve:withAuth:andInfo:andProg <- :progId :authKey :info :prog {
			statusCode <- 429
			resp <- false
			start <- 0
			end <- 0
			while: { statusCode = 429} do: {
				start <- os time
				resp <- (requests evalId: progId (info allInputs)) sendWithKey: authKey
				end <- os time
				if: (resp status) = "ok" {
					statusCode <- 200
					if: (end - start) < 4 {
						os sleep: (4 - (end - start))
					}
				} else: {
					statusCode <- resp httpCode
					if: statusCode = 429 {
						print: "API is pissed, waiting 20 seconds...\n"
						os sleep: 20
					}
				}
			}
			if: (resp status) = "ok" {
				print: "Start: " . (string: start) . ", End: " . (string: start) . "Duration: " . (string: end - start) . "\n"
				matches <- info findMatches: (resp outputs) at: 0
				noSuccess <- true
				cur <- 0
				if: (matches length) = 0 {
					print: "No matches? :(\n"
					print: info
				}
				while: { noSuccess && cur < (matches length) } do: {
					prog root!: (matches get: cur)
					gstart <- os time
					gresp <- (requests guess: progId (string: prog)) sendWithKey: authKey
					gend <- os time
					print: "Start: " . (string: gstart) . ", End: " . (string: gend) . "Duration: " . (string: gend - gstart) . "\n"
					if: (gend - gstart) < 4 {
						os sleep: (4 - (gend - gstart))
					}
					if: (gresp status) = "win" {
						noSuccess <- false
					} else: {
						if: (gresp status) = "mismatch" {
							failInput <- (gresp values) get: 0
							failOutput <- (gresp values) get: 1
							filtered <- #[]
							foreach: matches :idx tree {
								prog root!: tree
								if: (prog run: failInput) = failOutput {
									filtered append: tree
								}
							}
							print: "Mismatch: went from " . (matches length) . " to " . (filtered length) . "\n"
							matches <- filtered
							if: (matches length) = 0 {
								print: "None of our programs actually matched 0x" . (hex: failOutput) ." with input 0x" . (hex: failInput) ." :(\n"
							}
						} else: {
							if: (gresp httpCode) = 429 {
								print: "API is pissed, waiting 20 seconds...\n"
								os sleep: 20
							} else: {
								print: "Got message: " . (gresp message) . ", moving on\n"
								cur <- cur + 1
							}
						}
					}
				}
			} else: {
				print: resp
			}
		}

		main <- :args {
			size <- 3
			if: (args length) > 1 {
				size <- int32: (args get: 1)
			}
			prog <- bv program
			if: size >= 2 {
				numTests <- 0
				if: (args length) > 2 {
					numTests <- int32: (args get: 2)
				}
				if: numTests <= 0 {
					numTests <- 16
				}
				trees <- #[]

				if: (args length) > 5 {
					ops <- (args get: 5) splitOn: ","
					if: size < 10 {
						trees <- prog filterTrees: (prog allOfSize: size) ops
					} else: {
						print: "Generating programs for operators: " . (ops fold: "" with: :acc el { acc . el }) . "\n"
						trees <- prog allOfSize: size withOps: ops
						print: "Generated " . (string: (trees length)) . " programs\n"
						trees <- prog filterTrees: trees ops
					}
				} else: {
					trees <- (prog allWithMaxSize: size)
				}
				print: "Running classifier on " . (string: (trees length)) . " programs\n"
				info <- classify: prog trees numTests
				if: (args length) > 4 {
					progId <- (args get: 3)
					authKey <- (args get: 4)

					solve: progId withAuth: authKey andInfo: info andProg: prog
				} else: {
					print: info
				}
			}
			0
		}
	}
}