Some Simple Programming Exercises

Copyright 1999-2001 Cley Limited

our-third

Write a function, using car and cdr (or first and rest) which returns the third element of a list.

SAMPLE SOLUTION:


(defun our-third (x)
   (car (cdr (cdr x))))

hours-in-1999

Write a function which is called as follows:


> (hours-in-1999)
and which calculates the number of hours in 1999.

SAMPLE SOLUTION:


(defun hours-in-1999 ()
   (* 24 365))

seconds-in-a-leap-year

Write a function called:


> (seconds-in-a-leap-year)
which calculates the number of seconds in a leap year.

SAMPLE SOLUTION:


(defun seconds-in-a-leap-year ()
   (* 60 (* 60 (* 24 366))))

minutes-in-year

Write a function which takes a single argument, leapp. If leapp is non-nil, the function returns the number of minutes in a leap year. If leapp is nil, it returns the number of minutes in a non-leap year (e.g. 1999!).


> (minutes-in-year t)

SAMPLE SOLUTION:


(defun minutes-in-year (leapp)
   (if leapp
       (* 60 (* 24 366))
       (* 60 (* 24 365))))

less-than-or-equal-to

Lisp provides various arithmetic operators, including the following:


> (= 1 3)
nil
> (= 1 1.0)
t
> (> 4 3)
t
> (> 4 4)
nil
> (< 3/4 1.0)
t
> 
Write a function

> (less-than-or-equal-to x y)
which returns t if x is less than or equal to y. Define it using a selection of the operators above and the logical operators and, or and not.

SAMPLE SOLUTION:


(defun less-than-or-equal-to (x y)
   (or (< x y) (= x y)))

is-a-list?

Write a function is-a-list? which returns the symbol


list
if its argument is a non-empty list, returns

empty-list
if it is the empty list, and returns

something-else
for anything else.

SAMPLE SOLUTION:


