|
The code below runs on MIT Scheme with some modifications. First, the
slib distribution must be available, as it is on boole. You
can get this distribution here. Untar it in an
accessible place on your machine. You will get a directory called
slib with a lot of Scheme and help files. Assuming you are using unix
and the path to slib is /usr/local/lib/slib, you can
put a copy of this file into your home
directory as .scheme.init (notice there are two "dots"). You
may have to edit all occurrences of /usr/local/lib/slib in
the file to whatever the path to slib is on your machine. You may
also have to change all occurences of
/usr/local/lib/mit-scheme to match the path of the MIT Scheme
libraries if that is installed in a non-standard place on your
machine. Users of boole only have to worry about getting the
.scheme.init file and placing it in their home directory.
When Scheme runs it should automatically load the proper library files. Thus, you should see something very close to this when you run MIT scheme:
Scheme Microcode Version 11.151 MIT Scheme running under Linux Type `^C' (control-C) followed by `H' to obtain information about interrupts. Scheme saved on Sunday October 18, 1998 at 11:02:46 PM Release 7.4.7 Microcode 11.151 Runtime 14.168 ;Loading "/home/franco/.scheme.init" ;Loading "/usr/local/lib/slib/require.scm" -- done ;Loading "/usr/local/lib/slib/mbe.scm" ;Loading "/usr/local/lib/slib/comlist.scm" -- done ;Loading "/usr/local/lib/slib/defmacex.scm" -- done -- done -- done 1 ]=>If not, either you do not have slib installed, or you do not have .scheme.init, or the location of .scheme.init does not match what is given in .scheme.init, or you do not have write permission to the directory containing the MIT Scheme libraries (e.g. /usr/local/lib/mit-scheme). If you are using Windows instead of unix, consider taking this opportunity to switch to unix and contact Red Hat or Debian for a recent copy of GNU/Linux. Now cut out and save the code below in a file named after your favorite politician. I named mine hillary.ss because she will probably run for the senate soon. Then, in Scheme do this:
1 ]=> (load "hillary.ss") ;Loading "hillary.ss" -- done ;Value: puzzle 1 ]=> (puzzle) Parent 1 is a female, Parent 2 is a male, Kid is a female ;Unspecified return valueDont't worry about the "unspecified return value" as it was sacrificed to get a more readable output. For a second example, click here. |
;;;
;;; Implementation of amb
;;;
(define amb-fail (lambda () (error "amb tree exhausted")))
(define-syntax amb
(syntax-rules ()
((amb alt ...)
(let ((prev-amb-fail amb-fail))
(call-with-current-continuation (lambda (sk)
(call-with-current-continuation (lambda (fk)
(set! amb-fail (lambda ()
(set! amb-fail prev-amb-fail)
(fk 'fail)))
(sk alt)))
...
(prev-amb-fail)))))))
;;; Example: Kaloton Puzzle
;;; The Kalotans are a tribe with a peculiar quirk: their males always
;;; tell the truth. Their females never make two consecutive true
;;; statements, or two consecutive untrue statements.
;;;
;;; An anthropologist (let's call him Worf) has begun to study them.
;;; Worf does not yet know the Kalotan language. One day, he meets a
;;; Kalotan (heterosexual) couple and their child Kibi (also called "kid").
;;; Worf asks the kid: ``Are you a boy?'' The kid answers in Kalotan,
;;; which of course Worf doesn't understand.
;;;
;;; Worf turns to the parents (who know English) for explanation. One
;;; of them says: "Kibi said: `I am a boy.'" The other adds: "Kibi is a
;;; girl. Kibi lied."
;;;
;;; Solve for the sex of the parents and Kibi.
;;;
;;; Required Helper Procedures -
;;; (assert pred) - forces pred to be true
;;;
(define assert
(lambda (pred)
(if (not pred) (amb))))
;;; (distinct? lst) - #t iff all objects in lst are different
;;;
(define distinct?
(lambda (l)
(if (or (null? l) (null? (cdr l)))
#t
(letrec ((is-there? (lambda (l^ token)
(if (null? l^)
'()
(if (eq? token (car l^))
#t
(is-there? (cdr l^) token))))))
(if (is-there? (cdr l) (car l))
'()
(distinct? (cdr l)))))))
;;; (xor p1 p2) - p1 and not p2 or not p1 and p2
;;;
(define xor
(lambda (p1 p2)
(or (and (not p1) p2) (and p1 (not p2)))))
;;;
;;; Solution to the puzzle using "amb"
;;;
(define puzzle
(lambda ()
(let ((parent1 (amb 'male 'female))
(parent2 (amb 'male 'female))
(kid (amb 'male 'female))
(kid-said (amb 'male 'female))
(kid-lied? (amb #t #f)))
(assert
(distinct? (list parent1 parent2)))
(assert
(if (eq? kid 'male)
(not kid-lied?)))
(assert
(if kid-lied?
(xor
(and (eq? kid-said 'male)
(eq? kid 'female))
(and (eq? kid-said 'female)
(eq? kid 'male)))))
(assert
(if (not kid-lied?)
(xor
(and (eq? kid-said 'male)
(eq? kid 'male))
(and (eq? kid-said 'female)
(eq? kid 'f)))))
(assert
(if (eq? parent1 'male)
(and
(eq? kid-said 'male)
(xor
(and (eq? kid 'female)
(eq? kid-lied? #f))
(and (eq? kid 'male)
(eq? kid-lied? #t))))))
(assert
(if (eq? parent1 'female)
(and
(eq? kid 'female)
(eq? kid-lied? #t))))
(display " Parent 1 is a ")(display parent1)
(display ", Parent 2 is a ")(display parent2)
(display ", Kid is a ")(display kid))))