(archive 'newLISPer)

March 30, 2006

Sledgehammer and Nut Department

Filed under: newLISP — newlisper @ 16:03
Tags:

>

The kids are playing Zoombinis Mountain Rescue, a computer game aimed at the 8 to 10 age range, and they’re enjoying it immensely. It’s got an educational slant, which keeps the adults reasonably happy too. Some of the puzzles are very interesting, and they’re challenging enough for lively-minded 8 year olds, let alone their poor old parents.

The Beetle Bug Alley puzzle consists of a group of coloured scarab beetles sitting on coloured stones on a cave wall:

Each scarab has to move to the stone with the same colour, but there’s only a few ways you can move them. When you press one of the patterned stones at the bottom of the wall, some of the scarabs swap places, accompanied by 2000-year-old-sliding-limestone-blocks sounds.

In this screen grab, the outer group of five scarabs rotates clockwise when you push the first button, and the scarabs sitting on the green and blue stones change places when you push the second button. (Although in this example the blue scarab is already in the correct location. But it will have to move.)

On the easy levels the puzzle is simply solved – you rotate some of the scarabs a couple of times, swap an out-of-sequence scarab out of the loop, do some more rotates, swap it back, repeat this a few more times, and you’ve solved it.

On the harder levels, though, it’s considerably more challenging (at least, I find it so). Remember the Rubik’s cube? Having to twist it 30 times just to get one corner correct? And then after another two moves it had all got scrambled again? In the same way, getting one scarab into the correct position is no use, because you then have to move it away to get another one correct. The double rotations (both clockwise in this case) are also confusing.

So I left the kids to it, and wondered idly whether I could model the logic behind the puzzle in newLISP, stripping away the excellent visual presentation to see what’s underneath.

The obvious place to start is to store the stones in a simple list. The order can be chosen arbitrarily, if it’s used consistently:

(set 'stones '('cyan 'blue 'red 'purple 'green 'brown 'pink))

The starting position for the scarabs can be in another list. Since I want to be able to ‘reset’ the scarabs, I’ve put this in a function, using the same order (left to right, then top to bottom):

(define (start-position)
    (set 'scarabs '('brown 'green 'purple 'red  'blue 'cyan 'pink)))

These two lists represent the desired finish position and the start position. All we have to do, therefore, is to work out how to transform the first list into the second. But we’re permitted only two sets of moves:

Pushing the first button moves the blue scarab from the green stone (index 4) to the cyan one (index 0), the red scarab from the purple stone to the red stone, and so on. These are easily coded using select, and some hasty pencil and paper computation:

(define (m1)
    (set 'scarabs (select scarabs '(4 0 3 6 5 1 2))))

The second button is easier, just swapping scarabs index 5 and 6.

(define (m2)
    (set 'scarabs (select scarabs '(0 1 2 3 4 6 5))))

I’ll put all the available move functions in a list, which will be useful later:

(set 'moves '(m1 m2))

I want one more function: how do I know when all the scarabs are on their correct stones? For my first attempt at this, I compared the two lists for equality by mapping = over both lists and counting the resulting successes:

(define (get-score)
    (first (count '(true) (map = stones scarabs))))

But it doesn’t really help to know exactly what this score is, because it doesn’t reflect your progress. For example, at the very last but one move before the puzzle is solved, the score will probably be 0, even though every stone is nearly correct. So I rewrote it to be a simple binary test: are all the scarabs correct or not?

(define (solved?)
    (apply and (map = stones scarabs)))

This compares each element of the two lists in turn, and generates a list of true or nil values. Then the applied and returns nil if the list contains any non-true values.

So, we’re ready to find a solution. Warning, brute force will be used!

(define (find-solution)
    (seed (nth 6 (now)))        ; milliseconds seeds random
    (set 'solution '())
    (until (solved?)
        (apply (push (apply amb moves) solution -1))))

The last line does two useful jobs. amb is applied to moves, so it chooses a move from the moves list at random. This move is pushed at the end of a list called solution. It’s also applied again – ie the chosen move is executed and the scarabs are moved – because push returns the element that was pushed. When the function eventually finishes, solution contains a list of the moves that were made to solve the puzzle:

(m2 m1 m1 m1 m2 m2 m1 m2 m1 m2 m1 m1 m2 m1 m2 m1 m2 m1 m1 m1 m2 m1
 m2 m1 m1 m2 m2 m1 m1 m1 m2 m1 m2 m2 m2 m2 m2 m1 m2 m2 m2 m1 m2 m1
 ...
 m2 m1 m2 m2 m2 m1 m1 m1 m1 m2 m1 m2 m2 m1 m1 m1 m1 m2 m1 m1 m1 m2
 m1 m2 m2 m2 m2 m1 m1)

This list of moves is like a recording, and can now be ‘replayed’ if we want to test the solution (remembering to return the scarabs to their initial positions first):

(start-position)
(map apply solution)

But although it’s good to make some progress and see a solution, there are a number of problems. I’ve bet you’ve spotted them too!

First, we’ve found only one solution, and it probably isn’t the best one. To compensate a bit for that, let’s run find-solution a number of times, say 200, and see whether we can get a lower score:

(define (test)
    (set 'best-so-far 1000)
    (dotimes (x 200) ; find 200 solutions
        (start-position)
        (find-solution)
        (println "found solution with " (length solution) " moves")
        (if (< (length solution) best-so-far)
            (set 'best-solution solution 'best-so-far (length solution))))
    ; now print out the best one
    (println "Best solution found so far takes "
        (length best-solution) " moves " )
    (println best-solution)
    ; test solution
    (println "   testing solution ")
    (start-position)
    (println "   scarabs start position " scarabs)
    ; replay the best solution
    (map (fn (x)
            (apply x)
            (println " after " x ",  scarabs now " scarabs))
        best-solution))

This function finds 200 solutions and remembers the best one it finds:

    found solution with 34361 moves
    found solution with 11683 moves
    found solution with 601 moves
    found solution with 15353 moves
    found solution with 11309 moves
    found solution with 20921 moves
    found solution with 1025 moves
    found solution with 13051 moves
    found solution with 4583 moves
    found solution with 10865 moves
    ...
    found solution with 7927 moves
    found solution with 523 moves
    found solution with 749 moves
    found solution with 5015 moves
    found solution with 755 moves
    found solution with 3369 moves
    found solution with 14531 moves
    found solution with 21 moves
    found solution with 8731 moves

    Best solution found so far takes 21 moves
     (m2 m1 m1 m1 m1 m2 m2 m2 m2 m1 m1 m1 m1 m2 m1 m1 m1 m1 m2 m1 m1)
      testing solution
    scarabs start position ('brown 'green 'purple 'red 'blue 'cyan 'pink)
        after m2,  scarabs now ('brown 'green 'purple 'red 'blue 'pink 'cyan)
        after m1,  scarabs now ('blue 'brown 'red 'cyan 'pink 'green 'purple)
        ...
        after m1,  scarabs now ('blue 'brown 'pink 'red 'cyan 'green 'purple)
        after m1,  scarabs now ('cyan 'blue 'red 'purple 'green 'brown 'pink)

Luckily newLISP is fast enough to make this stupid way of finding solutions possible. 20921 moves – ridiculous!

Another obvious problem is easily solved. If you do m2 followed by another m2, in this puzzle, you’ve got back to where you started, having achieved exactly nothing. So we could improve a solution by seeing if there are any of these doubled moves that can be removed. For this we can use newLISP’s powerful match function, which looks for patterns in lists:

(while (set 'temp-list (match '(* m2 m2 *) solution))
    (set 'solution (apply append temp-list)))

This repeatedly does a match until no more doubled m2 moves are found. This can reduce the length of solutions quite a bit – our best solution is now 17 moves.

Another obvious thing to do is to stop looking for a solution once we’ve exceeded the number of moves in the best solution found so far. We could easily recast our find-solution method so that it gives up. This would avoid the pointless generation of 20000+ move solutions once we’ve found a more promising one.

The most serious problem, though, is that I’ve been unable to think of any technique that would allow newLISP to discover patterns in the solutions ‘for itself’.

I don’t know if this is a well-known area of research in computer science circles. Does it make sense to think about how humans do the tasks? Humans don’t tackle problems by randomly selecting moves until a solution is found. Instead, it’s a curious combination of trial and error, pattern spotting, and slowly developing and testing strategies for making progress. That, and some impressive right-brain processing which I don’t understand. I don’t think I’ll be able to do any of that in newLISP, and besides, this little puzzle has had quite enough analysis for one day!

Advertisements

4 Comments »

  1. >No need to put quotes before the symbols here? (set ‘stones ‘(‘cyan ‘blue ‘red ‘purple ‘green ‘brown ‘pink))will work too:(set ‘stones ‘(cyan blue red purple green brown pink))and easier on the eyes.But I don’t want to distract from what is an excellent exercise in ‘map’ and ‘apply’ :)

    Comment by don Lucio — March 31, 2006 @ 21:36 | Reply

  2. >You’re right, of course. I can’t get used to newLISP’s friendly way of dealing with things it hasn’t seen before!

    Comment by newlisper — April 12, 2006 @ 11:27 | Reply

  3. >Sweet post.(Sorry, but I just recently discovered your blog and I’m trying to read it on chrono order.)

    Comment by Rick Hanson — May 1, 2006 @ 00:41 | Reply

  4. >(Sorry, that’s “… in chrono order.” Blogger doesn’t let me go back and fix this after I commit the comment.)

    Comment by Rick Hanson — May 1, 2006 @ 00:46 | Reply


RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at WordPress.com.

%d bloggers like this: