Solutions to exercises from "lecture notes 6"

;;;; A couple of these turn out (when I actually did them) to be more
;;;; than somewhat unpleasant. Do not give up the struggle...


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

;; 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))
    (dotimes (i 26)
      (format t "~&~a   ~a"
              (code-char (+ lower-a i))
              (aref counts i))))

;; 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:


Nick Levine
                                                                               last modified 2000-11-06
                                                         Copyright (C) Nick Levine 1999. All rights reserved.
$Id: // $