SOLUTIONS FOR EXERCISE SET #8

1. Define a Scheme procedure arity that takes any number of arguments and returns the number of arguments it is given.

(define arity
  (lambda args
    (length args)))
2. Define a Scheme procedure display-integer-in-field that takes two arguments, an integer n and a natural number minimum-field-width, and displays n in a field of no fewer than minimum-field-width columns, padding it with spaces on the left if necessary to bring it up to the specified width. (If the numeral for the integer requires more than the specified number of columns, the procedure should display it in full anyway.)

Next, modify the procedure so that it can (optionally) take a third argument indicating the port to which the output should be written. If only two arguments are supplied, the procedure should write the output to the current output port.

Here's the basic version:

(define display-integer-in-field
  (lambda (n minimum-field-width)
    (let ((actual-width (string-length (number->string n))))
      (if (< actual-width minimum-field-width)
          (display (make-string (- minimum-field-width
                                   actual-width)
                                #\space)))
      (display n))))
And here is the version with the optional port argument:

(define display-integer-in-field
  (lambda (n minimum-field-width . optional)
    (let ((actual-width (string-length (number->string n)))
          (port (if (null? optional)
                    (current-output-port)
                    (car optional))))
      (if (< actual-width minimum-field-width)
          (display (make-string (- minimum-field-width
                                   actual-width)
                                #\space)
                   port))
      (display n port))))
3. Define a Scheme procedure vector-sum that returns the sum of the elements of a given vector of numbers.

(define vector-sum
  (lambda (vec)
    (let ((len (vector-length vec))
          (result 0))        
      (do ((index 0 (+ index 1)))
          ((= index len) result)
        (set! result (+ result (vector-ref vec index)))))))
4. Define a Scheme procedure add-vectors that takes two vectors of numbers, equal in length, as arguments and returns a vector containing their (componentwise) sum. For example, the call (add-vectors '#(3 5 7 9) '#(3 1 4 1)) should return #(6 6 11 10).

(define add-vectors
  (lambda (vec-1 vec-2)
    (let* ((len (vector-length vec-1))  ; The vectors should
                                        ; have the same length.
           (result (make-vector len)))
      (do ((index 0 (+ index 1)))
          ((= index len) result)
        (vector-set! result index
                     (+ (vector-ref vec-1 index)
                        (vector-ref vec-2 index)))))))
5. Define a Scheme procedure vector-map that takes as arguments a procedure proc of arity 1 and a vector vec and returns a vector, of the same length as vec, in which the elements are constructed by applying proc to the corresponding elements of vec. For example, the call (vector-map odd? '#(3 1 4 1 6)) should return #(#t #t #f #t #f).

(define vector-map
  (lambda (proc vec)
    (let* ((len (vector-length vec))
           (result (make-vector len)))
      (do ((index 0 (+ index 1)))
          ((= index len) result)
        (vector-set! result index
                     (proc (vector-ref vec index)))))))
6. Define a Scheme procedure vector-append that takes any number of arguments, each of which must be a vector, and returns a single vector containing all of the elements of all the given vectors, in effect concatenating those vectors.

(define vector-append
  (lambda vecs
    (let* ((len (apply + (map vector-length vecs)))
           (result (make-vector len)))
      (let loop ((result-index 0)
                 (source-index 0)
                 (rest-of-vecs vecs))
        (cond ((null? rest-of-vecs) result)
              ((= source-index (vector-length (car rest-of-vecs)))
               (loop result-index 0 (cdr rest-of-vecs)))
              (else
               (vector-set! result result-index
                            (vector-ref (car rest-of-vecs) source-index))
               (loop (+ result-index 1) (+ source-index 1) rest-of-vecs)))))))

7. The file /u2/stone/events/scheme-workshop/examples/gps.scm contains the source code for a sketchy version of Newell and Simon's General Problem Solver. Examine this program and describe the problem-solving strategy that the General Problem Solver uses.

It considers each component of the goal state in turn. If such a goal is already part of the current state, it does nothing; otherwise, it identifies the operations that might bring about that goal and attempts to apply each one in turn until it finds one that works. In attempting to apply an operation, it first determines what preconditions must be satisfied in order for the goal to be achieved and then treats those preconditions as subgoals, recursively attempting to satisfy them. If the preconditions for the operation cannot be satisfied, the GPS backs off and tries another operation that would, if accomplished produce the goal; if it runs out of operations to try, it abandons the goal and reports that it can find no solution.

8. A hungry monkey is in a room that contains a bunch of bananas, suspended from the ceiling (out of the monkey's reach) by a rope, and a chair, light enough to be moved. The bananas are in the middle of the room, while the chair is against the north wall, far enough from the middle of the room that the monkey cannot reach the bananas even by standing on the chair if it remains in its current position. Select a set of operations available to the monkey and a set of conditions that can be used to describe various states of the monkey's environment. Describe the initial state and the goal state in terms of these conditions. Submit the data to the GPS procedure and see whether it can solve the monkey's problem (its goal is not to be hungry).

GPS can solve the problem when it is presented in the following form:

(define *monkey-ops*
  (list
   (make-op "eat some bananas"
            '(hungry bananas-in-hand)
            '(not-hungry hands-empty)
            '(hungry bananas-in-hand))
   (make-op "grab the bananas"
            '(hands-empty chair-in-middle-of-room on-chair)
            '(bananas-in-hand)
            '(hands-empty))
   (make-op "climb onto the chair"
            '(on-floor)
            '(on-chair)
            '(on-floor))
   (make-op "push the chair from the north wall to the middle of the room"
            '(hands-empty on-floor at-north-wall chair-at-north-wall)
            '(in-middle-of-room chair-in-middle-of-room)
            '(at-north-wall chair-at-north-wall))
   (make-op "go to the north wall"
            '(on-floor)
            '(at-north-wall)
            '(at-center-of-room at-east-wall at-south-wall at-west-wall))
   (make-op "go to the east wall"
            '(on-floor)
            '(at-east-wall)
            '(at-center-of-room at-north-wall at-south-wall at-west-wall))
   (make-op "go to the south wall"
            '(on-floor)
            '(at-south-wall)
            '(at-center-of-room at-north-wall at-east-wall at-west-wall))
   (make-op "go to the west wall"
            '(on-floor)
            '(at-west-wall)
            '(at-center-of-room at-north-wall at-east-wall at-south-wall))
   (make-op "go to the center of the room"
            '(on-floor)
            '(at-center-of-room)
            '(at-north-wall at-east-wall at-south-wall
                            at-west-wall))))
> (gps '(hungry on-floor at-west-wall hands-empty
                chair-at-north-wall)
       '(not-hungry)
       *monkey-ops*)
go to the north wall
push the chair from the north wall to the middle of the room
climb onto the chair
grab the bananas
eat some bananas
#
9. A man wishes to transport a wolf, a goat, and a cabbage across a river. He finds a sound boat that he can row easily, but there is room in the boat for only one of the three pieces of freight (and the man). The wolf and the goat may not be left together on the same side of the river in the absence of the man, since the wolf would then eat the goat. Similarly, the goat and the cabbage may not be left together on the same side of the river, since the goat would eat the cabbage. The problem is to find a way for the man to get all three items across the river. It is acceptable for the boat to be left on the bank opposite the one it starts out on.

Can GPS solve this problem? It depends on details of the way the operations are defined. What operations would you provide in order to enable GPS to solve the problem?

GPS can solve the problem when it is presented in this form:

(define *river-ops*
  (list
   (make-op "cross left to right with goat" '(MG) '(empty) '(MG))
   (make-op "cross right to left alone" '(G) '(MG) '(G))
   (make-op "cross left to right with wolf" '(MWG) '(G) '(MWG))
   (make-op "cross right to left with goat" '(W) '(MWG) '(W))
   (make-op "cross left to right with cabbage" '(MWC) '(W) '(MWC))
   (make-op "cross right to left alone" '(WC) '(MWC) '(WC))
   (make-op "cross left to right with goat" '(MWGC) '(WC) '(MWGC))
   (make-op "cross left to right alone" '(MWGC) '(WGC) '(MWGC))
   (make-op "cross left to right alone" '(MWG) '(WG) '(MWG))
   (make-op "cross left to right alone" '(MWC) '(WC) '(MWC))
   (make-op "cross left to right alone" '(MW) '(W) '(MW))
   (make-op "cross left to right alone" '(MGC) '(GC) '(MGC))
   (make-op "cross left to right alone" '(MG) '(G) '(MG))
   (make-op "cross left to right alone" '(MC) '(C) '(MC))
   (make-op "cross left to right alone" '(M) '(empty) '(M))
   (make-op "cross right to left alone" '(WGC) '(MWGC) '(WGC))
   (make-op "cross right to left alone" '(WG) '(MWG) '(WG))
   (make-op "cross right to left alone" '(W) '(MW) '(W))
   (make-op "cross right to left alone" '(GC) '(MGC) '(GC))
   (make-op "cross right to left alone" '(empty) '(M) '(empty))
   (make-op "cross left to right with cabbage" '(MWGC) '(WG) '(MWGC))
   (make-op "cross left to right with cabbage" '(MGC) '(G) '(MGC))
   (make-op "cross left to right with cabbage" '(MC) '(empty) '(MC))
   (make-op "cross right to left with cabbage" '(WG) '(MWGC) '(WG))
   (make-op "cross right to left with cabbage" '(W) '(MWC) '(W))
   (make-op "cross right to left with cabbage" '(G) '(MGC) '(G))
   (make-op "cross right to left with cabbage" '(empty) '(MC) '(empty))
   (make-op "cross left to right with goat" '(MWG) '(W) '(MWG))
   (make-op "cross left to right with goat" '(MGC) '(C) '(MGC))
   (make-op "cross right to left with goat" '(WC) '(MWGC) '(WC))
   (make-op "cross right to left with goat" '(C) '(MGC) '(C))
   (make-op "cross right to left with goat" '(empty) '(MG) '(empty))
   (make-op "cross left to right with wolf" '(MWGC) '(GC) '(MWGC))
   (make-op "cross left to right with wolf" '(MWC) '(C) '(MWC))
   (make-op "cross left to right with wolf" '(MW) '(empty) '(MW))
   (make-op "cross right to left with wolf" '(GC) '(MWGC) '(GC))
   (make-op "cross right to left with wolf" '(G) '(MWG) '(G))
   (make-op "cross right to left with wolf" '(C) '(MWC) '(C))
   (make-op "cross right to left with wolf" '(empty) '(MW) '(empty))))
> (GPS '(MWGC) '(empty) *river-ops*)
cross left to right with goat
cross right to left alone
cross left to right with cabbage
cross right to left with goat
cross left to right with wolf
cross right to left alone
cross left to right with goat
The state symbols indicate which items (man, wolf, goat, cabbage) are on the left bank of the river at any given point.

Unfortunately, this representation does not prevent the construction of false solutions or blind alleys if the operations happen to be presented in a different order. GPS regards it as perfectly sensible, for instance, to transfer the wolf, the goat, and the cabbage in successive left-to-right trips, even though the goat would eat the cabbage during the first trip and the wolf would eat the goat during the third trip. This can be corrected with a complicated series of locking preconditions, so that no operation that would result in a meal could be unlocked, but it's tricky and still does not address the problem of blind alleys.

10. The current version of the GPS can fail to find a solution even when one is available because it tries the goals in a fixed order. It can happen that achieving goal A consumes one of the preconditions for achieving goal B, thus blocking a solution that would be found if goal B were attempted first. Add backtracking to the GPS so that when one approach fails, GPS backs up and tries to achieve a different goal first.

Modify the achieve-all procedure as follows:

;; Given a list of goals, an initial state, and a list of
;; state-transforming operations, the achieve-all procedure
;; attempts to achieve one or another of the goals, trying
;; them in succession until it finds one that is achievable;
;; then it constructs the set of goals that have not yet
;; been achieved in the resulting state and calls itself
;; recursively to achieve all of them.  If the set of
;; unachieved goals ever becomes empty, the procedure
;; returns the final state and the sequence of operations by
;; which the goals were achieved.

(define achieve-all
  (lambda (goals initial-state operations)
    (if (null? goals)
        (cons initial-state '())
        (let loop ((chosen (car goals))
                   (alternatives (cdr goals)))
          (let ((first-part (achieve chosen initial-state
                                     operations)))
            (if first-part
                (let* ((new-state (car first-part))
                       (rest-part
                        (achieve-all (set-difference goals new-state)
                                     new-state
                                     operations)))
                  (if rest-part
                      (cons (car rest-part)
                            (append (cdr first-part)
                                    (cdr rest-part)))
                      (if (null? alternatives)
                          #f
                          (loop (car alternatives)
                                (cdr alternatives)))))
                (if (null? alternatives)
                    #f
                    (loop (car alternatives)
                          (cdr alternatives)))))))))

created June 20, 1996
last revised June 20, 1996

John David Stone (stone@math.grin.edu)