The answers to the first 4 problems are given below, along with a hint on the last problem (ACL 8.5). Because I think the last problem is an interesting one, but so few people completed it, I am reassigning it. If you did for Assignment 2, that's fine -- just include it in your Assignment 3 as well. Since the assignment was all code this time, I included comments not in red text, but as comments embedded in the code below. You should study the answers, even if you got full credit on a problem because I've posed a few questions regarding the code. If you can answer the questions confidently, that's a good sign. If not, we can discuss the answers, and try to figure them out together.
;;;; Problem 1 (ACL 3.5) (3 pts)
;;; Recursive version
;; Uses &optional so that caller need not specify
;; the zero (0) position on first call
;; Note: This function is not tail-recursive -- why not?
(defun pos+ (lst &optional (pos-num 0))
(if (null lst)
nil
(let ((first-elt (first lst)))
(if (numberp first-elt)
(cons (+ first-elt pos-num)
(pos+ (cdr lst) (+ pos-num 1)))
(pos+ (cdr lst) (+ pos-num 1)))))))
;;; Iterative version
(defun pos+ (lst)
(let ((pos 0)
(result-list nil))
(dolist (num-elt lst)
(push (+ num-elt pos) result-list)
(incf pos))
(reverse result-list)))
;;; Mapcar version
;; Many people wound up using setf because they couldn't
;; figure out how to pass values between successive calls
;; to mapcar. So instead they setf'd a value inside the
;; function they passed to mapcar. Yikes.
(defun pos+ (lst)
(mapcar #'(lambda (num pos)
(+ num pos))
lst
(index-list (length lst))))
(defun index-list (len &optional (result-lst nil))
(if (= len 0)
(cons 0 result-lst)
(index-list (- len 1) (cons len result-lst))))
;;;; Problem 2 (ACL 4.4) (2 pts)
(defun big-to-small (bst &optional (result-list nil))
(if (null bst)
result-list
(let ((min (node-elt (bst-min bst))))
(big-to-small (bst-remove min bst #'<)
(cons min result-list)))))
;;;; Problem 3 (ACL 5.7) (3pts)
;;; Recursive version
(defun succ-diff-one-p (lst)
(if (null lst)
t
(let ((one (first lst))
(two (second lst)))
(if (or (null one)
(null two))
(succ-diff-one-p (cddr lst))
(if (diff-one-p one two)
(succ-diff-one-p (cdr lst))
nil)))))
(defun diff-one-p (one two)
(if (= (abs (- one two)) 1)
t
nil))
;;; do version
(defun succ-diff-one-p (lst)
(do ((lst-len (length lst))
(counter 1 (incf counter)))
((= counter lst-len) t)
(unless (diff-one-p (nth (- counter 1) lst)
(nth counter lst))
(return nil))))
;;; Using mapc and return
;; Why is the return here? Wouldn't this work
;; without the block/return?
(defun succ-diff-one-p (lst)
(block nil
(let ((prev (car lst)))
(if (null
(mapc #'(lambda (curr)
(if (diff-one-p curr prev)
(setf prev curr)
(return nil)))
(cdr lst)))
nil
t))))
;;;; Problem 4 (ACL 6.8) (3 pts)
;;; Many people used a hash table here, but this is not a
;;; a good candidate for using a hash table. Hash tables are
;;; appropriate when the data is sparse in the key space.
;;; Here's a (classic) example: social security numbers (SSN).
;;; SSN's are 9 digits, which mean that there are 10^10 possible
;;; SSN's. However, there are only about 2.5x10^8 people in the
;;; U.S. right now. If you create an array, then only 1 in 40
;;; slots will have a value in it. You're wasting 98% of the
;;; array. But with a hash table, you would use only what you
;;; need. The cost is that hash tables are more complex (read
;;; slower to run) to implement.
;;;
;;; Personally, I think the assoc list solution is simplest.
;;; You could also make a good case for using a vector because
;;; you know how many elements. you will have in advance (0-100).
;;;
;;; What *is* bad is setf'ing a hash table (or any other
;;; data structure) at the top-level, and then referring
;;; to it from within your function.
;;;
;;; Note that the setf is okay here (where is it?). Why?
;;; Think about the normal objection to setf, and then
;;; look for what distinguishes this version from the
;;; typical case.
(let ((table nil))
(defun frugal (int)
(let ((answer (assoc int table)))
(if (null answer)
(cdar ; What does cdar() do,
(push ; and why does it work here?
(cons int (expensive int))
table))
(cdr answer)))))
;; expensive() computes int!
(defun expensive (int)
(do ((j int (- j 1))
(f 1 (* j f)))
((= j 0) f)))
;;;; Problem 5 (ACL 8.5)
;;; This was tricky problem, because you had to think
;;; about how to solve it before writing the code.
;;; How could you recognize that a quote might have
;;; been produced by Henley (the sample code in
;;; section 8.8)? Think about how Henley works:
;;; it's probabilistic, so the ideal answer is to
;;; write code that takes the probabiities into
;;; account. But there's a simpler way that can, in
;;; some cases, say positively that Henley did NOT
;;; generate a piece of text.
;;; The sample code needed is here:
(defparameter *words* (make-hash-table :size 10000))
(defconstant maxword 100)
(defun read-text (pathname)
(with-open-file (s pathname :direction :input)
(let ((buffer (make-string maxword))
(pos 0))
(do ((c (read-char s nil :eof)
(read-char s nil :eof)))
((eql c :eof))
(if (or (alpha-char-p c) (char= c #\'))
(progn
(setf (aref buffer pos) c)
(incf pos))
(progn
(unless (zerop pos)
(see (intern (string-downcase
(subseq buffer 0 pos))))
(setf pos 0))
(let ((p (punc c)))
(if p (see p)))))))))
(defun punc (c)
(case c
(#\. '|.|) (#\, '|,|) (#\; '|;|)
(#\! '|!|) (#\? '|?|) ))
(let ((prev `|.|))
(defun see (symb)
(let ((pair (assoc symb (gethash prev *words*))))
(if (null pair)
(push (cons symb 1) (gethash prev *words*))
(incf (cdr pair))))
(setf prev symb)))
(defun generate-text (n &optional (prev '|.|))
(if (zerop n)
(terpri)
(let ((next (random-next prev)))
(format t "~A " next)
(generate-text (1- n) next))))
(defun random-next (prev)
(let* ((choices (gethash prev *words*))
(i (random (reduce #'+ choices
:key #'cdr))))
(dolist (pair choices)
(if (minusp (decf i (cdr pair)))
(return (car pair))))))