I was working on trying to solve the MU puzzle from the

Godel Escher Bach book

http://en.wikipedia.org/wiki/G%C3%B6del,_Escher,_Bach
(yes, I know now it is impossible) when I saw an interesting

sub-problem - which integers between 0 and 1000 can be

derived by sequences of "doubling" and "subtracting three"

operations? I first tried to solve this with scheme and then

with perl but I'm having some problems with the perl program.

A quick outline of the algorithm:

Begin with a list of lists containing [[1]]

Foreach list

take the head of the list

double it

subtract three from it.

if either result is within the range 0 and 1000 and not already

in the hash it is valid

foreach valid result

concatenate the result to the list and add it to a new list

of lists

Continue creating new in-progress lists until an iteration does not add

any more

keys to the hash

We create lists like this for two purposes:

#1 To reduce the amount of work needed to do - at any one time

there are many more keys in the hash then there are lists in the

list of lists.

#2 To keep a record of the steps necessary to produce a given integer.

Here is the perl code:

use strict;

my %HASH = (1 => 1);

sub display

{

my $l = $_[0];

my $first = 1;

print '(';

foreach my $elem (@$l) {

unless ($first) { print ' '; }

$first = 0;

if (ref $elem eq 'ARRAY') {

display($elem);

} else {

print $elem;

}

}

print ')';

}

sub valid

{

my $v = $_[0];

return ($v >= 0) && ($v <= 1000) && (! exists($HASH{$v}));

}

sub new_list

{

my $l = $_[0];

my @retVal = ();

foreach my $subList (@$l) {

my $head = $subList->[0];

foreach my $v (($head * 2), ($head - 3)) {

if (valid($v)) {

$HASH{$v} = 1;

push @retVal, [($v, @$subList)];

}

}

}

return \@retVal;

}

my $l = [[1]];

my $solutions = 1;

while (1) {

$l = new_list($l);

display($l); print "\n";

my $keys = scalar keys %HASH;

if ($keys == $solutions) { last; }

print "$solutions, $keys\n";

$solutions = $keys;

}

# display($l);

foreach (@$l) {

display($_);

print "\n";

}

This seems to progress correctly for a number of iterations, but

towards the end of the processing it loses

all the results. Any ideas why?

This may look like uni coursework or similar, but I promise it isn't

(at least for me!). Here is my scheme program

that solves the problem:

(require (lib "28.ss" "srfi"))

(require (lib "69.ss" "srfi"))

(define (double x) (* x 2))

(define (sub3 x) (- x 3))

(define (valid? x hash) (and (>= x 0)

(<= x 1000)

(not (hash-table-exists? hash x))))

(define (make-soln s e hash)

(hash-table-set! hash s #t)

(cons s e))

(define (add-solutions seq hash)

(if (null? seq) '()

(let* ((e (car seq))

(f (car e))

(s1 (double f))

(s2 (sub3 f)))

(cond ((and (valid? s1 hash) (valid? s2 hash))

(append (list (make-soln s1 e hash) (make-soln s2 e

hash))

(add-solutions (cdr seq) hash)))

((valid? s1 hash) (append (list (make-soln s1 e hash))

(add-solutions (cdr seq) hash)))

((valid? s2 hash) (append (list (make-soln s2 e hash))

(add-solutions (cdr seq) hash)))

(else (append (list e) (add-solutions (cdr seq)

hash)))))))

(define (solve solutions solutions-count hash iterations)

(let* ((new-solutions (add-solutions solutions hash))

(new-count (hash-table-size hash)))

(if (= solutions-count new-count)

(begin

(display (format "Iterations == ~a~%" iterations))

(display new-solutions)

(newline)

new-solutions)

(solve new-solutions new-count hash (+ iterations 1)))))

(let ((hash (make-hash-table)))

(hash-table-set! hash 1 #t)

((solve '((1)) 1 hash 1)

(display (format " Solutions == ~a~%" (hash-table-size hash)))

(hash-table-keys hash))

IanO