Lösungen der Übungen zu Kapitel 4

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

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

1

2

3

4

5

6

7

8

9

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

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

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

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

Schreibe einen Kommentar Antworten abbrechen