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 goatThe 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)))))))))