Continued from Part 1 As App Creators, we believe in keeping our tools sharp and exercising our creative passion for solving real world problems with Mobile Apps. So with our...
A bad workman may blame his tools, but even the best workman needs to invest time in keeping his tools sharp!
I’ve recently been going back through some of my University Computer Science materials, and thought I’d give scheme another shot and refresh my programming basics by working through SICP again. Maybe I should get out more! It’s actually been a pretty refreshing experience all in all, and I thought I’d put my refound skills to the test by working through the puzzles on the Colossal Cue Adventure game. If you haven’t pit your wits against this fiendish programming challenge yet – then you should! Cue used it as a recruiting tool, and it’ll definitely help you heapsort your wheat from your chaff.
For the earlier parts of the challenge, you can find some good references online already – for example:
The third part of the challenge I found easy to solve by hand once I noticed that you have to go through 8s to leave the home square and to enter the ^ square, this simplified the remaining problem sufficiently that I could see the path without writing any code!
However, the Bonus puzzles were more of a challenge… Particularly the ‘eat the carrot’ puzzle as now the complexity was increased, as was the search space. So, I busted out DrRacket with the SICP language pack and set forth to do battle…
Defining the Problem
Firstly, we need a way to represent the costs associated with each Troll. A list of lists seemed to be a good approach for that with east-west movement taking place within the inner list, and north-south taking place between lists…
; Define the map as a list of rows (define ourmap (list (list '* 8 1 7 8 8 5 2 9 5 9 5) (list 8 5 1 1 5 6 9 4 4 5 2 1) (list 7 2 3 5 2 9 2 6 9 3 9 4) (list 9 2 5 9 8 9 5 7 7 5 9 6) (list 2 4 6 7 1 4 2 6 6 2 5 8) (list 2 8 1 5 3 8 4 9 7 5 2 3) (list 2 9 3 5 6 7 2 4 9 4 2 5) (list 6 3 1 7 8 2 3 3 6 7 9 3) (list 2 5 7 4 2 7 8 5 5 3 5 8) (list 5 2 9 8 3 6 1 4 9 5 6 3) (list 4 6 9 8 5 4 9 7 6 4 6 8) (list 2 7 7 1 9 9 7 3 7 2 2 '^) ))
We need some ways to interact with this data – like getting the element at certain coordinates, establishing what moves are valid from a particular location etc.. etc..
; Utility to grab the nth element of a list (define (objectAtIndex n list) (if (eq? 0 n) (car list) (objectAtIndex (- n 1) (cdr list)))) ; Retrieve the basic cost at a particular position on the map (define (costAtCoord coord themap) (let ((x (car coord)) (y (cdr coord))) (define row (objectAtIndex y themap)) (objectAtIndex x row))) ; Give a list of valid moves from a particular position on the map ; We pay special attention to (0, 1) and (1, 0) since we don't want to go back to the home square? (define (movesFromCoord coord themap) (let ( (x (car coord)) (y (cdr coord))) (define row (objectAtIndex y themap)) (cond ((eq? (+ x y) 1) (list 'e 's)) ; Right next to the * we can only go s or e ((and (eq? (length row) (+ 1 x)) (eq? 0 y) ) (list 's 'w)) ; Top Right ((and (> (length row) (+ 1 x)) (eq? 0 y) ) (if (eq? x 0) (list 's 'e) (list 's 'e 'w)) ; Top Row ((and (eq? (length row) (+ 1 x)) (> y 0)) (list 's 'w 'n)) ; Right Hand Side ((and (eq? 0 x) (> y 0)) (if (eq? (+ 1 y) (length themap)) (list 'e 'n) (list 'e 's 'n))) ; Left Hand Side ((and (eq? (+ 1 y) (length themap)) (> x 0)) (list 'e 'n 'w)) ; Bottom Row (else (list 's 'e 'n 'w)))))
As you can see – I’m not a big fan of lisp / scheme style lets-hyphen-everything-together and so have optedForCamelCase instead… Yes, I’m a rebel. Woo. /sarcasm.
Now we can represent the problem domain, we need a way of searching for solutions. To achieve this I defined a ‘state’ to be a combination of:
- current position
- remaining balance
- the map
The increment in this problem is 1 – every move you make the trolls inflate their prices by 1… The accumulator is ‘the amount of increase to add to each cost’ at each stage of the solution. So we can define the constructors, selectors and initial state:
; Manage the current state as a list, constructor and selectors: (define (make-state themap coord balance accumulator incrementer) (list themap coord balance accumulator incrementer)) (define (getCoord state) (objectAtIndex 1 state)) (define (getAccumulator state) (objectAtIndex 3 state)) (define (getBalance state) (objectAtIndex 2 state)) (define (getMap state) (objectAtIndex 0 state)) (define (getIncrementer state) (objectAtIndex 4 state)) (define (getX state) (car (getCoord state))) (define (getY state) (cdr (getCoord state))) ; This is how we start, the final 5 coin balance has been deducted from the start balance, and our goal is to reach zero ; The Trolls inflate their prices by 1 on each move so our accumulator starts at 0 and our incrementer is 1 (define start-state (make-state ourmap (cons 0 0) 439 0 1))
Now we need a way of advancing through our state by making moves. Moves either give us a new state to work from, or they result in failure or success. We hunt out early failures in order to limit our search space – by noting whether our remaining balance is sufficient to reach the goal or not…
; Execute a particular move to transition from state to state ; If we know we can't reach the goal from the state then we return 'fail ; If we've reached the goal we return 'goal ; Otherwise we return the new state (define (distance-from-coord from-coord to-coord) (+ (abs (- (car to-coord) (car from-coord))) (abs (- (cdr to-coord) (cdr from-coord))))) (define (move direction state) (define x (getX state)) (define y (getY state)) (let ((accumulator (getAccumulator state)) (increment (getIncrementer state)) (balance (getBalance state)) (themap (getMap state)) (new-coord (cond ((eq? 'n direction) (cons x (- y 1))) ((eq? 's direction) (cons x (+ y 1))) ((eq? 'e direction) (cons (+ x 1) y)) ((eq? 'w direction) (cons (- x 1) y)))) ) (cond ((> (* accumulator (distance-from-coord new-coord (cons 11 11))) balance) 'fail) ; If we're too far from the goal, and not enough balance left to get there. ((and (eq? 0 balance) (eq? (costAtCoord new-coord themap) '^)) 'goal) ; Found the Goal with exactly zero left ((and (< 0 balance) (eq? (costAtCoord new-coord themap) '^)) 'fail) ; Ran out of Money (else (make-state themap new-coord (- balance (+ (costAtCoord new-coord themap) accumulator)) (+ increment accumulator) increment)))))
Next we introduce a couple of utility functions (some from SICP) and create our own function to enumerate the possible next states based on the permissible moves from the current state…
; Utility to filter a list (define (filter predicate list) (if (pair? list) (if (predicate (car list)) (cons (car list) (filter predicate (cdr list))) (filter predicate (cdr list))) list)) ; SICP Flatmap utility (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) ; Find all the possible next states which aren't failures (define (nextStates movesSoFar state) (let ((nextMoves (movesFromCoord (getCoord state) (getMap state)))) (filter (lambda (x) (not (eq? 'fail (cdr x)))) (map (lambda (x) (cons (append movesSoFar (list x)) (move x state))) nextMoves))))
And finally, we recursively look for solutions:
; Show our answers before the exhaustive search is complete - there might be multiple solutions (define (displayReturn y) ((lambda (x) (display x) x) y)) ; Recursively find solutions from a particular state, keeping track of the moves taken to get to that state (define (solutionsFromHere movesSoFar state) (let ((next-possible-states (nextStates movesSoFar state))) (let ((solutions (filter (lambda (x) (eq? 'goal (cdr x))) next-possible-states))) (if (pair? solutions) (displayReturn (map car solutions)) (if (not (pair? next-possible-states)) '() (flatmap (lambda (x) (solutionsFromHere (car x) (cdr x))) next-possible-states) )))))
All that’s left to start finding solutions is a quick function to start with no moves and in the initial state:
; Start point to find all solution (define (go) (solutionsFromHere '() start-state))
Executing this in DrRacket and solutions start streaming out at you rapidly – I don’t see much need to optimise this any further for the current problem, but if we wanted to know how many solutions there are in total there are many inefficiencies that could be improved. Running “(length (go))” is not quick…
- I need to get out more…
- Even though my day to day life is lived in Objective-C and XCode, there’s huge value in thinking about things from a completely different perspective, and it’s not as hard as it may initially seem. Breaking your habits and pre-conceptions that build up by using a single tool day in day out is a good thing.
- Programming Challenges are fun (see point #1 above…)
- My tools are still sharper than I thought, but they need to be taken care of!
Get the code from gist here.