;;;; exercises.lisp -- small Common Lisp exercises for a meeting's
;;;; hacking session, from first steps to a macro.
;;;;
;;;; From the Common Lisp meeting kit of common-lisp.net, under the
;;;; Creative Commons Attribution 4.0 International License.
;;;;
;;;; How to use it:
;;;;
;;;;   1. Load the file into any Common Lisp:
;;;;        (load "exercises.lisp")
;;;;   2. See where you are:
;;;;        (ex:check)        ; every exercise
;;;;        (ex:check 3)      ; exercise 3 only
;;;;   3. Replace an exercise's (not-yet) with your own code, load the
;;;;      file again, and check again.  Work at the REPL too: after
;;;;        (in-package :ex)
;;;;      you can call your functions by name.
;;;;
;;;; Each exercise says what to write.  The tests under it say exactly
;;;; what is expected.  Stuck?  Ask the person next to you: that is
;;;; what the meeting is for.  The answers are in
;;;; exercises-solutions.lisp, for after you have tried.

(defpackage :lisp-exercises
  (:use :common-lisp)
  (:nicknames :ex)
  (:export #:check))

(in-package :lisp-exercises)

;;; The machinery.  Nothing to change here.

(define-condition not-done (error) ()
  (:report "Not done yet."))

(defun not-yet ()
  (error 'not-done))

(defvar *tests* (make-hash-table)
  "Exercise number -> list of (form expected), in order.")

(defmacro tests (number &body cases)
  "The tests of exercise NUMBER: each case is (FORM EXPECTED).  The
forms are kept as they are and evaluated only when checked, so that a
new definition of a function or a macro is always the one tested."
  `(setf (gethash ,number *tests*) ',cases))

(defun run-case (form expected)
  (handler-case
      (let ((got (eval form)))
        (if (equalp got expected)
            :ok
            (format nil "~s gave ~s, expected ~s" form got expected)))
    (not-done () :not-done)
    (error (e) (format nil "~s signalled an error: ~a" form e))))

(defun check (&optional number)
  "Run the tests of exercise NUMBER, or of every exercise, and say how
each one went.  Returns how many exercises pass."
  (let ((passed 0)
        (*package* (find-package :lisp-exercises)))
    (loop for n from 1 to (hash-table-count *tests*)
          when (or (null number) (= n number))
            do (let ((results (loop for (form expected) in (gethash n *tests*)
                                    collect (run-case form expected))))
                 (cond ((every (lambda (r) (eq r :ok)) results)
                        (incf passed)
                        (format t "~&~2d  ok~%" n))
                       ((some (lambda (r) (eq r :not-done)) results)
                        (format t "~&~2d  not done yet~%" n))
                       (t
                        (format t "~&~2d  FAILS~%" n)
                        (dolist (r results)
                          (unless (eq r :ok) (format t "      ~a~%" r)))))))
    (unless number
      (format t "~&~%~d of ~d done.~:[~; Well done!~]~%"
              passed (hash-table-count *tests*)
              (= passed (hash-table-count *tests*))))
    passed))

;;; 1. Warming up
;;;
;;; Write SQUARE, which returns its argument times itself.

(defun square (x)
  (declare (ignorable x))
  (not-yet))

(tests 1
  ((square 3) 9)
  ((square -4) 16)
  ((square 1/2) 1/4))

;;; 2. Strings
;;;
;;; Write GREET, which takes a name and returns the string
;;; "Hello, NAME!".  FORMAT with NIL as its first argument returns a
;;; string: (format nil "~a and ~a" 1 2) => "1 and 2".

(defun greet (name)
  (declare (ignorable name))
  (not-yet))

(tests 2
  ((greet "Lisp") "Hello, Lisp!")
  ((greet "world") "Hello, world!"))

;;; 3. Counting
;;;
;;; Write COUNT-VOWELS, which returns how many of the letters a, e, i,
;;; o, u (in either case) a string contains.  Look at COUNT-IF and
;;; FIND, or write a LOOP.

(defun count-vowels (string)
  (declare (ignorable string))
  (not-yet))

(tests 3
  ((count-vowels "Common Lisp") 3)
  ((count-vowels "rhythm") 0)
  ((count-vowels "AEIOU aeiou") 10))

;;; 4. FizzBuzz
;;;
;;; Write FIZZBUZZ, which returns a list of the numbers from 1 to N,
;;; each as a string, except that a multiple of 3 is "Fizz", a multiple
;;; of 5 is "Buzz", and a multiple of both is "FizzBuzz".

(defun fizzbuzz (n)
  (declare (ignorable n))
  (not-yet))

(tests 4
  ((fizzbuzz 5) ("1" "2" "Fizz" "4" "Buzz"))
  ((nth 14 (fizzbuzz 15)) "FizzBuzz")
  ((length (fizzbuzz 100)) 100))

;;; 5. Recursion
;;;
;;; Write MY-REVERSE, which returns a list in the opposite order,
;;; without using REVERSE.  FIRST, REST and CONS are all you need.

(defun my-reverse (list)
  (declare (ignorable list))
  (not-yet))

(tests 5
  ((my-reverse '(1 2 3)) (3 2 1))
  ((my-reverse '()) ())
  ((my-reverse '(a (b c) d)) (d (b c) a)))

;;; 6. Hash tables
;;;
;;; Write WORD-COUNTS, which takes a list of words (strings) and
;;; returns an association list of (word . count), the most frequent
;;; word first, and words that are counted the same in alphabetical
;;; order.  MAKE-HASH-TABLE (with :test #'equal for strings), GETHASH,
;;; MAPHASH and SORT will help.

(defun word-counts (words)
  (declare (ignorable words))
  (not-yet))

(tests 6
  ((word-counts '("lisp" "is" "lisp")) (("lisp" . 2) ("is" . 1)))
  ((word-counts '("b" "a" "c" "a" "b")) (("a" . 2) ("b" . 2) ("c" . 1)))
  ((word-counts '()) ()))

;;; 7. Functions as values
;;;
;;; Write COMPOSE, which takes two functions F and G and returns a new
;;; function that, given X, returns (F (G X)).  LAMBDA and FUNCALL.

(defun compose (f g)
  (declare (ignorable f g))
  (not-yet))

(tests 7
  ((funcall (compose #'1+ #'abs) -5) 6)
  ((funcall (compose #'length #'string-trim-spaces) "  abc  ") 3)
  ((mapcar (compose #'square #'1+) '(1 2 3)) (4 9 16)))

(defun string-trim-spaces (string)
  (string-trim " " string))

;;; 8. Characters
;;;
;;; Write CAESAR, which shifts every letter of a string by N places
;;; along the alphabet, wrapping from z to a, keeping its case, and
;;; leaves everything else as it is.  CHAR-CODE, CODE-CHAR,
;;; ALPHA-CHAR-P, UPPER-CASE-P and MOD; MAP 'STRING applies a function
;;; to every character of a string.

(defun caesar (string n)
  (declare (ignorable string n))
  (not-yet))

(tests 8
  ((caesar "abc" 1) "bcd")
  ((caesar "Hello, World!" 13) "Uryyb, Jbeyq!")
  ((caesar (caesar "Common Lisp" 7) 19) "Common Lisp"))

;;; 9. Objects
;;;
;;; The class POINT has two slots, X and Y, set by the initargs :X and
;;; :Y.  Give each slot a reader (:reader point-x, and so on), then
;;; write the method DISTANCE, which returns the distance between two
;;; points.  SQRT.

(defclass point ()
  ((x :initarg :x)
   (y :initarg :y)))

(defgeneric distance (a b)
  (:documentation "The distance between A and B."))

(defmethod distance ((a point) (b point))
  (not-yet))

(tests 9
  ((distance (make-instance 'point :x 0 :y 0) (make-instance 'point :x 3 :y 4)) 5.0)
  ((distance (make-instance 'point :x 1 :y 1) (make-instance 'point :x 1 :y 1)) 0.0))

;;; 10. A macro
;;;
;;; Common Lisp has no WHILE.  Write one: (while TEST BODY...) runs
;;; BODY again and again for as long as TEST is true, and returns NIL.
;;; A macro returns code: build it with a backquote, ` , and ,@ --
;;; LOOP, or TAGBODY and GO, can do the looping.  (macroexpand-1
;;; '(while (< i 3) (incf i))) shows what you made.

(defmacro while (test &body body)
  (declare (ignorable test body))
  '(not-yet))

(tests 10
  ((let ((i 0)) (while (< i 5) (incf i)) i) 5)
  ((let ((i 0) (seen '())) (while (< i 3) (push i seen) (incf i)) seen) (2 1 0))
  ((let ((i 10)) (while (< i 5) (incf i)) i) 10)
  ((while nil) nil))

;;; Done?  Write an exercise of your own for the next meeting.