All pastes #811406 Raw Edit

Meins

public text v1 · immutable
·published 2007-12-10 21:55 UTC
rendered paste body
;Aufgabe 1a
(define (filter-by-equality value lst)
  (define (f-b-e-help lst nlst)
    (if (and (pair? lst) (not(null? lst)))
        (if (equal? (car lst) value)
            (f-b-e-help (cdr lst) (cons (car lst) nlst))
            (f-b-e-help (cdr lst) nlst)        
            )
        nlst
        )
    )
  (f-b-e-help lst '())
  )
;(filter-by-equality 3 '(1 2 3 4 3 2 1)); --> (3 3)
;(filter-by-equality 7 '(1 2 3 4 3 2 1)); --> ()
;(filter-by-equality '(2) '((1) (2) (3))); --> ((2))
;Aufgabe 1 b
(define (begins-with? prefix lst)
  (if (and (not(null? lst) (pair? prefix) (not(null? prefix))))
      (if (equal? (car prefix) (car lst))
          (if (equal? '() (cdr prefix))
              '#t
              (begins-with? (cdr prefix) (cdr lst)))
          '#f
          )
      )
  )
;(begins-with? '(A B) '(A B C)); --> #t
;(begins-with? '(u v) '(X Y Z)); --> #f
;Aufgabe 1 c
(define (filter-by-prefix prefix list)
  (define (iter list ret)
    (if (null? list)
        ret
        (if (begins-with? prefix (car list))
            (iter (cdr list) (cons (car list) ret))
            (iter (cdr list) ret)
            )
        )
    )
  (reverse (iter list '()))
  )
;(filter-by-prefix '(1) '((1 2) (4 5) (1) (3 2)));--> ((1 2) (1))
;Aufgabe 1 d
(define (index n)
  (define (i-h m liste)
    (if (<= m (- n 1)) (i-h (+ m 1) (cons m liste)) (reverse liste))
    )
  (i-h 0 '())
  )
(define (map-with-index f lst)
  (map f lst (index (length lst)))
  )
;(map-with-index cons '(A B C)); --> ((A . 0) (B . 1) (C . 2))
;Aufgabe 2
(define (my-cons x y)
  (lambda (msg)
    (cond ((eq? msg 'CAR) x)
          ((eq? msg 'CDR) y)
          ((eq? msg 'PAIR) #t)
          ((eq? msg 'FLIP) (cons y x))
          (else (error "pair cannot" msg)))))
(define (my-car p) (p 'CAR))
(define (my-cdr p) (p 'CDR))
(define (my-pair? p) (and (procedure? p) (p 'PAIR)))
(define (flip pair)
  (my-cons (pair 'CDR) (pair 'CAR)) 
  )
;(cons (my-car (flip (my-cons 3 4))) (my-cdr (flip (my-cons 3 4))))
;Aufgabe 3 a
(define (make-area list-of-rows)
  (define (help n lst)
    (cond ((null? lst) (cons n list-of-rows))
          ((= n (length (car lst))) (help n (cdr lst)))
          (else (error "area muss quadratisch sein"))
          ) 
    )
  (help (length list-of-rows) list-of-rows)
  )

;(make-area '((A B) (C D))); --> (2 (A B) (C D))
;Aufgabe 3 b
(define (in-area? area x y)
  (if (and (<= 0 x (- (car area) 1)) (<= 0 y (- (car area) 1)))
      #t
      #f
      )
  )
;(in-area? (make-area '((A B) (C D))) 1 0); --> #t
;(in-area? (make-area '((A B) (C D))) 2 -1); --> #f
;Aufgabe 3 c
(define (area-ref area x y)
  (define (help n liste)
    (if (<= n y) 
        (help (+ n 1) (cdr liste))
        (list-ref (car liste) x)
        )
    )
  (help 0 area)
  )
;(area-ref (make-area '((A B) (C D))) 0 1); --> C
;Aufgabe 3 d
(define (area-map f area)
  (define y 0)
  (define (inner-am-x x y lst olst)
    (if (< x (car area))
        (inner-am-x (+ x 1) (+ y 1) (cdr lst) (append olst (cons (map-with-index (lambda (a b) (f a b y)) (car lst)) '())))
        (cons (car area) olst)))
  (inner-am-x 1 1 (cddr area) (cons (map-with-index (lambda (a b) (f a b y)) (cadr area)) '())))
;(f element x-koordinate y-koordinate)
;(map-with-index f list)
;(area-map list (make-area '((A B) (C D)))); --> (2 ((A 0 0) (B 1 0)) ((C 0 1) (D 1 1)))
;Aufgabe 3 e
(define (area-flatten area)
  (define (area-flatten-help lst hlst)
    (if (null? lst) 
        hlst 
        (area-flatten-help (cdr lst) (append hlst (if 
                                                   (list? (caar lst)) (area-flatten-help (car lst) '()) 
                                                   (car lst)
                                                   )))
        ))
  (area-flatten-help (cdr area) '())
  )
;(area-flatten (make-area '(((A) (B)) ((C) (D))))); --> (B A D C)