When the definition of a procedure includes a call to that same procedure, the call is said to be recursive. Under what conditions is such a call said to be tail-recursive? Give an example of a tail-recursive procedure call.
What output, if any, is generated when the expression
(do ((outer 0 (+ outer 1)))
((= outer 5))
(do ((inner outer (+ inner 1)))
((= inner 5) (newline))
(display (+ outer inner))))
is evaluated?
Here's the definition of a metaprogramming procedure:
(define meta-mystery
(lambda (expression)
(list 'begin
(list 'write (list 'quote expression))
(list 'display " ===> ")
(list 'write expression)
(list 'newline))))
(a) What is the value of the procedure call (meta-mystery '(+
3 5))?
(b) Explain in thirty words or less what the
meta-mystery procedure does. (The word limit is for real and
is intended to force you to give a high-level description rather than a
trace of the execution of the procedure.)
The following procedure is supposed to take the name of an existing file as argument and return a vector of 256 integers, one for each character that might occur in the file. The element in position k of the vector should indicate how many times the character with ASCII code k occurred in the file. However, when this procedure is put to work on any non-empty file, it never returns. Account for this misbehavior and suggest a way to correct the the error that produced it.
(define spectrum-of-file
(lambda (file-name)
(let ((source (open-input-file file-name))
(spectrum (make-vector 256 0)))
(do ((ch (read-char source) ch))
((eof-object? ch) (close-input-port source) spectrum)
(let ((index (char->integer ch)))
(vector-set! spectrum index
(+ (vector-ref spectrum index) 1))
(read-char source))))))
Here is a procedural abstraction for deep recursion, operating on trees:
(define deep-recur
(lambda (seed item-proc list-proc)
(lambda (tree)
(let recur ((rest tree))
(if (null? rest)
seed
(let ((first (car rest)))
(if (list? first)
(list-proc (recur first) (recur (cdr rest)))
(item-proc first (recur (cdr rest))))))))))
The first argument, seed, is the value that the recurrence
should return when given an empty tree. The second,
item-proc, is a procedure of two arguments that the recurrence
should invoke to combine a leaf of the tree with the result of a recursive
call on other subtrees. The third, list-proc, is a procedure
of two arguments (possibly, though not necessarily, the same as
list-proc) that the recurrence should invoke to combine the
result of a recursive call on a leading subtree with the result of a
recursive call on other subtrees.
The value returned by deep-recur is a procedure that traverses
the structure of a tree, applying item-proc and
list-proc as necessary. For instance, the call
(deep-recur 0 + +) procedure that finds the sum of the leaves
in a tree of numbers.
(a) Describe the effect of invoking the procedure that is the value
of the expression (deep-recur null cons append)
(b) Describe the effect of invoking the procedure that is the value of the expression
(deep-recur 0
(lambda (a b)
(max (string-length a) b))
max)
(c) Describe the effect of invoking the procedure that is the value of the expression
(deep-recur null
(lambda (a b)
(cons (+ a 1) b))
cons)
What preconditions, if any, does the primitive assoc procedure
impose on its arguments?
Suppose you want to define small-roots to be a seven-element
vector containing the square roots of the integers 2 through 8. Which of
the following definitions would you use? Why?
;; definition (a) (define small-roots '#((sqrt 2) (sqrt 3) (sqrt 4) (sqrt 5) (sqrt 6) (sqrt 7) (sqrt 8))) ;; definition (b) (define small-roots (vector (sqrt 2) (sqrt 3) (sqrt 4) (sqrt 5) (sqrt 6) (sqrt 7) (sqrt 8)))
What is the value of the DrScheme expression (make-object color% 255
0 255)?
The following procedure is supposed to take a binary predicate as its
argument and return its converse -- a similar binary predicate that
takes the arguments in the opposite order. (For instance,
<= is the converse of >=.)
(define converse
(lambda (predicate)
(lambda (right left)
(predicate right left))))
But it doesn't work correctly -- for instance, ((converse >=) 3
5) is #f, but it should be #t. Explain
what has gone wrong and suggest a way to correct the error.
Suppose that I have a Scheme program in the file
log-summary.ss in my current directory. This program manages
its own input and output, and I want to run it as a standalone. What
command would I type in the terminal-emulator window to get MzScheme to run
the program?
What is the value of the Scheme expression (call-with-values values
list)?
Suppose that you have a list of five hundred objects of the
tally% class that we developed in lab, and you want to sort
them into descending order by their contents, so that the tally with the
greatest contents is at the beginning of the resulting list and the tally
with the least contents is at the end.
(a) What sorting algorithm would you use?
(b) Define or describe the Scheme predicate that would implement the ordering relation.
Explain the difference between a let-expression and a
letrec-expression.
The program shown below was recently posted to the Usenet newsgroup comp.lang.lisp. Read the program and make some judicious and constructive comments on its style, content, structure, and presentation. (It may help to imagine that you are teaching Scheme to the author of the program. If he submitted this as an exercise, how would you assess it?)
Note. The author regularly uses a shorthand form for procedure
definitions. If what appears after the keyword define is a
list rather than an identifier -- for instance,
(define (name first second third) ;; body of procedure )
the effect is to define a procedure name with arguments
first, second, and third, exactly as
if the definition had the form
(define name
(lambda (first second third)
;; body of procedure
))
Although we never encountered this contracted syntax (it is not quite as flexible as the full form, so the authors of our textbook and I avoided it), it is permitted in standard Scheme and is not uncommon in Scheme programming, so the author of the program below should not be faulted for using it.
;;; Shallow Gray Scale, a Mancala engine by jason libsch
;;; Distribute freely; I ask only to have my name left in.
;;; If you like it, e-mail me! jlibsch@wesleyan.edu
;; The rules to Mancala are relatively simple. A player chooses a pit from which to
;; move, takes all of the stones out of the pit, and drops them sequentially one at a
;; time into the next pits going counter clockwise around the board.
;;
;; A player may only choose to move a stone from his side of the board (pits 8 through
;; 14), and may not choose to move from his score pit.
;;
;; If the last stone to fall from his hand lands in an empty pit, it is taken out and
;; put in his scoring pit. Also, if the pit across the board from this pit has any
;; stones in it, these too are put in the score pit of the player whose move it is.
;;
;; The computer's score pit is pit 7. Your score pit is pit 14.
;;
;; This is always the case, unless the last stone happens to fall into the scoring pit.
;; In this case, none of the others players stones are taken. Instead a free move is
;; given.
;;
;; The game is over when one side has no more leagle moves. The winner is the player
;; with the most stones on his side.
;;
;; To begin playing type (mancala start <depth> <side>), where depth is how many moves
;; ahead the computer looks. This number must be atleast 1. <side> should be 1 if you
;; want the computer to go first, -1 if you want to go first. (You should still play
;; the top half of the board though)
;;
;; Have fun! (And good luck too!)
;;
;; (If you are interested in what the computer is thinking try traceing
;; "map-what-to-move?" "stregnth-tree" and "prune" (prune especially- tells how strong
;; it will be after moving from each pit.)
;; (Sorry about all the spelling errors!)
;; (If you are able to beat it on the first few levels (1-3 or so) don't worry if you
;; move to level 5 or 6 and it takes a long time to think. The time will cut down
;; drasticly as the game progresses and fewer possible moves exist.)
;; (Hint: It's much harder to beat if you go first!)
;; (It turns out that the weight of the pit in the module side-stregnth is verry
;; importaint in determining how the computer plays. I have found, and this makes alot
;; of sense, that the further ahead it looks (larger depth) the less these pits should
;; be weighted, this is becuase the weights are just me telling the computer how to
;; choose according to intuition, but if the computer is looking far ahead it knows,
;; and should not be working from intuition. So i have changed the weights once again.
;; It is now more difficult to beat at higher levels but easier at lower levels.
;; (Compare level 3 to level 4!) )
;--------------------------------------------------------------------------------------
;[*************************The Code***************************************************]
;--------------------------------------------------------------------------------------
(define (position-stregnth position side) ;; side=1 if computer plays first, side=2
(if (over? position) ;; if person
(* side (- (* 1 (in-side (near-side position)))
(* 1 (in-side (far-side position))))
)
(+ (* side (side-stregnth (near-side position)))
(* -1 (* side (side-stregnth (far-side position))))
)
)
)
(define (over? position)
(or (= (- (in-side (near-side position)) (in 7 position)) 0)
(= (- (in-side (far-side position)) (in 14 position)) 0)
)
)
(define (side-stregnth half-pos) ;;this is what is most importain in determining
(+ (* (cadar half-pos) 1) ;;how well the computer plays.
(* (car (cdadr half-pos)) 1)
(* (cadar (cddr half-pos)) .9)
(* (cadar (cdddr half-pos)) .9)
(* (cadar (cdddr (cdr half-pos))) .8)
(* (cadar (cdddr (cddr half-pos))) 1) ;;this square is safe, none can be taken
(* (cadar (cdddr (cdddr half-pos))) 1.1)
)
)
(define (far-side pos)
(far-side-aux pos 0)
)
(define (far-side-aux pos num)
(cond ((= num 14) '())
((> num 6) (cons (car pos) (far-side-aux (cdr pos) (+ num 1))))
(else (far-side-aux (cdr pos) (+ num 1)))
)
)
(define (near-side pos)
(near-side-aux pos 0)
)
(define (near-side-aux pos num)
(if (= num 7) '()
(cons
(car pos)
(near-side-aux (cdr pos) (+ 1 num))
)
)
)
(define (position? lst)
(not (list? (caar lst))))
(define (stregnth-tree tree-o-moves side)
(cond ((null? tree-o-moves) '())
((null? (car tree-o-moves)) '())
((null? (caar tree-o-moves)) '())
((equal? tree-o-moves '(("empty"))) '(empty))
((position? tree-o-moves)
(list (position-stregnth tree-o-moves side)))
(else (cons (stregnth-tree (car tree-o-moves) side)
(stregnth-tree (cdr tree-o-moves) side)))
)
)
(define (prune str-tree)
(if (null? str-tree) '()
(if (empty? (car str-tree))
(cons "empty" (prune (cdr str-tree)))
(cons (prune-aux (car str-tree)) (prune (cdr str-tree)))
)
)
)
(define (prune-aux str-tree)
(if (null? str-tree) 0
(if (empty? str-tree) 0
(if (list? (caar str-tree))
(+ (prune-aux (car str-tree)) (prune-aux (cdr str-tree)))
(+ (if (empty? (caar str-tree)) 0 (caar str-tree))
(prune-aux (cdr str-tree)))
)
)
)
)
(define (what-to-move? current-pos depth side) ;;;side =1, computer goes first
(find-biggest
(prune (stregnth-tree (map-what-to-move? current-pos (+ 1 depth) side) side))
)
)
(define (find-biggest lst)
(find-in-list (car (order lst)) lst)
)
(define (find-in-list element lst)
(if (equal? element (car lst)) 1 (+ 1 (find-in-list element (cdr lst)))))
(define (order lst)
(if (null? lst) '()
(insert (car lst) (order (cdr lst)))))
(define (insert x lst)
(if (null? lst) (list x)
(if (greater x (car lst)) (cons x lst)
(cons (car lst) (insert x (cdr lst)))
)
)
)
(define (greater x y)
(cond ((empty? x) #f)
((empty? y) #T)
(else (> x y))
)
)
(define (find-big-help pos element lst)
(cond ((null? lst) 0)
((= 0 (cadar pos)) (+ 1 (find-big-help (cdr pos) element lst)))
((= element (car lst)) 1)
(else (+ 1 (find-big-help (cdr pos) element (cdr lst))))
)
)
(define empty 0)
(define (empty? lst)
(cond ((or (equal? lst 'empty) (equal? lst "empty")) #t)
((not (list? lst)) #f)
((null? lst) #f)
(else (if (equal? (car lst) 'empty) #t
(empty? (cdr lst))))
)
)
(define (in-side half-pos)
(if (null? half-pos) 0
(+ (cadar half-pos) (in-side (cdr half-pos)))
)
)
(define (map-what-to-move? position depth side)
(if (equal? position '(("empty"))) position
(if (= depth 0) position
(map-what-aux (all-posible position side) depth side)
)
)
)
(define (map-what-aux positions depth side)
(if (null? positions) '()
(cons (map-what-to-move? (car positions) (- depth 1) (* -1 side))
(map-what-aux (cdr positions) depth side))
)
)
(define (all-posible position side-to-move)
(all-pos-aux position (if (= side-to-move 1) 1 8))
)
(define (all-pos-aux pos count)
(if (equal? pos '(("empty"))) '(("empty"))
(if (= count 14) '()
(if (= count 7) '()
(if (= (in count pos) 0)
(cons '(("empty")) (all-pos-aux pos (+ count 1)))
(cons (new-position pos count) (all-pos-aux pos (+ count 1)))
)
)
)
)
)
(define (in pit pos)
(if (= (car (car pos)) pit)
(cadar pos)
(in pit (cdr pos))
)
)
(define (new-position pos pit-moved)
(new-pos-format pos pit-moved
;(if (= (in pit-moved pos) 0) pos
(new-pos-aux pos pit-moved (in pit-moved pos) 0)
;)
)
)
(define (new-pos-aux pos pit amount second-time-around?) ;;;works like a charm,
(cond ((> amount (- 14 pit)) ;; 0=no 1=yes
(new-pos-aux (new-pos-aux pos pit (- 14 pit) 1) 0 (- amount (- 14 pit)) 1))
((and (not (= pit 1)) (not (= pit 0)))
(cons (car pos)
(new-pos-aux (cdr pos) (- pit 1) amount second-time-around?)))
((= amount 0) (attach second-time-around? pos));; Will this
((= pit 1) (cons ;; always leave
(list (caar pos) 0) ;; second-tim... on the end?
(new-pos-aux (cdr pos) (- pit 1) amount second-time-around?)))
(else (cons
(add-to-pit (car pos))
(new-pos-aux (cdr pos) pit (- amount 1) second-time-around?)))
)
)
(define (new-pos-format old-pos pit-moved new-pos)
(cond ((= (car (last new-pos)) 1) (first 14 new-pos))
((not (and (and (= (in (+ pit-moved (in pit-moved old-pos)) old-pos) 0)
(not (and
(< pit-moved 7)
(> (+ (in pit-moved old-pos) pit-moved) 7))))
;format takes care of 14
(not (or (= (+ pit-moved (in pit-moved old-pos)) 7)
(= (+ pit-moved (in pit-moved old-pos)) 14)
)
)
)
) (first 14 new-pos))
(else (empty-pit
(across-from (no-longer-empty old-pos new-pos))
(add-to (if (< (no-longer-empty old-pos new-pos) 7) 7 14)
(+ 1 (in (across-from (no-longer-empty old-pos new-pos))
new-pos))
(add-to (no-longer-empty old-pos new-pos) -1 new-pos)
)
)
)
)
)
(define (no-longer-empty old-pos new-pos)
(no-longer-aux old-pos new-pos 13))
(define (no-longer-aux old new pit)
(if (and (= (in pit old) 0) (= (in pit new) 1))
pit
(no-longer-aux old new (- pit 1))
)
)
(define (empty-pit pit pos)
(add-to pit (* -1 (in pit pos)) pos))
(define (add-to pit amount pos) ;;; it thinks there is something wrong here?
(if (equal? (caar pos) pit)
(cons (list pit (+ (in pit pos) amount)) (cdr pos))
(cons (car pos) (add-to pit amount (cdr pos)))
)
)
(define (across-from pit)
(cond ((= pit 1) 13)
((= pit 2) 12)
((= pit 3) 11)
((= pit 4) 10)
((= pit 5) 9)
((= pit 6) 8)
((= pit 8) 6)
((= pit 9) 5)
((= pit 10) 4)
((= pit 11) 3)
((= pit 12) 2)
((= pit 13) 1)
)
)
(define (last pos)
(if (null? (cdr pos)) (car pos) (last (cdr pos))))
(define (first x pos)
(if (= x 0) '() (cons (car pos) (first (- x 1) (cdr pos)))))
(define (add-to-pit pit)
(list (car pit) (+ 1 (cadr pit))))
(define (attach thing lst)
(if (null? lst)
(list (list thing))
(cons (car lst) (attach thing (cdr lst)))))
(define (get-new-move? new old)
(let ((fred (+ (in (what-pit-moved? new old) old) (what-pit-moved? new old))))
(or (and (< (what-pit-moved? new old) 7) (= fred 7))
(and (< (what-pit-moved? new old) 14) (= fred 14))
)
)
)
(define (what-pit-moved? new old)
(cond ((> (in 7 new) (in 7 old)) (now-empty 'near new old))
((> (in 14 new) (in 14 old)) (now-empty 'far new old))
(else (now-empty 'whole new old))
)
)
(define (now-empty board new old)
(cond ((equal? board 'near) (now-empty 'whole new old))
((equal? board 'far) (now-empty 'whole (far-side new) (far-side old)))
(else
(if (= (cadar new) (cadar old))
(now-empty board (cdr new) (cdr old))
(caar new)))))
(define start '((1 3) (2 3) (3 3) (4 3) (5 3) (6 3) (7 0)
(8 3) (9 3) (10 3) (11 3) (12 3) (13 3) (14 0)))
(define (mancala pos depth who-to-go );;1=y ;1computer's turn
(cond ((over? pos) (begin
(newline)
(display "Computer score= ")
(display (in-side (near-side pos)))
(newline)
(display "Your score= ")
(display (in-side (far-side pos)))
(newline)
))
((= who-to-go 1)
(letrec ((comps-move (what-to-move? pos depth 1)))
(begin
(display "I moved from pit: ")
(display comps-move)
(newline)
(mancala
(new-position pos comps-move)
depth
(if (get-new-move? (new-position pos comps-move) pos) 1 -1)
))))
((= who-to-go -1)
(begin
(board-display pos)
(newline)
(display "what pit would you like to move..?")
(newline)
(display "")
(letrec ((theirs (read)))
(mancala
(new-position pos theirs) depth
(if (get-new-move? (new-position pos theirs) pos) -1 1)
)
)
)
)
)
)
(define (board-display pos)
(begin
(display (reverse (through 8 13 pos)))
(newline)
(display (through 14 14 pos) )
(display " ")
(display (through 7 7 pos))
(newline)
(display (append (spacer (through 1 4 pos)) (through 5 6 pos)))
)
)
(define (through pit1 pit2 pos)
(cond ((= (caar pos ) pit2) (list (car pos)))
((= (caar pos) pit1) (cons (car pos) (through pit1 pit2 (cdr pos))))
((> (caar pos) pit1) (cons (car pos) (through pit1 pit2 (cdr pos))))
(else (through pit1 pit2 (cdr pos)))
)
)
(define (spacer lst)
(if (null? lst) '()
(cons (cons "" (car lst)) (spacer (cdr lst)))
)
)
This document is available on the World Wide Web as
http://www.cs.grinnell.edu/~stone/courses/scheme/sample-exam.xhtml
created May 7, 2000
last revised May 7, 2000