;;;; A couple of these turn out (when I actually did them) to be
more
;;;; than somewhat unpleasant. Do not give up the struggle...
;;; WORD COUNTS
(defun word-count ()
(do-word-count (read-line)))
;; split this off so we can run tests to verify whether it works
(defun do-word-count (string)
(let* ((count 0))
(dotimes (i (length string))
;; need to look for a word BOUNDARY...
(if (and (or (zerop i)
(spacep string (1- i)))
(not (spacep string i)))
(incf count)))
count))
;; utility
(defun spacep (string index)
(char= (aref string index) #\Space))
;; tests
(let* ((tests '(("One two three" 3) ; simplest
case
("One two three" 3) ; multiple spaces
(" One two three" 3) ; leading space
("One two three " 3) ; trailing space
(" One
two three
" 3) ; lots of spaces
("" 0)
; empty
(" " 0)
; just spaces
)))
(dolist (test tests)
(let* ((string (first test))
(expected
(second test))
(obtained
(do-word-count string)))
(unless (= expected obtained)
(error "Test on ~s failed:
count appears to be ~a but expected ~a."
string obtained expected)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rotate-square-array (array)
(let* ((dimensions (array-dimensions array))
(dimension (first
dimensions))
(new-array (make-array
dimensions)))
;; error check...
(unless (= dimension (second dimensions))
(error "Not a square array!"))
(dotimes (i dimension)
(dotimes (j dimension)
(setf (aref new-array
j (- dimension i 1))
(aref array i j))))
new-array))
; nasty
(defun reducing-copy-list (list)
(reduce 'cons list :initial-value nil :from-end t))
(defun reducing-reverse (list)
(reduce 'rcons list :initial-value nil))
(defun rcons (rest first)
(cons first rest))
;; could have downcased the whole string in one go...
(defun alpha-count (string)
(let* ((counts (make-array 26 :initial-element 0))
(lower-a (char-code
#\a)))
(dotimes (i (length string))
(let* ((char (aref string i)))
(if (alpha-char-p char)
(incf (aref counts (- (char-code (char-downcase char))
lower-a))))))
(dotimes (i 26)
(format t "~&~a
~a"
(code-char (+ lower-a i))
(aref counts i))))
nil)
;; char= and = &co require one argument minimum...
(defun better-equal (things)
(if things
(in-better-equal (first things)
(rest things))
(error "Call to ~s needs at least one thing."
'better-equal)))
(defun in-better-equal (thing others)
(if others
(if (equal thing (first others))
(in-better-equal
thing (rest others))
nil)
; termination condition: fail
t)))
; termination condition: success
(defun recursive-compare (list vector)
(in-recursive-compare list vector 0))
(defun in-recursive-compare (list vector index)
(let* ((vector-length (length vector))
(vector-expired
(= index vector-length))
(list-expired
(null list)))
(or ;; got to the end of both?
(and vector-expired
list-expired)
;;
did one sequence run out too soon?
(and (not (or vector-expired
list-expired))
;; do the check
(equal (first list)
(aref vector index))
;; and carry on along both sequences
(in-recursive-compare (rest list) vector (1+ index)))))
)
; quite unpleasant
;; probably less hassle to use a "free ride" along the vector, ie
to
;; use dotimes - this way we don't have to worry about going over
the
;; end of the vector
(defun iterative-compare (list vector)
(and (dotimes (i (length vector) t) ; note the default
return value
(if (or (null
list)
(not (equal (pop list)
(aref vector i))))
(return nil)))
(null list)))
; moderately tough
If you have tried the exercises, looked at the solutions and still do not understand what's going on, I am available for consultation at the times advertised on my office door. Bring your code with you in BOTH the following forms: