2023-02-03         List and lists

 I stumbled  across this text  adventure called "Lists  and Lists"[1]
 for  the Z-machine[2]  by Andrew  Plotkin  where a  genie gives  you
 coding problems  and you  have to  solve them  in a  very restricted
 Scheme environment. The  genie then checks your  progress by running
 some tests with  random inputs. It was a fun  challenge so I decided
 to document  my solutions.  The text  adventure part  is practically
 non-existent.  When you  have gained  acces to  the computer  (after
 opening the  door, smashing the  glass box and answering  "yes") the
 game-loop looks this:

   turn on computer
   >>'(write scheme code)
   :q
   check

 There is a manual included which is very helpful because it's really
 a bare-bones Scheme implementation which even lacks a multiplication
 function. Of  course I wrote most  of the solutions in  Emacs. I had
 the game running in an *ansi-term*  buffer and simply pasted my code
 into  it  (C-c  C-j  enters the  `term-line-mode`  where  all  Emacs
 keybindings are present). Here it goes:




 ;; GENIE:  Your first  problem  is  just to  acquaint  you with  the
 ;; system. Start up the machine,  and define twentyseven to have the
 ;; value  27. You  can  ask  me to  'check'  when  you're ready,  or
 ;; 'repeat' the problem if you need me to.

 (define twentyseven 27)

 ;; GENIE: Let's try  creating some lists. Define values  for cat and
 ;; dog so  that cat and  dog are  equal? but not  eqv?. Furthermore,
 ;; cdr(cat) and cdr(dog) must be eqv?.

 (define dog '(5))
 (define cat '(5))

 ;; GENIE:  Perfect!  There  are  actually two  ways  to  solve  this
 ;; problem.  You used  the simpler  one, using  one-term lists.  The
 ;; trickier solution would be something like this:

 ;; (define tail '(end))
 ;; (define cat (cons 'head tail))
 ;; (define dog (cons 'head tail))

 ;; The cdrs are eqv? because they  are both the thing defined on the
 ;; first line. See?"

 ;; GENIE: Define abs to be the absolute value function for integers.
 ;; That is, (abs  4) should return 4; (abs -5)  should return 5; and
 ;; (abs 0) should return 0.

 (define abs (lambda (x)
               (cond ((< x 0) (- x))
                     (t x))))

 ;; GENIE:  Define sum  to  be a  function  that adds  up  a list  of
 ;; integers. So (sum '(8 2 3))  should return 13. Make sure it works
 ;; correctly for the empty list; (sum nil) should return 0.

 (define cadr (lambda (x)
                (car (cdr x))))

 (define sum (lambda (ls)
               (cond ((null? ls) 0)
                     ((= (length ls) 2) (+ (car ls) (cadr ls)))
                     (t (+ (car ls) (sum (cdr ls)))))))

 ;; GENIE:  This problem  is like  the  last one,  but more  general.
 ;; Define megasum to add up  an arbitrarily nested list of integers.
 ;; That is, (megasum '((8) 5 (2 () (9 1) 3))) should return 28.

 (define megasum (lambda (ls)
               (cond ((null? ls) 0)
                     ((not (list? (car ls))) (+ (car ls)
                                                (megasum (cdr ls))))
                     (t (+ (megasum (car ls))
                           (megasum (cdr ls)))))))

 ;; GENIE: Define  max to be a  function that finds the  maximum of a
 ;; list of integers.  So (max '(5 14 -3)) should  return 14. You can
 ;; assume the list will have at least one term.

 (define max-rec (lambda args
                  (let ((max-elem (car args))
                        (ls (cadr args)))
                    (cond ((null? ls) max-elem)
                          ((> (car ls) max-elem) (max-rec (car ls) (cdr ls)))
                          (t (max-rec max-elem (cdr ls)))))))

 (define max (lambda (ls) (max-rec (car ls) ls)))

 ;; GENIE: Last  problem. You're  going to  define a  function called
 ;; pocket. This function should take one argument. Now pay attention
 ;; here:  pocket  does  two   different  things,  depending  on  the
 ;; argument. If  you give it nil  as the argument, it  should simply
 ;; return 8. But  if you give pocket any integer  as an argument, it
 ;; should  return a  new pocket  function  -- a  function just  like
 ;; pocket, but with that new integer hidden inside, replacing the 8.

 ;;  >>(pocket nil)
 ;;  8
 ;;  >>(pocket 12)
 ;;  [function]
 ;;  >>(define newpocket (pocket 12))
 ;;  [function]
 ;;  >>(newpocket nil)
 ;;  12
 ;;  >>(define thirdpocket (newpocket 3))
 ;;  [function]
 ;;  >>(thirdpocket nil)
 ;;  3
 ;;  >>(newpocket nil)
 ;;  12
 ;;  >>(pocket nil)
 ;;  8

 ;; Note that when you create a new pocket function,
 ;; previously-existing functions should keep working.

 (define pocket-gen (lambda (x)
                  (letrec
                      ((f (lambda (y)
                            (cond ((null? y) x)
                                  (t (pocket-gen y))))))
                    f)))

 (define pocket (lambda (a)
                  (cond ((null? a) 8)
                        (t (pocket-gen a)))))




 APPENDIX

 My  first solution  to `megasum`  actually looked  different. I  was
 convinced that I  had to use `sum` from the  *last* problem to solve
 *this* problem so  I had to define some common  scheme functions not
 present in  the environment.  All the  time I  was thinking  that my
 solution was over-engineered  and sure it was.  After thinking about
 it for a few days I just modified `sum` to work for nested lists.

 (define append (lambda args
                  (let ((ls (car args))
                        (tail (cadr args)))
                    (cond ((null? ls) tail)
                          (t (cons (car ls)
                                   (append (cdr ls) tail)))))))

 (define flatten (lambda (ls)
                   (cond ((null? ls) '())
                         ((list? (car ls)) (append (flatten (car ls))
                                                   (flatten (cdr ls))))
                         (t (cons (car ls)
                                  (flatten (cdr ls)))))))

 (define megasum (lambda (ls) (sum (flatten ls))))


 The final  problem actually took me  a while to understand.  I tried
 many approaches but  always ended up where I began.  Then I actually
 read the included manual page about `letrec` and came quite close to
 the solution but the tests still failed. I was a bit frustrated so I
 wrote  this brain-dead  version of  the pocket  function which  only
 works for  three nesting-levels. Since  the genie doesn't  check any
 further  I finally  beat the  "game"  but of  course I  was not  yet
 satisfied. So a few days later I'm laying on the couch as I get this
 funny  idea.  I pull  out  my  laptop, make  a  final  change to  my
 `letrec`-version  of the  pocket  function and,  lo  and behold,  it
 works. XD

 (define pocket (lambda (a)
                  (cond ((null? a) 8)
                        (t (lambda (b)
                             (cond ((null? b) a)
                                   (t (lambda (c)
                                        (cond ((null? c) b)
                                              (t 'fuck))))))))))


Footnotes
_________

[1] https://ifdb.org/viewgame?id=zj3ie12ewi1mrj1t

[2]  https://en.wikipedia.org/wiki/Z-machine
    I used the program  `frotz`  from the Ubuntu/Debian repository
    to run the game

You are viewing proxied material from tilde.club. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.