SICP - chapter 2 习题

(define (make-rat n d)
  (let ((t1 (if (< n 0) -1 1)) ;获取n和d的符号位
        (t2 (if (< d 0) -1 1)))
       (cond ((= (* t1 t2) 1) (cons (* t1 n) (* t2 d)))
             ((= t1 -1) (cons n d))
             ((= t2 -1) (cons (* t2 n) (* t2 d))))))
(displayln (make-rat 1 22))
(displayln (make-rat 1 -22))
(displayln (make-rat -1 22))
(displayln (make-rat -1 -22))

(define (make-point x y)
  (cons x y))

(define (x-point p)
  (car p))

(define (y-point p)
  (cdr p))

(define (make-segment x y)
  (cons x y))

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cdr s))

(define (mid-segment s)
  (let ((startP (start-segment s))
        (endP (end-segment s)))
       (let ((x1 (x-point startP))
             (x2 (x-point endP))
             (y1 (y-point startP))
             (y2 (y-point endP)))
            (make-point (/ (+ x1 x2) 2) (/ (+ y1 y2) 2)))))

(define (print-point p)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

(define seg1 (make-segment (make-point 1 1) (make-point 3 3)))
(print-point (mid-segment seg1))

; 需要运行2.2
(define (make-rec p1 p2)
  (cons p1 p2))

(define (rec-length p)
  (let ((p1 (car p))
        (p2 (cdr p)))
       (let ((x1 (x-point p1))
             (x2 (x-point p2)))
            (abs (- x1 x2)))))

(define (rec-width p)
  (let ((p1 (car p))
        (p2 (cdr p)))
       (let ((y1 (y-point p1))
             (y2 (y-point p2)))
            (abs (- y1 y2)))))

(define (rec-area p)
  (* (rec-length p) (rec-width p)))

(define (rec-perimeter p)
  (* 2 (+ (rec-length p) (rec-width p))))

(define rec1 (make-rec (make-point 0 0) (make-point 3 2)))

(displayln (rec-area rec1))
(displayln (rec-perimeter rec1))

; 为了使rec-area和rec-perimeter过程不改变，另一种定义方式只要提供rec-length和rec-width接口即可。

(define (cons1 x y)
  (lambda (m) (m x y)))

(define (car1 z)
  (z (lambda (p q) p)))

(define (cdr1 z)
  (z (lambda (p q) q)))

(car1 (cons1 1 2))
(cdr1 (cons1 1 2))

(cdr1 (cons1 1 2))
; =>
(cdr1 (lambda (m) (m 1 2)))
; =>
((lambda (m) (m 1 2)) (lambda (p q) q))
;=>
((lambda (p q) q) 1 2)

(displayln "----2.17")
(define (last-pair l)
  (if (null? l)
      null
      (if (null? (cdr l))
          (car l)
          (last-pair (cdr l)))))

(last-pair (list 1 2 3))
(last-pair (list))

(define (reverse l)
  (if (null? l)
      null
      (append (reverse (cdr l)) (list (car l)))))

(reverse (list))
(reverse (list 1))
(reverse (list 1 2 3))

(define (same-parity x . xs)
  (define (same-p n)
        (= (remainder x 2) (remainder n 2)))
  (if (null? xs)
      null
      (if (= (remainder x 2) (remainder (car xs) 2))
          (cons (car xs) (apply same-parity (cons x (cdr xs))))
          (apply same-parity (cons x (cdr xs))))))

(same-parity 111 2 3 4 5 6 7 8 9)
(same-parity 100 2 3 4 5 6 7 8 9)

(define (for-each f xs)
  (if (null? xs)
      #t
      (begin
        (f (car xs))
        (for-each f (cdr xs)))))

(for-each (lambda (x) (displayln x)) (list 1 2 3))

(define x25-1 (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr x25-1)))))

(define x25-2 (list (list 7)))
(car (car x25-2))

(define x25-3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr x25-3))))))))))))

(define x26 (list 1 2 3))
(define y26 (list 4 5 6))
(append x26 y26)
(cons x26 y26)
(list x26 y26)

(define (deep-reverse l)
  (if (null? l)
      null
      (if (list? (car l))
          (append (deep-reverse (cdr l)) (list (deep-reverse (car l))))
          (append (deep-reverse (cdr l)) (list (car l))))))
(deep-reverse '())
(deep-reverse '(1))
(deep-reverse '(1 2))
(deep-reverse (list (list 1 2) (list 3 4)))
(deep-reverse '((1 2) (3 4) 5 6 (7 8)))

(displayln "二叉树版抽象")
(define (left-tree tree)
  (car tree))
(define (right-tree tree)
  (car (cdr tree)))
(define (fringe-bin tree)
  (cond ((null? tree) null)
        ((pair? tree) (append
                         (fringe-bin (left-tree tree))
                         (fringe-bin (right-tree tree))))
        (else (list tree))))

; 多叉树无法work
;(fringe-bin (list (list 1 2 3) (list 4 5 6) (list 7 8) 9))
(define x28 (list (list 1 2) (list 3 4)))
(fringe-bin x28)
(fringe-bin (list x28 x28))

; 多叉树work版
(define (fringe tree)
  (cond ((null? tree) null)
        ((pair? tree) (append
                         (fringe (car tree))
                         (fringe (cdr tree))))
        (else (list tree))))
(fringe (list (list 1 2 3) (list 4 5 6) (list 7 8) 9))