LISP – Arturs Blog

29. Oktober 202230. Januar 2024

Lösungen der Übungen zu Kapitel 5

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 5.

Übung 1:

;;; (a)
(defun exercise-1a-before (y)
  (let ((x (car y)))
    (cons x x)))

(exercise-1a-before '(a b c)) ; (A . A) 

(defun exercise-1a-after (y)
  ((lambda (x) (cons x x)) (car y)))

(exercise-1a-after '(a b c)) ; (A . A)

;;; (b)
(defun exercise-1b-before (x z)
  (let* ((w (car x))
         (y (+ w z)))
    (cons w y)))

(exercise-1b-before '(1 2 3) 5) ; (1 . 6)

(defun exercise-1b-after (x z)
  ((lambda (w) 
     ((lambda (y) (cons w y)) (+ w z)))
   (car x)))

(exercise-1b-after '(1 2 3) 5) ; (1 . 6)

;;; (a)

(defun exercise-1a-before (y)

(let ((x (car y)))

(cons x x)))

(exercise-1a-before '(a b c)) ; (A . A)

(defun exercise-1a-after (y)

((lambda (x) (cons x x)) (car y)))

(exercise-1a-after '(a b c)) ; (A . A)

;;; (b)

(defun exercise-1b-before (x z)

(let* ((w (car x))

(y (+ w z)))

(cons w y)))

(exercise-1b-before '(1 2 3) 5) ; (1 . 6)

(defun exercise-1b-after (x z)

((lambda (w)

((lambda (y) (cons w y)) (+ w z)))

(car x)))

(exercise-1b-after '(1 2 3) 5) ; (1 . 6)

Übung 2:

;;; Das Original
(defun mystery (x y)
  (if (null y)
      nil
      (if (eql (car y) x)
          0
          (let ((z (mystery x (cdr y))))
            (and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; Lösung
(defun mystery-cond (x y)
  (cond ((null y) nil)
        ((eql (car y) x) 0)
        (t (let ((z (mystery x (cdr y))))
                   (and z (+ z 1))))))

(mystery-cond 'a '(b c a d e a a f a)) ; 2

(mystery 'x '(b c d e a a f a)) ; NIL

;;; Das Original

(defun mystery (x y)

(if (null y)

nil

(if (eql (car y) x)

(let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; Lösung

(defun mystery-cond (x y)

(cond ((null y) nil)

((eql (car y) x) 0)

(t (let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery-cond 'a '(b c a d e a a f a)) ; 2

(mystery 'x '(b c d e a a f a)) ; NIL

Übung 3:

(defun square-5 (x)
  (if (<= x 5)
      nil
      (* x x)))

(square-5 1) ; nil
(square-5 5) ; nil
(square-5 6) ; 36

(defun square-5 (x)

(if (<= x 5)

nil

(* x x)))

(square-5 1) ; nil

(square-5 5) ; nil

(square-5 6) ; 36

Übung 4:

;;; Original
(defconstant month #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defun leap? (y)
  (and (zerop (mod y 4))
       (or (zerop (mod y 400))
           (not (zerop (mod y 100))))))

(defun month-num (m y)
  (+ (svref month (- m 1))
     (if (and (> m 2) (leap? y)) 1 0)))

(month-num 1 2000) ; 0
(month-num 2 2000) ; 31
(month-num 3 2000) ; 68

;;; Lösung
(defun month-num-new (m y)
  (+ (case m
       (1 0)
       (2 31)
       (3 59)
       (4 90)
       (5 120)
       (6 151)
       (7 181)
       (8 212)
       (9 243)
       (10 273)
       (11 304)
       (12 334)
       (otherwise 365))
     (if (and (> m 2) (leap? y)) 1 0)))

(month-num-new 1 2000) ; 0
(month-num-new 2 2000) ; 31
(month-num-new 3 2000) ; 60
(month-num-new 4 2000) ; 91
(month-num-new 5 2000) ; 121
(month-num-new 6 2000) ; 152
(month-num-new 7 2000) ; 182
(month-num-new 8 2000) ; 213
(month-num-new 9 2000) ; 244
(month-num-new 10 2000) ; 274
(month-num-new 11 2000) ; 305
(month-num-new 12 2000) ; 335
(month-num-new 13 2000) ; 366

;;; Original

(defconstant month #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defun leap? (y)

(and (zerop (mod y 4))

(or (zerop (mod y 400))

(not (zerop (mod y 100))))))

(defun month-num (m y)

(+ (svref month (- m 1))

(if (and (> m 2) (leap? y)) 1 0)))

(month-num 1 2000) ; 0

(month-num 2 2000) ; 31

(month-num 3 2000) ; 68

;;; Lösung

(defun month-num-new (m y)

(+ (case m

(1 0)

(2 31)

(3 59)

(4 90)

(5 120)

(6 151)

(7 181)

(8 212)

(9 243)

(10 273)

(11 304)

(12 334)

(otherwise 365))

(if (and (> m 2) (leap? y)) 1 0)))

(month-num-new 1 2000) ; 0

(month-num-new 2 2000) ; 31

(month-num-new 3 2000) ; 60

(month-num-new 4 2000) ; 91

(month-num-new 5 2000) ; 121

(month-num-new 6 2000) ; 152

(month-num-new 7 2000) ; 182

(month-num-new 8 2000) ; 213

(month-num-new 9 2000) ; 244

(month-num-new 10 2000) ; 274

(month-num-new 11 2000) ; 305

(month-num-new 12 2000) ; 335

(month-num-new 13 2000) ; 366

Übung 5:

;;; Iterativ
(defun precedes-iter (el vec)
  (if (< (length vec) 2)
      nil
      (let ((result nil))
        (do ((i 1 (+ i 1))
             (e (aref vec 0) (aref vec i)))
            ((= i (length vec)) (reverse result))
          (if (equal el (aref vec i))
               (push e result))))))

(precedes-iter 1 #()) ; nil
(precedes-iter 1 #(1)) ; nil
(precedes-iter 1 #(1 2)) ; nil
(precedes-iter 1 #(2 1)) ; (2)
(precedes-iter 4 #(1 4 6 4)) ; (1 6)
(precedes-iter #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Rekursiv
(defun precedes-rec-internal (el vec i result)
  (if (= i (length vec))
      result
      (progn
        (if (equal el (aref vec i))
            (push (aref vec (- i 1)) result))
        (precedes-rec-internal el vec (+ i 1) result))))

(defun precedes-rec (el vec)
  (if (< (length vec) 2)
      nil
      (reverse (precedes-rec-internal el vec 1 nil))))

(precedes-rec 1 #()) ; nil
(precedes-rec 1 #(1)) ; nil
(precedes-rec 1 #(1 2)) ; nil
(precedes-rec 1 #(2 1)) ; (2)
(precedes-rec 4 #(1 4 6 4)) ; (1 6)
(precedes-rec #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Iterativ

(defun precedes-iter (el vec)

(if (< (length vec) 2)

nil

(let ((result nil))

(do ((i 1 (+ i 1))

(e (aref vec 0) (aref vec i)))

((= i (length vec)) (reverse result))

(if (equal el (aref vec i))

(push e result))))))

(precedes-iter 1 #()) ; nil

(precedes-iter 1 #(1)) ; nil

(precedes-iter 1 #(1 2)) ; nil

(precedes-iter 1 #(2 1)) ; (2)

(precedes-iter 4 #(1 4 6 4)) ; (1 6)

(precedes-iter #\a "abracadabra") ; (#\r #\c #\d #\r)

;;; Rekursiv

(defun precedes-rec-internal (el vec i result)

(if (= i (length vec))

result

(progn

(if (equal el (aref vec i))

(push (aref vec (- i 1)) result))

(precedes-rec-internal el vec (+ i 1) result))))

(defun precedes-rec (el vec)

(if (< (length vec) 2)

nil

(reverse (precedes-rec-internal el vec 1 nil))))

(precedes-rec 1 #()) ; nil

(precedes-rec 1 #(1)) ; nil

(precedes-rec 1 #(1 2)) ; nil

(precedes-rec 1 #(2 1)) ; (2)

(precedes-rec 4 #(1 4 6 4)) ; (1 6)

(precedes-rec #\a "abracadabra") ; (#\r #\c #\d #\r)

Übung 6:

;;; Iterativ
(defun intersperse-iter (el lst)
  (let ((len (length lst))
        (res nil)
        (ls lst))
    (if (< len 2)
        lst
        (do* ((i 1 (+ i 1))
             (ls ls (cdr ls))
             (e (car ls) (car ls)))
            ((= len i) (push e res))
          (push e res)
          (push el res)))
  (reverse res)))

(intersperse-iter '- '(a b c d)) ; (A - B - C - D)

;;; Rekursiv
(defun intersperse-rec (el lst)
  (if (null lst)
      nil
      (cons (car lst)
            (if (> (length lst) 1)
                (cons el (intersperse-rec el (cdr lst)))
                (car (cdr lst)))))))

(intersperse-rec '- '(a b c d)) ; (A - B - C - D)

;;; Iterativ

(defun intersperse-iter (el lst)

(let ((len (length lst))

(res nil)

(ls lst))

(if (< len 2)

lst

(do* ((i 1 (+ i 1))

(ls ls (cdr ls))

(e (car ls) (car ls)))

((= len i) (push e res))

(push e res)

(push el res)))

(reverse res)))

(intersperse-iter '- '(a b c d)) ; (A - B - C - D)

;;; Rekursiv

(defun intersperse-rec (el lst)

(if (null lst)

nil

(cons (car lst)

(if (> (length lst) 1)

(cons el (intersperse-rec el (cdr lst)))

(car (cdr lst)))))))

(intersperse-rec '- '(a b c d)) ; (A - B - C - D)

Übung 7:

;;; (a) Rekursiv
(defun num-diff-1-rec-internal (lst former)
  (cond ((null lst) t)
        ((= (- (car lst) former) 1)
         (num-diff-1-rec-internal (cdr lst) (car lst)))
        (t nil)))

(defun num-diff-1-rec (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (num-diff-1-rec-internal (cdr lst) (car lst))))

(num-diff-1-rec nil) ; nil
(num-diff-1-rec '(2)) ; nil
(num-diff-1-rec '(2 3)) ; t
(num-diff-1-rec '(2 3 4 5 6)) ; t
(num-diff-1-rec '(2 3 5 6 7)) ; nil

;;; (b) Iterativ
(defun num-diff-1-iter (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (do ((res t (and res (= (- (second lst) (first lst)) 1)))
           (lst lst (cdr lst)))
          ((null (cdr lst)) res))))
        
(num-diff-1-iter nil) ; nil
(num-diff-1-iter '(2)) ; nil
(num-diff-1-iter '(2 3)) ; t
(num-diff-1-iter '(2 3 4 5 6)) ; t
(num-diff-1-iter '(2 3 5 6 7)) ; nil

;;; (c) mapc return
(defun num-diff-1-mapc (lst)
  (if (or (null lst) (null (cdr lst)))
      nil
      (let ((former (first lst)))
        (mapc #'(lambda (next)
                  (progn
                    (if (/= (- next former) 1)
                        (return-from num-diff-1-mapc nil))
                    (setf former next)))
              (cdr lst))
        t)))
        
(num-diff-1-mapc nil) ; nil
(num-diff-1-mapc '(2)) ; nil
(num-diff-1-mapc '(2 3)) ; t
(num-diff-1-mapc '(2 3 4 5 6)) ; t
(num-diff-1-mapc '(2 3 5 6 7)) ; nil

;;; (a) Rekursiv

(defun num-diff-1-rec-internal (lst former)

(cond ((null lst) t)

((= (- (car lst) former) 1)

(num-diff-1-rec-internal (cdr lst) (car lst)))

(t nil)))

(defun num-diff-1-rec (lst)

(if (or (null lst) (null (cdr lst)))

nil

(num-diff-1-rec-internal (cdr lst) (car lst))))

(num-diff-1-rec nil) ; nil

(num-diff-1-rec '(2)) ; nil

(num-diff-1-rec '(2 3)) ; t

(num-diff-1-rec '(2 3 4 5 6)) ; t

(num-diff-1-rec '(2 3 5 6 7)) ; nil

;;; (b) Iterativ

(defun num-diff-1-iter (lst)

(if (or (null lst) (null (cdr lst)))

nil

(do ((res t (and res (= (- (second lst) (first lst)) 1)))

(lst lst (cdr lst)))

((null (cdr lst)) res))))

(num-diff-1-iter nil) ; nil

(num-diff-1-iter '(2)) ; nil

(num-diff-1-iter '(2 3)) ; t

(num-diff-1-iter '(2 3 4 5 6)) ; t

(num-diff-1-iter '(2 3 5 6 7)) ; nil

;;; (c) mapc return

(defun num-diff-1-mapc (lst)

(if (or (null lst) (null (cdr lst)))

nil

(let ((former (first lst)))

(mapc #'(lambda (next)

(progn

(if (/= (- next former) 1)

(return-from num-diff-1-mapc nil))

(setf former next)))

(cdr lst))

t)))

(num-diff-1-mapc nil) ; nil

(num-diff-1-mapc '(2)) ; nil

(num-diff-1-mapc '(2 3)) ; t

(num-diff-1-mapc '(2 3 4 5 6)) ; t

(num-diff-1-mapc '(2 3 5 6 7)) ; nil

Übung 8:

(defun maxmin-internal (vec len i max min)
  (if (= i len)
      (values max min)
      (let ((a (svref vec i)))
        (maxmin-internal
         vec
         len
         (+ i 1)
         (if (> a max) a max)
         (if (< a min) a min)))))


(defun maxmin (vec)
  (if (or (null vec) (zerop (length vec)))
      nil
      (let ((a (svref vec 0)))
        (maxmin-internal vec (length vec) 1 a a))))

(maxmin #(3 20 4 6 15 7 4 9 10)) ; 20, 3
(maxmin #(1)) ; 1, 1 
(maxmin #()) ; nil 
(maxmin nil) ; nil

(defun maxmin-internal (vec len i max min)

(if (= i len)

(values max min)

(let ((a (svref vec i)))

(maxmin-internal

vec

len

(+ i 1)

(if (> a max) a max)

(if (< a min) a min)))))

(defun maxmin (vec)

(if (or (null vec) (zerop (length vec)))

nil

(let ((a (svref vec 0)))

(maxmin-internal vec (length vec) 1 a a))))

(maxmin #(3 20 4 6 15 7 4 9 10)) ; 20, 3

(maxmin #(1)) ; 1, 1

(maxmin #()) ; nil

(maxmin nil) ; nil

29. Oktober 202230. Januar 2024

Lösungen der Übungen zu Kapitel 4

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 4.

Übung 1:

(defun quarter-turn (arr)
  (let* ((dims (array-dimensions arr))
         (ar (make-array dims :initial-element nil))
         (dim (car dims)))
    (do ((y 0 (+ y 1)))
        ((= y dim) ar)
      (do ((x 0 (+ x 1)))
          ((= x dim) nil)
        (setf (aref ar y x) (aref arr (- dim x 1) y))))))

(quarter-turn #2A((a b) (c d))) ; #2A((C A) (D B))
(quarter-turn #2A((c a) (d b))) ; #2A((D C) (B A))
(quarter-turn #2A((d c) (b a))) ; #2A((B D) (A C))
(quarter-turn #2A((b d) (a c))) ; #2A((A B) (C D))

(quarter-turn #2A((a b c) (d e f) (1 2 3))) ; #2A((1 D A) (2 E B) (3 F C))

(defun quarter-turn (arr)

(let* ((dims (array-dimensions arr))

(ar (make-array dims :initial-element nil))

(dim (car dims)))

(do ((y 0 (+ y 1)))

((= y dim) ar)

(do ((x 0 (+ x 1)))

((= x dim) nil)

(setf (aref ar y x) (aref arr (- dim x 1) y))))))

(quarter-turn #2A((a b) (c d))) ; #2A((C A) (D B))

(quarter-turn #2A((c a) (d b))) ; #2A((D C) (B A))

(quarter-turn #2A((d c) (b a))) ; #2A((B D) (A C))

(quarter-turn #2A((b d) (a c))) ; #2A((A B) (C D))

(quarter-turn #2A((a b c) (d e f) (1 2 3))) ; #2A((1 D A) (2 E B) (3 F C))

Übung 2:

(defun new-copy-list (lst)
  (reduce #'cons lst :from-end t :initial-value nil))

(new-copy-list '(a b c)) ; (a b c)

(defun new-reverse (lst)
  (reduce #'(lambda (a b) (cons b a)) lst :initial-value nil))

(new-reverse '(a b c d))

(defun new-copy-list (lst)

(reduce #'cons lst :from-end t :initial-value nil))

(new-copy-list '(a b c)) ; (a b c)

(defun new-reverse (lst)

(reduce #'(lambda (a b) (cons b a)) lst :initial-value nil))

(new-reverse '(a b c d))

Übung 6:

;;; (a)
(defun assoc-to-hash (lst)
  (let ((ht (make-hash-table)))
    (dolist (sl lst)
        (setf (gethash (car sl) ht) (cdr sl)))
    ht)
  )

;;; Test (a)
(setf trans '((+ . "add") (- . "subtract")
              (* . "multiply") (/ . "divide")))

trans

(setf ht (assoc-to-hash trans))
(gethash '- ht) ; "subtract", T
(gethash '+ ht) ; "add", T
(gethash '* ht) ; "multiply", T
(gethash '/ ht) ; "divide", T

;;; (b)
(defun hash-to-assoc (ht)
  (let ((lst nil))
    (maphash #'(lambda (k v) (setf lst (cons (cons k v) lst))) ht)
    lst))

;;; Test (b)
(setf ass (hash-to-assoc ht))
(assoc '- ass) ; (- . "subtract")
(assoc '+ ass) ; (+ . "add") 
(assoc '* ass) ; (* . "multiply")
(assoc '/ ass) ; (/ . "divide")
ass

;;; (a)

(defun assoc-to-hash (lst)

(let ((ht (make-hash-table)))

(dolist (sl lst)

(setf (gethash (car sl) ht) (cdr sl)))

ht)

)

;;; Test (a)

(setf trans '((+ . "add") (- . "subtract")

(* . "multiply") (/ . "divide")))

trans

(setf ht (assoc-to-hash trans))

(gethash '- ht) ; "subtract", T

(gethash '+ ht) ; "add", T

(gethash '* ht) ; "multiply", T

(gethash '/ ht) ; "divide", T

;;; (b)

(defun hash-to-assoc (ht)

(let ((lst nil))

(maphash #'(lambda (k v) (setf lst (cons (cons k v) lst))) ht)

lst))

;;; Test (b)

(setf ass (hash-to-assoc ht))

(assoc '- ass) ; (- . "subtract")

(assoc '+ ass) ; (+ . "add")

(assoc '* ass) ; (* . "multiply")

(assoc '/ ass) ; (/ . "divide")

ass

22. Oktober 202230. Januar 2024

Lösungen der Übungen zu Kapitel 3

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 3.

Übung 2:

(defun new-union (a b)
  (let ((ac (copy-list a)))
    (dolist (e b)
      (if (not (member e ac))
          (setf ac (append ac (list e)))))
    ac))
    
(union '(a b c) '(b a d)) ; (c b a d)

(new-union '(a b c) '(b a d)) ; (a b c d)

(defun new-union (a b)

(let ((ac (copy-list a)))

(dolist (e b)

(if (not (member e ac))

(setf ac (append ac (list e)))))

ac))

(union '(a b c) '(b a d)) ; (c b a d)

(new-union '(a b c) '(b a d)) ; (a b c d)

Übung 3:

(defun occurrences (lst)
  (let ((results (list (cons (car lst) 0)))
        (r nil))
    (dolist (elm lst)
      (setf r (assoc elm results))
      (if r
          (incf (cdr r))
          (push (cons elm 1) results)))
    (setf results (sort results #'(lambda (x y) (> (cdr x) (cdr y))))) 
    results))

(occurrences '(a b a d a c d c a))

(defun occurrences (lst)

(let ((results (list (cons (car lst) 0)))

(r nil))

(dolist (elm lst)

(setf r (assoc elm results))

(if r

(incf (cdr r))

(push (cons elm 1) results)))

(setf results (sort results #'(lambda (x y) (> (cdr x) (cdr y)))))

results))

(occurrences '(a b a d a c d c a))

Übung 4:

(member '(a ) '((a) (b)) :test #'equal)

;;; member benutzt zum Vergleich standardmäßig eql

(member '(a ) '((a) (b)) :test #'equal)

;;; member benutzt zum Vergleich standardmäßig eql

Übung 5:

;;; Recursion
(defun pos+rec-internal (lst n)
  (if (null lst)
      nil
      (cons (+ (car lst) n) (pos+rec-internal (cdr lst) (+ n 1)))))

(defun pos+rec (lst)
  (pos+rec-internal lst 0))

(pos+rec '(7 5 1 4))

;;; Itertiv
(defun pos+iter (lst)
  (let ((i 0)
        (results nil))
    (dolist (elem lst)
      (setf results (cons (+ i elem) results))
      (setf i (+ 1 i)))
    (reverse results)))
        
(pos+iter '(7 5 1 4))

;;; mapcar
(defun pos+map (lst)
  (let ((idx -1))
    (mapcar #'(lambda (x) (incf idx)
                      (+ idx x))
            lst)))

(pos+map '(7 5 1 4))

;;; Recursion

(defun pos+rec-internal (lst n)

(if (null lst)

nil

(cons (+ (car lst) n) (pos+rec-internal (cdr lst) (+ n 1)))))

(defun pos+rec (lst)

(pos+rec-internal lst 0))

(pos+rec '(7 5 1 4))

;;; Itertiv

(defun pos+iter (lst)

(let ((i 0)

(results nil))

(dolist (elem lst)

(setf results (cons (+ i elem) results))

(setf i (+ 1 i)))

(reverse results)))

(pos+iter '(7 5 1 4))

;;; mapcar

(defun pos+map (lst)

(let ((idx -1))

(mapcar #'(lambda (x) (incf idx)

(+ idx x))

lst)))

(pos+map '(7 5 1 4))

Übung 6:

(defun new-car (lst)
  (cdr lst))

(defun new-cdr (lst)
  (car lst))

(new-car '(1 2 3)) ; (2 3)

(new-cdr '(1 2 3)) ; 1

(defun new-cons (elm1 elm2)
  (cons elm1 elm2))

(new-cons 'a '(b c)) ; (a b c)

(defun new-list-internal (lst)
  (if (null (new-cdr lst))
      nil
      (new-cons (new-cdr lst) (new-list-internal (new-car lst)))))

(defun new-list (&rest lst)
  (new-list-internal (new-cons (new-cdr lst) (new-car lst))))

(new-list-internal '(a b c)) ; (a b c)

(new-list 'a 'b 'c) ; (a b c)

(defun new-length (lst)
  (if (null lst)
      0
      (+ 1 (new-length (new-car lst)))))

(new-length '(a b c d)) ; 4

(defun new-member (elm lst)
  (if (null lst)
      nil
      (if (eql elm (new-cdr lst))
          t
          (new-member elm (new-car lst)))))

(new-member 'a nil) ; nil
(new-member 'e '(a b c d)) ; nil
(new-member 'c '(a b c d)) ; t

(defun new-car (lst)

(cdr lst))

(defun new-cdr (lst)

(car lst))

(new-car '(1 2 3)) ; (2 3)

(new-cdr '(1 2 3)) ; 1

(defun new-cons (elm1 elm2)

(cons elm1 elm2))

(new-cons 'a '(b c)) ; (a b c)

(defun new-list-internal (lst)

(if (null (new-cdr lst))

nil

(new-cons (new-cdr lst) (new-list-internal (new-car lst)))))

(defun new-list (&rest lst)

(new-list-internal (new-cons (new-cdr lst) (new-car lst))))

(new-list-internal '(a b c)) ; (a b c)

(new-list 'a 'b 'c) ; (a b c)

(defun new-length (lst)

(if (null lst)

(+ 1 (new-length (new-car lst)))))

(new-length '(a b c d)) ; 4

(defun new-member (elm lst)

(if (null lst)

nil

(if (eql elm (new-cdr lst))

(new-member elm (new-car lst)))))

(new-member 'a nil) ; nil

(new-member 'e '(a b c d)) ; nil

(new-member 'c '(a b c d)) ; t

Übung 7:

(defun compress (x)
  (if (consp x)
      (compr (car x) 1 (cdr x))
      x))

(defun compr (elt n 1st)
  (if (null 1st)
      (list (n-elts elt n))
      (let ((next (car 1st)))
        (if (eql next elt)
            (compr elt (+ n 1) (cdr 1st))
            (cons (n-elts elt n)
                  (compr next 1 (cdr 1st)))))))

(defun n-elts (elt n)
  (if (> n 1)
      (cons n elt) ; list mit cons ersetzt
      elt))

(compress '(1 1 1 0 1 0 0 0 0 1)) ; ((3 . 1) 0 1 (4 . 0) 1)

(defun compress (x)

(if (consp x)

(compr (car x) 1 (cdr x))

x))

(defun compr (elt n 1st)

(if (null 1st)

(list (n-elts elt n))

(let ((next (car 1st)))

(if (eql next elt)

(compr elt (+ n 1) (cdr 1st))

(cons (n-elts elt n)

(compr next 1 (cdr 1st)))))))

(defun n-elts (elt n)

(if (> n 1)

(cons n elt) ; list mit cons ersetzt

elt))

(compress '(1 1 1 0 1 0 0 0 0 1)) ; ((3 . 1) 0 1 (4 . 0) 1)

Übung 8:

(defun showdots (lst)
  (if (null lst)
      (format t "NIL")
      (progn
        (format t "(~A . " (car lst))
        (showdots (cdr lst))
        (format t ")"))))


(showdots '(a b c)); (A . (B . (C . NIL)))
(showdots nil) ; NIL
(showdots '(a)) ; (A . NIL)

(defun showdots (lst)

(if (null lst)

(format t "NIL")

(progn

(format t "(~A . " (car lst))

(showdots (cdr lst))

(format t ")"))))

(showdots '(a b c)); (A . (B . (C . NIL)))

(showdots nil) ; NIL

(showdots '(a)) ; (A . NIL)

21. Oktober 202230. Januar 2024

Lösungen der Übungen zu Kapitel 2

Ich lese gerade das Buch „ANSI Common Lisp“ von Paul Graham und veröffentliche hier meine Lösungen zu den Übungen am Ende der Kapitel. Hier sind meine Lösungen zu Kapitel 2.

Übung 1:

(+ (- 5 1) (+ 3 7)) ; 14

(list 1 ( + 2 3)) ; (1 5)

(if (listp 1) (+1 2 ) (+ 3 4)) ; 7

(list (and (listp 3) t) (+ 1 2)) ; (nil 3)

(+ (- 5 1) (+ 3 7)) ; 14

(list 1 ( + 2 3)) ; (1 5)

(if (listp 1) (+1 2 ) (+ 3 4)) ; 7

(list (and (listp 3) t) (+ 1 2)) ; (nil 3)

Übung 2:

(cons 'a (cons 'b (cons 'c nil)))

(cons 'a (cons 'b '(c)))

(cons 'a '(b c))

(cons 'a (cons 'b (cons 'c nil)))

(cons 'a (cons 'b '(c)))

(cons 'a '(b c))

Übung 3:

(defun my-fourth (lst)
  (car (cdr (cdr (cdr lst)))))

(my-fourth '(1 2 3 4 5 6))

(defun my-fourth (lst)

(car (cdr (cdr (cdr lst)))))

(my-fourth '(1 2 3 4 5 6))

Übung 4:

(defun my-max (a b)
  (if (> a b) a b))

(my-max 2 1)

(defun my-max (a b)

(if (> a b) a b))

(my-max 2 1)

Übung 5a:

(defun enigma (x)
  (and (not (null x))
       (or (null (car x))
	   (enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil(defun enigma (x)
  (and (not (null x))
       (or (null (car x))
           (enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil

(enigma '(a b)) ; nil

(enigma '(nil a)) ; t

(enigma '(a nil b)); t

(enigma '(nil)); t

;;; d.h. Die Funktion gibt t zurück, wenn in der übergebenen
;;; Liste nil vorkommt, sonst nil

(defun enigma (x)

(and (not (null x))

(or (null (car x))

(enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil(defun enigma (x)

(and (not (null x))

(or (null (car x))

(enigma (cdr x)))))

(enigma nil) ; nil

(enigma '(a)) ; nil

(enigma '(a b)) ; nil

(enigma '(nil a)) ; t

(enigma '(a nil b)); t

(enigma '(nil)); t

;;; d.h. Die Funktion gibt t zurück, wenn in der übergebenen

;;; Liste nil vorkommt, sonst nil

Übung 5b:

(defun mystery (x y)
  (if (null y)
      nil
      (if (eql (car y) x)
          0
          (let ((z (mystery x (cdr y))))
            (and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; wenn y keine Liste ist, dann nil
;;; wenn x in der Liste nicht vorkommt, dann auch nil
;;; sonst die Position vom ersten x in der Liste

(defun mystery (x y)

(if (null y)

nil

(if (eql (car y) x)

(let ((z (mystery x (cdr y))))

(and z (+ z 1))))))

(mystery 'a '(b c a d e a a f a))

(mystery 'x '(b c d e a a f a))

;;; wenn y keine Liste ist, dann nil

;;; wenn x in der Liste nicht vorkommt, dann auch nil

;;; sonst die Position vom ersten x in der Liste

Übung 6:

(car (car (cdr '(a (b c) d)))) ; x = car

(or 13 (/ 1 0)) ; x = or

(apply #'list 1 nil) ; x = apply

(car (car (cdr '(a (b c) d)))) ; x = car

(or 13 (/ 1 0)) ; x = or

(apply #'list 1 nil) ; x = apply

Übung 7:

(defun contains-list (lst)
  (if (null lst)
      nil
      (if (listp (car lst))
          t
          (contains-list (cdr lst)))))

(contains-list nil)

(contains-list '(a b c d))

(contains-list '(a (b c) d))

(defun contains-list (lst)

(if (null lst)

nil

(if (listp (car lst))

(contains-list (cdr lst)))))

(contains-list nil)

(contains-list '(a b c d))

(contains-list '(a (b c) d))

Übung 8a:

(defun print-dots-iter (n)
  (do ((i n (- i 1)))
      ((= i 0) 'done)
    (format t ".")))

(print-dots-iter 3)

(defun print-dots-rec (n)
  (if (zerop n)
      nil
      (progn
        (format t ".")
        (print-dots-rec (- n 1)))))

(print-dots-rec 3)

(defun print-dots-iter (n)

(do ((i n (- i 1)))

((= i 0) 'done)

(format t ".")))

(print-dots-iter 3)

(defun print-dots-rec (n)

(if (zerop n)

nil

(progn

(format t ".")

(print-dots-rec (- n 1)))))

(print-dots-rec 3)

Übung 8b:

(defun count-iter (x lst)
  (do ((counter 0))
      ((null lst) counter)
    (if (eql x (car lst))
        (setf counter (+ counter 1)))
    (setf lst (cdr lst))))

(count-iter 'a '(a b a c d a f g a))

(defun count-rec (x lst)
  (if (null lst)
      0
      (if (eql x (car lst))
          (+ 1 (count-rec x (cdr lst)))
          (count-rec x (cdr lst)))))

(count-rec 'a '(a b a c d a f g a))

(defun count-iter (x lst)

(do ((counter 0))

((null lst) counter)

(if (eql x (car lst))

(setf counter (+ counter 1)))

(setf lst (cdr lst))))

(count-iter 'a '(a b a c d a f g a))

(defun count-rec (x lst)

(if (null lst)

(if (eql x (car lst))

(+ 1 (count-rec x (cdr lst)))

(count-rec x (cdr lst)))))

(count-rec 'a '(a b a c d a f g a))

Übung 9:

(defun summit (lst)
  (setf lst (remove nil lst))
  (apply #' + lst))

(summit '(1 nil 2 nil nil 3))

;;; Die ursprüngliche Version hat nicht funktioniert
;;; weil remove eine neue liste zurück liefert
;;; und die ursprüngliche liste wird nicht verändert

(defun summit2 (lst)
  (if (null lst)
      0
      (let ((x (car lst)))
         (if (null x)
             (summit2 (cdr lst))
             (+ x (summit2 (cdr lst)))))))

(summit2 '(nil 1 2 3 nil 4 5 nil))

(summit2 nil)

;;; Es fehlte die Abbruchbedingung, wenn die Liste leer ist

(defun summit (lst)

(setf lst (remove nil lst))

(apply #' + lst))

(summit '(1 nil 2 nil nil 3))

;;; Die ursprüngliche Version hat nicht funktioniert

;;; weil remove eine neue liste zurück liefert

;;; und die ursprüngliche liste wird nicht verändert

(defun summit2 (lst)

(if (null lst)

(let ((x (car lst)))

(if (null x)

(summit2 (cdr lst))

(+ x (summit2 (cdr lst)))))))

(summit2 '(nil 1 2 3 nil 4 5 nil))

(summit2 nil)

;;; Es fehlte die Abbruchbedingung, wenn die Liste leer ist