2.30-2.42

;2.30
(define (square-tree tree)
  (cond ((null? tree) '())
        ((not (pair? tree)) (* tree tree))
        (else (cons (square-tree (car tree))
                    (square-tree (cdr tree))))))

(define (sq-tree tree)
  (map (lambda (sub-tree)
         (if (not (pair? sub-tree))
             (* sub-tree sub-tree)
             (sq-tree sub-tree)))
       tree))

;2.31
(define (tree-map f tree)
  (map (lambda (sub-tree)
         (if (not (pair? sub-tree))
             (f sub-tree)
             (tree-map f sub-tree)))
       tree))

(define (t-tree tree)
  (tree-map square tree))

(define (square x)
  (* x x))

;2.32

;null define
(define nil '())

(define (subsets s)
  (if (null? s)
      (list '())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (cons (car s) x)) rest)))))

;2.33
(define (taccumulate op initial seq)
  (if (null? seq)
      initial
      (op (car seq)
          (taccumulate op initial (cdr seq))))) 

(define (tmap p sequencet)
  (taccumulate (lambda (x y)
                 (if (not (pair? x))
                     (cons (p x) y)
                     (cons (tmap p x) y)))
               nil 
               sequencet))

(define (tappend seq1 seq2)
  (taccumulate cons seq2 seq1))

(define (tlength seq)
  (taccumulate (lambda (x y) (+ 1 y))  0 seq))

;2.34
(define (horner-eval x coefficient-sequence)
  (taccumulate (lambda (this-coeff higher-terms)
                 (+ this-coeff (* x higher-terms)))
               0
               coefficient-sequence))

;2.35
(define (count-leaves t)
  (taccumulate + 0 (map (lambda (x) 
                         (if (not (pair? x))
                             1
                             (count-leaves x)))
                       t)))

;2.36
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
             nil
             (cons (taccumulate op init (map (lambda (x) (car x)) seqs))
                   (accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))

;2.37

;v(i) * w(i)
(define (dot-product v w)
  (taccumulate + 0 (map * v w)))

;matrix * vector
(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product v x)) m))

;transpot 
(define (transpose mat)
  (accumulate-n cons nil mat))

;2.38
(define (fold-left op initial seqs)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial seqs))

;2.39
(define fold-right taccumulate)
(define (r-reverse seqs)
  (fold-right (lambda (x y) 
                (if (not (pair? x))
                    (cons y x)
                    (cons y (r-reverse x)))) nil seqs))

(define (l-reverse seqs)
  (fold-left (lambda (x y) 
               (if (not (pair? y))
                   (cons y x)
                   (cons (l-reverse y) x))) nil seqs))

;2.40

;make pair
(define (enumerate-interval k n)
  (define (iter i)
    (cond ((= i (- n 1)) (list (- n 1)))
          ((or (> k n) (= k n)) nil)
          (else (append (list i) (iter (+ 1 i))))))
  (iter k))

(define (proc-i n)
  (map (lambda (x) (cons n x)) (enumerate-interval 1 n)))

(define (unique-pair n)
  (taccumulate append 
               nil 
               (map (lambda (i)
                      (map (lambda (j) (list i j))
                           (enumerate-interval 1 i)))
                    (enumerate-interval 1 (+ 1 n)))))

;2.41 it's a little complex to get a good displaying
(define (3-unique-pair n s)
  (taccumulate (lambda (x y)
                 (op-s (filter-3-pair x) y))
               nil
               (map (lambda (i)
                      (map (lambda (j) 
                             (map (lambda (k) 
                                    (if (and (not (= i j)) (not (= i k)) (not (= j k)) (= s (+ i j k))) 
                                        (list i j k)
                                        nil)) 
                                  (enumerate-interval 1 n))) 
                           (enumerate-interval 1 n))) 
                    (enumerate-interval 1 n))))

;3-pair?
(define 3-pair?
  (lambda (x)
    (if (and (pair? x)
             (= (length x) 3)
             (not (pair? (car x)))
             (not (pair? (cadr x)))
             (not (pair? (caddr x)))
             (not (and (null? (car x)) (null? (cadr x)) (null? (caddr x)))))
        #t
        #f)))

;filter-3-pair
(define op-s
  (lambda (x y)
    (if (or (null? x) (null? y) (and (pair? x) (not (3-pair? x))) (and (pair? y) (not (3-pair? y))))
        (append x y)
        (list x y))))

(define (filter-3-pair x)
  (if (3-pair? x)
      x
      (if (pair? x)
          (op-s (filter-3-pair (car x)) (filter-3-pair (cdr x)))
          nil)))

  
;2.42 the eight queens are everywhere

;flatmap
(define (flatmap proc seq)
  (taccumulate append nil (map proc seq)))

;filter
(define (filter predicate sequencet)
  (cond ((null? sequencet) nil)
        ((predicate (car sequencet))
         (cons (car sequencet)
               (filter predicate (cdr sequencet))))
        (else (filter predicate (cdr sequencet)))))

; ;eight queens
; ; queen-cols
; ;( (1 3 5 7 ...)
; ;  (2 4 5 4 ...)
; ;  .....)

(define empty-board nil)
(define (queens board-size)
  (define (queen-cols k)
    (if (= 0 k)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (reset-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k reset-of-queens))
                 (enumerate-interval 1 (+ 1 board-size))))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;adjoin-position
(define (adjoin-position new-row k rest-of-queens)
  (append rest-of-queens (list new-row)))

;safe?
 
(define (safe? k positions)
  (define new-row (list-ref positions (- k 1)))
  (define (iter i) 
    (cond ((= i k) #t)
          ((or (= new-row (list-ref positions (- i 1)))
               (= (abs (- k i)) (abs (- new-row (list-ref positions (- i 1)))))) #f)
          (else (iter (+ 1 i)))))
  (if (null? (cdr positions))
      #t 
     (iter 1)))

 
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值