1  ; exercise chapter 5
  2  ; little lisper
  3  ; august 10 2005
  4
  5  ;=============================================================================
  6  ; constants
  7  ;=============================================================================
  8  (defconstant x 'comma)
  9  (defconstant y 'dot)
 10  (defconstant a 'kiwis)
 11  (defconstant b 'plums)
 12  (defconstant lat1 (list 'bananas 'kiwis))
 13  (defconstant lat2 (list 'peaches 'apples 'bananas))
 14  (defconstant lat3 (list 'kiwis 'pears 'plums 'bananas 'cherries))
 15  (defconstant lat4 (list 'kiwis 'mangoes 'kiwis 'guavas 'kiwis))
 16  (defconstant l1 (list (list 'curry) () (list 'chicken) ()))
 17  (defconstant l2 (list (list 'peaches) (list 'and 'cream)))
 18  (defconstant l3 (list (list 'plums) 'and (list 'ice) 'and 'cream))
 19  (defconstant l4 ())
 20
 21
 22  ;=============================================================================
 23  ; multisubst-kiwis
 24  ;=============================================================================
 25  (defun multisubst-kiwis (word lat)
 26    (cond
 27     ((null lat) (quote ()))
 28     ((eq (car lat) 'kiwis) (cons word (multisubst-kiwis word (cdr lat))))
 29     (t (cons (car lat) (multisubst-kiwis word (cdr lat))))
 30     )
 31  )
 32
 33  (multisubst-kiwis b lat1)
 34  (multisubst-kiwis y lat2)
 35  (multisubst-kiwis y lat4)
 36  (multisubst-kiwis y l4)
 37
 38  ;=============================================================================
 39  ; multisubst2
 40  ;=============================================================================
 41  (defun multisubst2 (newword oldword1 oldword2 lat)
 42    (cond
 43     ((null lat) (quote()))
 44     ((or (eq oldword1 (car lat)) (eq oldword2 (car lat)))
 45      (cons newword (multisubst2 newword oldword1 oldword2 (cdr lat))))
 46     (t (cons (car lat) (multisubst2 newword oldword1 oldword2 (cdr lat))))
 47    )
 48  )
 49
 50  (multisubst2 x a b lat1)
 51  (multisubst2 y a b lat3)
 52  (multisubst2 a x y lat1)
 53
 54  ;=============================================================================
 55  ; multidown
 56  ;=============================================================================
 57  (defun multidown (lat)
 58    (cond
 59     ((null lat) (quote ()))
 60     ((atom (car lat)) (cons (cons (car lat) (quote())) (multidown (cdr lat))))
 61     (t (cons (car lat) (multidown (cdr lat))))
 62    )
 63  )
 64
 65  (multidown lat1)
 66  (multidown lat2)
 67  (multidown l4)
 68
 69  ;=============================================================================
 70  ; occurN -very fun!
 71  ; more information here: http://paste.lisp.org/display/7359#2
 72  ; two different ways shown here
 73  ;=============================================================================
 74
 75  ; define a helper method that iterates through the second list with an element 
 76  ; from the first list, returning how many times that element occurs in the second
 77  ; list
 78  ; elegant because the helper method is local but it also generates warning
 79  ; because it is being redefine at each iteration
 80  (defun occurN (alat blat)
 81    ; helper function determines how many times this element occurs inside
 82    (defun helper (element lst)
 83      (cond
 84       ((null lst) 0)
 85       ((eq element (car lst)) (+ 1 (helper element (cdr lst))))
 86       (t (+ 0 (helper element (cdr lst))))
 87      )
 88     )
 89    (cond
 90     ((null alat) 0)
 91     (t (+ (helper (car alat) blat) (occurN (cdr alat) blat)))
 92    )
 93  )
 94
 95  (occurN lat1 l4)
 96  (occurN lat1 lat2)
 97  (occurN lat1 lat3)
 98  (occurN '(bananas kiwis kiwis) '(kiwis pears plums bananas cherries))
 99  (occurN '(a b c) '(a b d))
100
101  ; this does not really work
102  ; it double counts many things
103  (defun occurN2 (alat blat)
104    (cond
105     ((or (null alat) (null blat)) 0)
106     ((eq (car alat) (car blat))
107      (+ 1 (occurN2 alat (cdr blat)) (occurN2 (cdr alat) (cdr blat))))
108     (t (+ (occurN2 alat (cdr blat)) (occurN2 (cdr alat) blat)))
109    )
110  )
111
112  (occurN2 lat1 l4)
113  (occurN2 lat1 lat2)
114  (occurN2 lat1 lat3)
115  (occurN2 '(bananas kiwis kiwis) '(kiwis pears plums bananas cherries))
116  (occurN2 '(a b) '(a b))
117
118  ;=============================================================================
119  ; I
120  ;=============================================================================
121
122  ; I and multiI helper method
123  ; this returns the first member it encounters
124  (defun retMember (element lst)
125    (cond
126     ((null lst) (quote()))
127     ((eq element (car lst)) element)
128     (t (retMember element (cdr lst)))
129    )
130  )
131
132  (defun I (alat blat)
133    (cond
134     ((or (null alat) (null blat)) (quote()))
135     ((not (null (retMember (car blat) alat))) (car blat))
136     (t (I alat (cdr blat)))
137    )
138  )
139
140  (I lat1 l4)
141  (I lat1 lat2)
142  (I lat1 lat3)
143
144  ;=============================================================================
145  ; multiI
146  ;=============================================================================
147  (defun multiI (alat blat)
148    (cond
149     ((or (null alat) (null blat)) (quote()))
150     ((not (null (retMember (car blat) alat))) (cons (car blat) (multiI alat (cdr blat))))
151     (t (multiI alat (cdr blat)))
152    )
153  )
154
155  (multiI lat1 lat2)
156  (multiI lat1 lat3)
157
158  ;=============================================================================
159  ; count0 (questions ask to fix it)
160  ;=============================================================================
161  (defun count0 (vec)
162    (cond
163     ((null vec) 0)
164     ((zerop (car vec)) (1+ (count0 (cdr vec))))
165     (t (+ 0 (count0 (cdr vec))))
166    )
167  )
168
169  (count0 (list 1 2 3 4 5 0 0 0 1 2 45))
170  (count0 ())
171  (count0 (list 0))
172  (count0 (list 1 2 3))
173
174  ;=============================================================================
175  ; multiUp
176  ;=============================================================================
177  (defun multiUp (lat)
178    (cond
179     ((null lat) (quote()))
180     ((atom (car lat)) (cons (car lat) (multiUp (cdr lat)))) ;element is atom
181     ((null (car lat)) (multiUp (cdr lat))) ;element is empty list
182     ((null (cdr (car lat))) (cons (car (car lat)) (multiUp (cdr lat)))) ;element is single element list
183     (t (cons (car lat) (multiUp (cdr lat)))) ;element is list with more than one element
184    )
185  )
186
187  (multiUp l4)
188  (multiUp l1)
189  (multiUp l2)
190  (multiUp l3)
191