# Some Simple Programming Exercises

## `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:

• the type of information to look up: name, age or height
• the record

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)
4
> (get-integer-2)
nil
>
```

SAMPLE SOLUTION:

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

SAMPLE SOLUTION:

```
(defun get-integer ()
(format t "Please enter an integer: ")
(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:

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

```
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)
6
3
t
>
```

SAMPLE SOLUTION:

```
(defun calculator ()
((equal input "done") t)
(format t "~S~%" (calc (parse-calculation input)))
```

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

• Extend it so it tells you if you are redefining a function - use `fboundp` to check if the function is already defined.
• Extend it so it keeps a record (in a list or hash-table) of the functions that have been defined.

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