path: root/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week7

CS 61A			Week 7 solutions

LAB ASSIGNMENT:

2.62.  Union-set in Theta(n) time.

The key is to realize the differences between union-set and
intersection-set.  The null case for union-set will be different, because if
one of the sets is empty, the result must be the other set. In the element
comparisons, one element will always be added to the result set.  So the
expressions with the element will be the same as intersection-set, only with
a cons added.  Here's the solution:

(define (union-set set1 set2)
   (cond ((null? set1) set2)
         ((null? set2) set1)
         (else (let ((x1 (car set1)) (x2 (car set2)))
                    (cond ((= x1 x2)
                           (cons x1 (union-set (cdr set1) (cdr set2))))
                          ((< x1 x2)
                           (cons x1 (union-set (cdr set1) set2)))
                          ((< x2 x1)
                           (cons x2 (union-set set1 (cdr set2)))))))))


Trees on page 156:

(define tree1
  (adjoin-set 1
   (adjoin-set 5
    (adjoin-set 11
     (adjoin-set 3
      (adjoin-set 9
       (adjoin-set 7 '())))))))

(define tree2
  (adjoin-set 11
   (adjoin-set 5
    (adjoin-set 9
     (adjoin-set 1
      (adjoin-set 7
       (adjoin-set 3 '())))))))

(define tree3
  (adjoin-set 1
   (adjoin-set 7
    (adjoin-set 11
     (adjoin-set 3
      (adjoin-set 9
       (adjoin-set 5 '())))))))

Other orders are possible; the constraint is that each node must be
added before any node below it.  So in each case we first adjoin the
root node, then adjoin the children of the root, etc.  To make sure
this is clear, here's an alternative way to create tree1:

(define tree1
  (adjoin-set 11
   (adjoin-set 9
    (adjoin-set 5
     (adjoin-set 1
      (adjoin-set 3
       (adjoin-set 7 '())))))))


2.74 (Insatiable Enterprises):

(a)  Each division will have a private get-record operation, so each
division's package will look like this:

(define (install-research-division)
  ...
  (define (get-record employee file)
    ...)
  ...
  (put 'get-record 'research get-record)
  ...)

Then we can write a global get-record procedure like this:

(define (get-record employee division-file)
  ((get 'get-record (type-tag division-file))
   employee
   (contents division-file)))

It'll be invoked, for example, like this:
            (get-record '(Alan Perlis) research-personnel-list)

For this to work, each division's file must include a type tag
specifying which division it is.

If, for example, a particular division file is a sequence of
records, one per employee, and if the employee name is the CAR of 
each record, then that division can use ASSOC as its get-record
procedure, by saying

  (put 'get-record 'manufacturing assoc)

in its package-installation procedure.


(b)  The salary field might be in a different place in each
division's files, so we have to use the right selector based
on the division tag.

(define (get-salary record)
  (apply-generic 'salary record))

Each division's package must include a salary selector, comparable
to the magnitude selectors in the complex number example.

Why did I use GET directly in (a) but apply-generic in (b)?  In the
case of get-salary, the argument is a type-tagged datum.  But in the
case of get-record, there are two arguments, only one of which (the
division file) has a type tag.  The employee name, I'm assuming,
is not tagged.


(c)  Find an employee in any division

(define (find-employee-record employee divisions)
  (cond ((null? divisions) (error "No such employee"))
	((get-record employee (car divisions)))
	(else (find-employee-record employee (cdr divisions)))))

This uses the feature that a cond clause with only one expression
returns the value of that expression if it's not false.


(d)  To add a new division, you must create a package for the division,
make sure the division's personnel file is tagged with the division name,
and add the division's file to the list of files used as argument to
find-employee-record.


4.  Scheme-1 stuff.

(a)  ((lambda (x) (+ x 3)) 5)

Here's how Scheme-1 handles procedure calls (this is a COND clause
inside EVAL-1):

       ((pair? exp) (apply-1 (eval-1 (car exp))      ; eval the operator
                             (map eval-1 (cdr exp)))); eval the args

The expression we're given is a procedure call, in which the procedure
(lambda (x) (+ x 3)) is called with the argument 5.

So the COND clause ends up, in effect, doing this:

	(apply-1 (eval-1 '(lambda (x) (+ x 3))) (map eval-1 '(5)))

Both lambda expressions and numbers are self-evaluating in Scheme-1,
so after the calls to EVAL-1, we are effectively saying

	(apply-1 '(lambda (x) (+ x 3)) '(5))

APPLY-1 will substitute 5 for X in the body of the
lambda, giving the expression (+ 5 3), and calls EVAL-1
with that expression as argument.  This, too, is a procedure call.
EVAL-1 calls itself recursively to evaluate
the symbol + and the numbers 5 and 3.  The numbers are self-evaluating;
EVAL-1 evaluates symbols by using STk's EVAL, so it gets the primitive
addition procedure.  Then it calls APPLY-1 with that procedure and
the list (5 3) as its arguments.  APPLY-1 recognizes that the addition
procedure is primitive, so it calls STk's APPLY, which does the
actual addition.


(b) As another example, here's FILTER:

((lambda (f seq)
   ((lambda (filter) (filter filter pred seq))
    (lambda (filter pred seq)
      (if (null? seq)
	  '()
	  (if (pred (car seq))
	      (cons (car seq) (filter filter pred (cdr seq)))
	      (filter filter pred (cdr seq)))))))
 even?
 '(5 77 86 42 9 15 8))


(c) Why doesn't STk's map work in Scheme-1?  It works for primitives:

	Scheme-1: (map first '(the rain in spain))
	(t r i s)

but not for lambda-defined procedures:

	Scheme-1: (map (lambda (x) (first x)) '(the rain in spain))
	Error: bad procedure: (lambda (x) (first x))

This problem illustrates the complexity of having two Scheme interpreters
coexisting, STk and Scheme-1.  In Scheme-1, lambda expressions are
self-evaluating:

	Scheme-1: (lambda (x) (first x))
	(lambda (x) (first x))

But in STk, lambda expressions evaluate to procedures, which are a different
kind of thing:

	STk> (lambda (x) (first x))
	#[closure arglist=(x) 40179938]

STk's MAP function requires an *STk* procedure as its argument, not a Scheme-1
procedure!  Scheme-1 uses STk's primitives as its primitives, so MAP is happy
with them.  But a Scheme-1 lambda-defined procedure just isn't the same thing
as an STk lambda-defined procedure.


HOMEWORK:

2.75  Message-passing version of make-from-mag-ang :

 (define (make-from-mag-ang r a)
    (lambda (mesg)
       (cond ((eq? mesg 'real-part)  (* r (cos a)))
	     ((eq? mesg 'imag-part)  (* r (sin a)))
	     ((eq? mesg 'magnitude)  r)
	     ((eq? mesg 'angle)      a)
	     (else
	       (error "Unknown op -- Polar form number" mesg)) )) )

Note that the formal parameter names X and Y that the book uses in
make-from-real-imag (p. 186) are relatively sensible because they are
indeed the x and y coordinates of a point in the plane.  X and Y
are confusing as names for polar coordinates!  I used R and A, for
Radius and Angle, but MAGNITUDE and ANGLE would be okay, too.

I could have used an internal definition, as they do, instead of
lambda; the two forms are equivalent.


2.76  Compare conventional, data-directed, and message-passing.

To add a new operator:

First we must write a low-level procedure for that operator for each type,
like (magnitude-rectangular) and (magnitude-polar) if we're adding the
operator magnitude.  (If we're using a package system, we can add a
local definition of MAGNITUDE to each package.)  Then...

For conventional style, we write a generic operator procedure
(magnitude) that invokes the appropriate lower-level procedure
depending on the type of its operand.

For data-directed style, we use PUT to insert entries in the
procedure matrix for each low-level procedure; there is no new
high-level procedure required.

For message-passing style, we modify each of the type dispatch
procedures to accept a new message corresponding to the new
operator, dispatching to the appropriate low-level procedure.

To add a new type:

First we must write a low-level procedure for that type for each
operator, like (real-part-polar), (imag-part-polar),
(magnitude-polar), and (angle-polar) if we're inventing the
polar type.  (If we're using a package system, we can create
a new POLAR package with local definitions of REAL-PART, etc.)
Then...

For conventional style, we modify each of the generic operator
procedures (real-part), (imaginary-part), etc. to know about the
new type, dispatching to the appropriate lower-level procedures.

For data-directed style, we use PUT to insert entries, as for
a new operator.

For message-passing style, we write a new type dispatch procedure
that accepts messages 'real-part, 'imag-part, etc. and dispatches
to the appropriate lower-level procedure.

Which is most appropriate:

Conventional style is certainly INappropriate when many new types
will be invented, because lots of existing procedures need to be
modified.

Similarly, message-passing is INappropriate when many new operators
will be invented and applied to existing types.

Data-directed programming is a possible solution in either case, and is
probably the best choice if both new types and new operators are likely.
It's also a good choice if the number of types or operators is large in
the first place, whether or not new ones will be invented, because it
minimizes the total number of procedures needed (leaving out the generic
dispatch procedures for each type or operator) and thereby reduces the
chances for error.

As you'll see in chapter 3, message-passing style takes on new importance
when a data object needs to keep track of local state.  But you'll see
later in the chapter (mutable data) that there are other solutions to
the local state problem, too.

Message-passing is also sometimes sensible when there are lots of types,
each of which has its own separate set of operators with unique names, so
that a data-directed array would be mostly empty.


2.77

Starting with

          (magnitude '(complex rectangular 3 . 4))

we call MAGNITUDE giving

          (apply-generic  'magnitude  '(complex rectangular 3 . 4))

The apply-generic function (see pg. 184) just uses GET to find the
entry corresponding to 'magnitude and '(complex), and gets the same
function MAGNITUDE that we invoked in the first place.  This
time, however, the argument to MAGNITUDE is (CONTENTS OBJ)
so that the first type flag (COMPLEX) is removed.  In other
words, we end up calling

          (magnitude '(rectangular 3 . 4))
	
Calling the function MAGNITUDE again, this becomes :

	  (apply-generic 'magnitude '(rectangular 3 . 4))
   
The apply-generic function now looks up the entry for 'magnitude and
'(rectangular) and finds the MAGNITUDE function from the RECTANGULAR
package; that function is called with '(3 . 4) as its argument, which
yields the final answer...  (sqrt (square 3) (square 4))  ==>  5


2.79 equ?

(define (equ? a b)
  (apply-generic 'equ? a b))

In the scheme-number package:

  (put 'equ? '(scheme-number scheme-number) =)

In the rational package:

  (define (equ-rat? x y)
    (and (= (numer x) (numer y))
	 (= (denom x) (denom y))))
  ...
  (put 'equ? '(rational rational) equ-rat?)

In the complex package:

  (define (equ-complex? x y)
    (and (= (real-part x) (real-part y))
	 (= (imag-part x) (imag-part y))))
  ...
  (put 'equ? '(complex complex) equ-complex?)

This technique has the advantage that you can compare for equality
a complex number in rectangular form with a complex number in polar
form, since the latter is implicitly converted to rectangular by
equ-complex?.  But it has the disadvantage that when comparing
two complex numbers in polar form, it needlessly does the arithmetic
to convert them both to rectangular coordinates.  (On the other
hand, if you want a polar-specific version of equ?, you have to
remember that the angles can differ by a multiple of 2*pi and the
numbers are still equal!)


2.80 =zero?

(define (=zero? num)
  (apply-generic '=zero? num))

In the scheme-number package:

  (put '=zero? '(scheme-number) zero?)

In the rational package:

  (put '=zero? '(rational)
       (lambda (n) (equ? n (make-rational 0 1))))

In the complex package:

  (put '=zero? '(complex)
       (lambda (n) (equ? n (make-complex-from-real-imag 0 0))))

Of course I could have used internal defines instead of lambda
here.  And of course once we invent raising it gets even easier;
I can just say

(define (=zero? num)
  (equ? num (make-scheme-number 0)))

because then mixed-type equ? calls will be okay.


2.81 Louis messes up again

(a)  This will result in an infinite loop.  Suppose we have two
complex numbers c1 and c2, and we try (exp c1 c2).  Apply-generic
will end up trying to compute

  (apply-generic 'exp (complex->complex c1) c2)

but this is the same as

  (apply-generic 'exp c1 c2)

which is what we started with.


(b)  Louis is wrong.  If we have a complex exponentiation procedure
and we PUT it into the table, then apply-generic won't try to convert
the complex arguments.  And if we don't have a complex exponentiation
procedure, then apply-generic correctly gives an error message; there's
nothing better it can do.

(Once we invent the idea of raising, it would be possible to modify
apply-generic so that if it can't find a function for the given
type(s), it tries raising the operand(s) just in case the operation
is implemented for a more general type.  For instance, if we try to
apply EXP to two rational numbers, apply-generic could raise them to
real and then the version of EXP for the scheme-number type will work.
But it's tricky to get this right, especially when there are two
operands -- should we raise one of them, or both?)

(c)  Nevertheless, here's how it could be done:

              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
		(IF (EQ? TYPE1 TYPE2)
		    (ERROR "CAN'T COERCE SAME TYPES" TYPE1)
		    (let ((t1->t2 (get-coercion type1 type2))
			  (t2->t1 (get-coercion type2 type1)))
		      ...)))


2.83  Implementation of "raise" operators taking numbers to the next
level "up" in the hierarchy -- i.e. the next more general type:

               integer -> rational -> real -> complex

The package system as presented in the text has to be modified a little,
because now instead of having a scheme-number type we want two separate
types integer and real.  So start by imagining we have two separate
packages, one for integer and one for real.

In each package we need an operation to raise that kind of number
to the next type up:

In the integer package:

   (define (integer->rational int)
      (make-rational int 1))
   (put 'raise '(integer) integer->rational)

In the rational package:

   (define (rational->real rat)
      (make-real (/ (numer rat) (denom rat))))
   (put 'raise '(rational) rational->real)

In the real package:

   (define (real->complex Real)
      (make-complex-from-real-imag real 0))
   (put 'raise '(real) real->complex)

And then we can make this global definition:

(define (raise num) (apply-generic 'raise num))

If you want to keep the Scheme-number package, you need a raise method
that distinguishes integers from non-integers internally, which sort of
goes against the whole idea of centralizing the type checking:

   (define (scheme-number->something num)
     (if (integer? num)
	 (make-rational num 1)
	 (make-complex-from-real-imag num 0)))

   (put 'raise '(scheme-number) scheme-number->something)



Scheme-1 MAP:

We're writing a defined procedure in STk that will be a primitive
procedure for Scheme-1.  So we get to use all the features of STk,
but we have to be sure to handle Scheme-1's defined procedures.
(See this week's lab, above, problem 4c.)

(define (map-1 fn seq)
  (if (null? seq)
      '()
      (cons (APPLY-1 FN (LIST (CAR SEQ)))
	    (map-1 fn (cdr seq)))))

The part in capital letters is the only difference between map-1 and the
ordinary definition of map.  We can't just say (FN (CAR SEQ)) the way map
does, because FN might not fit STk's idea of a function, and our procedure is
running in STk, even though it provides a primitive for Scheme-1.

You could make this more complicated by testing for primitive vs. defined
Scheme-1 procedures.  For primitives you could say (FN (CAR SEQ)).  But
since APPLY-1 is happy to accept either a primitive or a lambda expression,
there's no reason not to use it for both.


SCHEME-1 LET:

Here's what a LET expression looks like:

	(LET ((name1 value1) (name2 value2) ...) body)

A good starting point is to write selectors to extract the pieces.

(define let-exp? (exp-checker 'let))

(define (let-names exp)
  (map car (cadr exp))

(define (let-values exp)
  (map cadr (cadr exp))

(define let-body caddr)

As in last week's lab exercise, we have to add a clause to the COND in EVAL-1:

(define (eval-1 exp)
  (cond ((constant? exp) exp)
	((symbol? exp) (error "Free variable: " exp))
	((quote-exp? exp) (cadr exp))
	((if-exp? exp)
	 (if (eval-1 (cadr exp))
	     (eval-1 (caddr exp))
	     (eval-1 (cadddr exp))))
	((lambda-exp? exp) exp)
	((and-exp? exp) (eval-and (cdr exp)))	;; added in lab
	((LET-EXP? EXP) (EVAL-LET EXP))		;; ADDED
	((pair? exp) (apply-1 (car exp)
			      (map eval-1 (cdr exp))))
	(else (error "bad expr: " exp))))

We learned in week 2 that a LET is really a lambda combined with a
procedure call, and one way we can handle LET expressions is just to
rearrange the text to get

	( (LAMBDA (name1 name2 ...) body)  value1 value2 ... )

(define (eval-let exp)
  (eval-1 (cons (list 'lambda (let-names exp) (let-body exp))
		(let-values exp))))

Isn't that elegant?  It's certainly not much code.  You might not like
the idea of constructing an expression just so we can tear it back down
into its pieces for evaluation, so instead you might want to do the
evaluation directly in terms of the meaning, which is to APPLY an
implicit procedure to arguments:

(define (eval-let exp)
  (apply-1 (list 'lambda (let-names exp) (let-body exp))
	   (map eval-1 (let-values exp))))

We still end up constructing the lambda expression, because in this
interpreter, a procedure is represented as the expression that created
it.  (We'll see later that real Scheme interpreters have to represent
procedures a little differently.)  But we don't construct the procedure
invocation as an expression; instead we call apply-1, and we also
call eval-1 for each argument subexpression.



Extra for experts:

First of all, there's no reason this shouldn't work for anonymous
procedures too...

(define (inferred-types def)
  (cond ((eq? (car def) 'define)
	 (inf-typ (cdadr def) (caddr def)))
	((eq? (car def) 'lambda)
	 (inf-typ (cadr def) (caddr def)))
	(else (error "not a definition"))))

Then the key point is that this is a tree recursion.  For an expression
such as (append (a b) c '(b c)) we have to note that C is a list, but
we also have to process the subexpression (a b) to discover that A is
a procedure.

All of the procedures in this program return an association list as
their result.  We start by creating a list of the form

    ((a ?) (b ?) (c ?) (d ?) (e ?) (f ?))

and then create modified versions as we learn more about the types.

(define (inf-typ params body)
  (inf-typ-helper (map (lambda (name) (list name '?)) params) body))

(define (inf-typ-helper alist body)
  (cond ((not (pair? body)) alist)
	((assoc (car body) alist)
	 (inf-typ-seq (typ-subst (car body) 'procedure alist) (cdr body)))
	((eq? (car body) 'map) (inf-map alist body 'list))
	((eq? (car body) 'every) (inf-map alist body 'sentence-or-word))
	((eq? (car body) 'member) (typ-subst (caddr body) 'list alist))
	((memq (car body) '(+ - max min)) (seq-subst (cdr body) 'number alist))
	((memq (car body) '(append car cdr)) (seq-subst (cdr body) 'list alist))
	((memq (car body) '(first butfirst bf sentence se member?))
	 (seq-subst (cdr body) 'sentence-or-word alist))
	((eq? (car body) 'quote) alist)
	((eq? (car body) 'lambda) (inf-lambda alist body))
	(else (inf-typ-seq alist (cdr body)))))

(define (typ-subst name type alist)
  (cond ((null? alist) '())
	((eq? (caar alist) name)
	 (cons (list name
		     (if (or (eq? (cadar alist) '?)
			     (eq? (cadar alist) type))
			 type
			 'x))
	       (cdr alist)))
	(else (cons (car alist) (typ-subst name type (cdr alist))))))

(define (inf-typ-seq alist seq)
  (if (null? seq)
      alist
      (inf-typ-seq (inf-typ-helper alist (car seq)) (cdr seq))))

(define (inf-map alist body type)
  (if (pair? (cadr body))
      (inf-typ-helper (typ-subst (caddr body) type alist)
		      (cadr body))
      (typ-subst (cadr body) 'procedure (typ-subst (caddr body) type alist))))

(define (seq-subst seq type alist)
  (cond ((null? seq) alist)
	((pair? (car seq))
	 (seq-subst (cdr seq) type (inf-typ-helper alist (car seq))))
	(else (seq-subst (cdr seq) type (typ-subst (car seq) type alist)))))

(define (inf-lambda alist exp)
  ((repeated cdr (length (cadr exp)))
   (inf-typ-helper (append (map (lambda (name) (list name '?)) (cadr exp))
			   alist)
		   (caddr exp))))



Note -- the check for lambda in inf-typ-helper is meant to handle cases
like the following:

> (inferred-types
    '(lambda (a b) (map (lambda (a) (append a a)) b)))
((a ?) (b list))

The (append a a) inside the inner lambda does NOT tell us anything
about the parameter A of the outer lambda!