Lösungen der Übungen zu Kapitel 3

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

1

2

3

4

5

6

7

8

9

10

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

1

2

3

4

5

6

7

8

9

10

11

12

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

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

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

1

2

3

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

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

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

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

(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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

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

1

2

3

4

5

6

7

8

9

10

11

12

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

Schreibe einen Kommentar Antworten abbrechen