(defun is-a-list? (thing)
   (if (null thing)
       'empty-list
       (if (listp thing)
           'list
           'something-else)))

lookup-details and make-lookup-table

Lisp contains various predicates which check if something is the same as something else. You can use


> (eql 'symbol1 'symbol2)
nil
>
to check if two symbols are the same.

Write a function lookup-details which looks up information in a record.

A record takes the following form:


(NAME AGE HEIGHT)

Your function should take two arguments:

For example:


> (lookup-details 'age '(John 31 163cm))
31
> (lookup-details 'name '(Mary 10 unknown))
mary
>

SAMPLE SOLUTION:


(defun lookup-details (detail record)
   (if (eql detail 'name)
       (first record)
       (if (eql detail 'age)
           (second record)
           (if (eql detail 'height)
               (third record)))))

Write a function which, when given a record of the form given above, returns a lookup table as follows:


> (make-lookup-table '(John 31 163cm))
((name john) (age 31) (height 163cm))
>

SAMPLE SOLUTION:


(defun make-lookup-table (record)
   (list (list 'name (lookup-detail 'name record))
         (list 'age (lookup-detail 'age record))
         (list 'height (lookup-detail 'height record))))

non-zero-integerp

Look in your Common Lisp reference material to find predicates which test whether a number is an integer and whether a number is zero. Use these to define the following predicate:


> (non-zero-integerp 8)
t
> (non-zero-integerp 0)
nil
> (non-zero-integerp 1.0)
nil
>

SAMPLE SOLUTION:


(defun non-zero-integerp (n)
   (and (not (zerop n))
        (integerp n)))

memberp

Write a function called memberp, which returns t if its first argument is a member of its second argument, a list, and nil otherwise:


> (memberp 'a '(b a c k)
T
>

SAMPLE SOLUTION:


(defun memberp (obj lst)
   (if (null obj)
       nil
       (if (eql (car lst) obj)
           t
           (our-member obj (cdr lst)))))

How does this function behave compared to the behaviour of the Common Lisp member function?

even

Write a recursive function which finds the first even number in a list:


> (even '(1 5 4 2 7 3))
4
>

SAMPLE SOLUTION:


(defun even (lst)
   (if (null lst)
       nil
       (let ((first (first lst)))
         (if (evenp first)
             first
             (even (rest lst))))))

smallest

Write an iterative function which returns the smallest number in a list:


> (smallest '(4 2 5 8 1 6))
1
>

SAMPLE SOLUTION:


(defun smallest (lst)
   (let ((smallest (first lst)))
      (dolist (ele (rest lst))
         (if (< ele smallest)
             (setf smallest ele)))
      smallest))

print-elements

Write several versions of a function which prints the elements of a list, e.g.:


> (print-elements '(1 2 3))
1
2
3
>

Write an iterative version using dolist, a recursive version, and a verson which uses mapc.

SAMPLE SOLUTION:


(defun print-elements-i (lst)
   (dolist (ele lst)
      (format t "~A~%" ele))
   t)

(defun print-elements-r (lst)
   (if (null lst)
       t
       (progn (format t "~A~%" (car lst))
              (print-elements-r (cdr lst)))))

(defun print-elements-m (lst)
   (mapc #'(lambda (x)
             (format t "~A~%" x))
         lst)
    t)

get-integer

Write two versions of a function which asks the user for a number, and returns the number if it is an integer, but returns nil if it is not. For one version, use integerp as the test; for the other, use typep.


> (get-integer-1)
Please enter an integer: 4
4
> (get-integer-2)
Please enter an integer: "fish"
nil
>

SAMPLE SOLUTION:


(defun get-integer-1 ()
   (format t "Please enter an integer: ")
   (let ((input (read)))
     (if (integerp input)
         input
         nil)))

SAMPLE SOLUTION:


(defun get-integer ()
   (format t "Please enter an integer: ")
   (let ((input (read)))
     (if (typep input 'integer)
         input
         nil)))

double-number

The Common Lisp function error can be used to signal an error, for example:


> (error "unknown data type")
Error: unknown data type

<1>

Write a function which, given a number as argument, doubles that number. It should signal an error if its argument is not a number.

SAMPLE SOLUTION:


(defun double-number (num)
  (if (not (numberp num))
      (error "argument must be a number")
    (* num 2)))

subtract2

Use mapcar to define a function which, given a list of numbers, subtracts 2 from each number:


> (subtract2 '(1 2 3 4))
(-1 0 1 2)
>

SAMPLE SOLUTION:


(defun subtract2 (nums)
   (mapcar #'(lambda (n)
                (- n 2))
           nums))

Now rewrite your function so that it signals a warning if the result of calculation is a negative number (use warn).

SAMPLE SOLUTION:


(defun subtract2-with-warning (nums)
   (mapcar #'(lambda (n)
                (let ((res (- n 2)))
                  (if (< res 0)
                      (warn "negative number calculated"))
                  res))
           nums))
or

(defun subtract2-with-warning (nums)
   (mapcar #'(lambda (n)
                (let ((res (- n 2)))
                  (if (< res 0)
                      (warn "negative number calculated: ~D" res))
                  res))
           nums))

apply-operator-to-nums

Write a function which defines a list of numbers in a local variable, using let, for example:


(let ((nums '(1 2 3 4)))
   ...)

and which applies the argument function to the numbers in the list.


> (apply-operator-to-nums #'+)
10
> (apply-operator-to-nums #'*)
24
>

SAMPLE SOLUTION:


(defun apply-operator (func)
   (let ((nums '(1 2 3 4)))
     (apply func nums)))

our-nth

Write your own version of nth:


> (our-nth 1 '(1 2 3))
2
>

SAMPLE SOLUTION:


(defun our-nth (n lst)
   (car (nthcdr n lst)))

or


(defun our-nth (n lst)
   (labels ((ncdr (n l)
              (cond ((null l) '())
                    ((zerop n) l)
                    ((ncdr (1- n) (cdr l))))))
      (car (ncdr n lst))))

our-adjoin, our-union and our-intersection

The set function adjoin adds a new element to a list if it is not there already:


> (adjoin 's '(s e t))
(s e t)
> (adjoin 2 '(1 3 4))
(2 1 3 4)
>

Look up the behaviour of union and intersection. Define your own versions of the set functions adjoin, union and intersection.

SAMPLE SOLUTION:


(defun our-adjoin (x lst)
   (if (member x lst)
       lst
       (cons x lst)))

(defun our-union (set1 set2)
   (if (null set1)
       set2
       (if (member (car set1) set2)
           (our-union (cdr set1) set2)
           (cons (car set1)
                 (our-union (cdr set1) set2)))))

(defun our-intersection (set1 set2)
   (if (null set1)
       '()
       (if (member (car set1) set2)
           (cons (car set1)
                 (our-intersection (cdr set1) set2))
           (our-intersection (cdr set1) set2))))

our-assoc

Write your own version of assoc, our-assoc. Start with a simple function which looks up a key in a list of key-value pairs:

SAMPLE SOLUTION:


(defun our-assoc (key alist)
  (cond ((null alist) nil)
        ((eql key (caar alist)) (car alist))
        ((our-assoc key (cdr alist)))))

Then add some error checking: make it signal an error, list argument is not a list.

SAMPLE SOLUTION:


(defun our-assoc2 (key alist)
  (cond ((null alist) nil)
        ((not (listp alist)) (error "Second argument must be a list."))
        ((eql key (caar alist)) (car alist))
        ((our-assoc key (cdr alist)))))

tree-size

Write a function tree-size which counts the number of leaf nodes in a tree.

For example:


> (tree-size '())
0
> (tree-size '(1 2 3 4))
4
> (tree-size '((((2) 1 (3 4)))))
4
> (tree-size '(1 (2 (3 (4 (5))))))
5
>

SAMPLE SOLUTION:


(defun tree-size (tree)
   (if (null tree)
       0
       (if (atom tree)
           1
           (+ (tree-size (car tree))
              (tree-size (cdr tree))))))

place-mark

Create an array which represents a noughts-and-crosses (tic-tac-toe) game. Assign it as the value of the variable *board*.

Write a function, place-mark, which takes three arguments. The first should be the mark which is to be placed (either a 0 for a nought or a 1 for a cross). The second argument should be a dotted pair representing the position the mark is to be placed in. The third should be the noughts-and-crosses game board.

For example:


> (place-mark 0 '(0 . 1) *board*)
0
> (aref *board* 0 1)
0
>

SAMPLE SOLUTION:


> (setf *board* (make-array '(3 3) :initial-element nil))
#<hash-table>
>

(defun place-mark (mark position board)
   (setf (aref board (car position) (cdr position)) mark))

calculator

Write a function parse-calculation which, given a string which contains a calculation like these:


"1 + 2"
"3 - 4"
"5 * 2"
"3 / 2"

Returns a list of the form:


(+ 1 2)
(- 3 4)
(* 5 2)
(/ 3 2)

NB: just parse trivial cases of a single call to an operator (+,-, * or /) with two arguments, you do not need to write a general expression parser!

You may wish to use with-input-from-string and read.

SAMPLE SOLUTION:


(defun parse-calculation (calcstr)
   (with-input-from-string (in calcstr)
      (let ((n1 (read in))
            (op (read in))
            (n2 (read in)))
         (list op n1 n2))))

Write a function calc which, given a list containing an operator and a list of arguments, applies that operator to the arguments:


> (calc '(+ 1 2))
3
>

SAMPLE SOLUTION:


(defun calc (calc)
   (apply (symbol-function (first calc))
          (rest calc)))

The Lisp function read-line reads in a line of input and returns it as string:


> (read-line)
fish
"fish"
NIL
>

Using read-line and do, write a function calculator which prompts the user to enter a calculation, calculates the result, and prints it out. It should exit when the user enters "done" and types return.


> (calculator)
Please enter your calculation: 2 + 3
6
Please enter your calculation: 5 - 2
3
Please enter your calculation: done
t
>

SAMPLE SOLUTION:


(defun calculator ()
   (format t "Please enter your calculation: ")
   (do ((input (read-line) (read-line)))
       ((equal input "done") t)
      (format t "~S~%" (calc (parse-calculation input)))
      (format t "Please enter your calculation: ")))

You have now written a simple calculator. Add some basic input error checking into it.

SAMPLE SOLUTION:


(defun check-integer-arg (int)
   (if (integerp int)
       int
       (error "not a valid argument")))

(defun check-operator (op)
   (or (first (member op '(+ - * /)))
       (error "not a valid operator")))

(defun parse-calculation (calcstr)
   (with-input-from-string (in calcstr)
      (let ((n1 (read in))
            (op (read in))
            (n2 (read in)))
         (list (check-operator op)
               (check-integer-arg n1)
               (check-integer-arg n2)))))

NB Calc and calculator stay as they are.

dog

Define a structure to represent a pet dog. Since it is a pet dog, it will have a name - write your definition so that when you create a dog, Lisp prompts you for its name (it should be stored as a string). Dogs should have a number of legs, and a tail which is in one of two states: wagging, or hanging down.

Write a function pat-dog which, when applied to a dog, makes the dog wag its tail. Write another function dog-state which will print a message to tell you what state the dog's tail is in.

SAMPLE SOLUTION:


(defstruct dog
   (name (progn 
            (format *query-io* "Please give your dog a name: ")
            (read-line *query-io*)))
   (legs 4)
   (tail "hanging down"))

(defun pat-dog (dog)
   (setf (dog-tail dog) "wagging"))

(defun dog-state (dog)
   (format t "~A's tail is ~A~%" (dog-name dog) (dog-tail dog)))

delete-all

Write a recursive function which takes an atom and a nested list as arguments, and returns a new list which is a copy of the old with all instances of the atom removed, using cond.

For example:


> (delete-all 4 '((1 (((4)) 6 7 (4 3 4)))))
((1 ((NIL) 6 7 (3))))
>

SAMPLE SOLUTION:


(defun delete-all (thing lst)
   (cond ((null lst) '())
         ((eql thing lst) '())
         ((atom lst) lst)
         ((eql (first lst) thing) (delete-all thing (rest lst)))
         ((atom (first lst)) (cons (first lst)
                                   (delete-all thing (rest lst))))
         (t (cons (delete-all thing (first lst))
                    (delete-all thing (rest lst))))))

print-type

Look up the definition of typecase, and write a function which prints out a different phrase according to the type of its argument. For example, it might print "4 is an integer" if its argument was 4.

SAMPLE SOLUTION:


(defun print-type (obj)
   (format t
      (typecase obj
         (integer "~A is an integer~%")
         (ratio "~A is a ratio~%")
         (real "~A is a real~%")
         (function "~A is a function~%")
         (symbol "~A is a symbol~%")
         (list "~A is a list~%"))
      obj)
    t)

our-eleventh

Write a function our-eleventh which checks whether the function eleventh is defined in this Lisp; if it is, it should call it, and if not it should call nth with appropriate arguments. (NB: in order to test, you will need to define eleventh!)


> (our-eleventh '(1 2 3 4 5 6 7 8 9 10 11 12)
11
>

SAMPLE SOLUTION:


(defun eleventh (lst)
   (nth 10 lst))

(defun our-eleventh (lst)
   (if (fboundp 'eleventh)
       (funcall (symbol-function 'eleventh) lst)
       (nth 10 lst)))

collect-0s

Write a recursive function using labels which collects together all the instances of 0 in a list containing 0s and 1s. The internal function defined within the labels form should be tail-recursive - that is, the last thing it calls should be itself.

Your function should return an error if it encounters any item other than A 0 or a 1 in the argument list; use another local function which calls type-of to return an error dependent on the numeric type of the item encountered.


> (collect-0s '(1 0 0 1 1 1 0))
(0 0 0)
> (collect-0s '(1 0 3 4)
Error: unexpected FIXNUM 3.
> (collect-0s '(0 4.5 7)
Error: unexpected SINGLE-FLOAT 4.5.
>

SAMPLE SOLUTION:


(defun collect-0s (binlist)
   (labels ((check-n (n)
               (or (= n 0) 
                   (= n 1)
                   (error "Unexpected ~A ~S.~%"  (type-of n) n)))
            (collect-0s (binlst zerolst onelst)
               (if (null binlst)
                   (values zerolst onelst)
                   (let ((n (first binlst)))
                      (check-n n)
                      (if (= n 0)
                          (collect-0s (rest binlst)(cons n zerolst) onelst)
                          (collect-0s (rest binlst) zerolst (cons n onelst)))))))
      (collect-0s binlist '() '())))

minus

Define a function minus which takes one or more arguments. The first argument should be a number from which, in turn, all the other arguments are subtracted. Note that although you may use the built-in function -, for the purposes of this exercise you may call it with a maximum of two arguments.


> (minus 1 2 3)
-4
> (minus 5 2 1 1)
1
>

SAMPLE SOLUTION:


(defun minus (n &rest nums)
   (if (null nums)
       n
       (apply #'minus (- n (first nums)) (rest nums))))

create-string

Define a function which constructs a single string out of three string arguments, and either prints it to the terminal and returns nil, or returns the string, depending on the value of the keyword argument to:


> (create-string "fish" "bone" "bat")
"fishbonebat"

> (create-string "fish" "bone" "bat" :to 'result)
"fishbonebat"

> (create-string "fish" "bone" "bat" :to 'print)
fishbonebat

to should default to result; an error should be signalled if to evaluates to anything other than result or print.

SAMPLE SOLUTION:


(defun create-string (s1 s2 s3 &key (to 'result))
   (let ((str (concatenate 'string s1 s2 s3)))
      (cond ((eql to 'result) str)
            ((eql to 'print) (format t str))
            (t (error "Invalid to")))))

deal

Write a function which deals a card at random from a suit of cards, until all the cards are gone. The cards should be stored in a local variable within a closure. deal should return an error when there are no more cards to be dealt. (You will want to use the random function.)


> (deal)
A
> (deal)
J
> (deal)
4

until


> (deal)
Error: No more cards
> 

SAMPLE SOLUTION:


(let ((cards '(A K Q J 10 9 8 7 6 5 4 3 2)))
   (defun deal ()
      (if (null cards)
          (error "No more cards")
          (prog1 (first cards)
                 (setf cards (rest cards))))))

defun-note

Write a macro defun-note which will expand into defun and also print a message (to *debug-io*) saying what function is being defined.

A good way to do this is to think about what the expansion of the macro should be:


(defun-note foo (x)
   x)
could expand to something like this:

(progn
  (format *debug-io* "~&Defining ~A~%" 'foo))
  (defun foo (x)
    x)
Note that you only need to care about the first argument - the function name - all the others can just be passed straight through to defun.

SAMPLE SOLUTION:


(defmacro defun-note (name &rest stuff-for-defun)
  `(progn
    (format *debug-io* "~&Defining ~A~%" ',name)
    (defun ,name ,@stuff-for-defun)))	

There are several ways that defun-note could be extended:

SAMPLE SOLUTION:

Function redefinition:


(defmacro defun-note (name &rest stuff-for-defun)
  `(progn
     (format *debug-io* "~%~A ~A~%"
             (if (fboundp ',name) "Redefining" "Defining")
             ',name)
     (defun ,name ,@stuff-for-defun)))

Keeping track of defined functions (this version keeps them in a list in most-recent-first order):


(defvar *defined-functions* '())
(defmacro defun-note (name &rest stuff-for-defun)
  `(progn
     (pushnew ',name *defined-functions*)
     (format *debug-io* "~%~A ~A~%"
             (if (fboundp ',name) "Redefining" "Defining")
             ',name)
     (defun ,name ,@stuff-for-defun)))

for

Write a macro, for as follows:


> (for a in (1 2 3 4) do (* a a)
(1 4 9 16)

SAMPLE SOLUTION:


(defmacro for (var in lst do form)
   (if (not (and (eql in 'in)
                 (eql do 'do)
                 (symbolp var)
                 (listp lst)))
       (error "Invalid syntax")
       `(mapcar #'(lambda (,var)
                      ,form)
                ',lst)))

create-ordinals

Imagine that you have some information which you need to store in list of length up to 20 elements.

Common Lisp includes definitions of functions for getting at the elements of a list from first up to tenth.

Imagine that your program has to run both in Common Lisp and in some other Lisp which has more of these functions defined; up to fifteenth, for example, and that how many of them are defined depends on the version you are running of this other Lisp. You need to define functions for accessing elements of a list up to twentieth where they do not already exist.

Write a macro which checks, for each function from first to twentieth, whether it already exists and if it does not defines it suitably.

SAMPLE SOLUTION:


(defmacro create-ordinals ()
   (let ((names '((first . 1) (second . 2) (third . 3) (fourth . 4)
                  (fifth . 5)(sixth . 6) (seventh . 7) (eighth . 8)
                  (ninth . 9) (tenth . 10) (eleventh . 11) (twelfth . 12)
                  (thirteenth . 13) (fourteenth . 14) (fifteenth . 15)
                  (sixteenth . 16) (seventeenth . 17) (eighteenth . 18)
                  (nineteenth . 19) (twentieth . 20))))
      (cons 'progn
            (remove nil
                    (mapcar #'(lambda (p)
                                (let ((f (first p)))
                                   (if (not (fboundp f))
                                       `(defun ,f (x)
                                           (nth ,(1- (cdr p)) x)))))
                            names)))))