O
oversby
I was working on trying to solve the MU puzzle from the
Godel Escher Bach book
http://en.wikipedia.org/wiki/Gödel,_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
Godel Escher Bach book
http://en.wikipedia.org/wiki/Gödel,_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
