三分 的个人资料3fen's Notebook照片日志列表更多 工具 帮助

日志


2月27日

2.43

问题出在queen-cols是个递归的过程调用,把(queen-cols (- k 1))放到嵌套映射里面,使得这个递归调用在每次flatmap时不是像2.42那样只执行一次,而是执行board-size那么多次,我估计的时间应该在2.42的board-size^board-size倍这个数量级上。

2.42

(define empty-board ())

(define (adjoin-position new-row k rest-of-queens)
  (cond ((> k (+ 1 (length rest-of-queens))) "Error")
        ((< k 0) "Error")
        ((= k (+ 1 (length rest-of-queens))) (append rest-of-queens (list new-row)))
        ((= k 1) (cons new-row
                       rest-of-queens))
        (else (cons (car rest-of-queens)
                    (adjoin-position new-row
                                     (- k 1)
                                     (cdr rest-of-queens))))))

(define (safe? k positions)
  (define (safe-each? queen-row)
    (let ((this-queen (list-ref positions (- k 1)))
          (that-queen (list-ref positions (- queen-row 1))))
      (and (not (= this-queen that-queen))
           (not (= (abs (- k queen-row))
                   (abs (- this-queen that-queen)))))))
    (accumulate (lambda (x y) (and x y))
                #t
                (map safe-each?
                     (enumerate-interval 1 (- k 1)))))

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

;写这几个过程难度不大,难的是怎样把整个问题分割为这些小问题,题目给了不小的提示呢...

2.41

(define (tri-seq n sum)
  (filter (lambda(tri)
            (sum-s? tri sum))
          (flatmap (lambda(i)
                     (map (lambda(pair)
                            (cons i pair))
                          (unique-pairs (- i 1))))
                   (enumerate-interval 1 n))))
(define (sum-s? seq s)
  (= s (+ (car seq)
          (cadr seq)
          (cadr (cdr seq)))))
;用到了前面写的unique-pairs过程

2.40

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))
(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
;=============unique-pairs==========
(define (unique-pairs n)
  (flatmap (lambda(i)
             (map (lambda (j)
                    (list i j))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

2.39

(define (reverse1 seqs)
  (fold-left (lambda(x y) (cons y x))
             nil seqs))

(define (reverse2 seqs)
  (fold-right f
              nil seqs))
(define f (lambda(x y) (append (cond ((null? y) y)     
                                     ((not (pair? y)) (list y))
                                     (else y))
                               (cond ((null? x) x)
                                     ((not(pair? x)) (list x))
                                     (else x)))))

;第二个虽然结果不错,但感觉实在有点牵强,待修改...

2.38

;> (fold-right / 1 (list 1 2 3))
;1 1/2
;> (fold-left / 1 (list 1 2 3))
;1/6
;> (fold-right list nil (list 1 2 3))
;(1 (2 (3 ())))
;> (fold-left list nil (list 1 2 3))
;(((() 1) 2) 3)

fold-right不能简单的吧fold-left中的op 里的两个参数换位,只有用accumulate那样的递归程序或者用append才能正确实现。
想要fold-right和left返回结果一样,op一定要满足交换律。

2.37

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

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

(define (transpose mat)
  (accumulate-n cons       ;这里不能换用list,否则每行多出一个()
                nil
                mat))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (matrix-*-vector cols x))
         m)))
;写的两个打印过程
(define (print-v v)
  (cond ((null? v) (newline))
        (else (display "  ")
              (display (car v))
              (print-v (cdr v)))))
(define (print-m m)
  (cond ((null? m) (newline))
        (else (print-v (car m))
              (print-m (cdr m)))))

2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs)) ;用car seqs而不是seqs,因为最后返回的是一个由空队列组成的队列:(() () ()),而不是空队列
      nil
      (cons (accumulate op
                        init
                        (map car seqs))
            (accumulate-n op
                          init
                          (map cdr seqs)))))

2.35

(define (count-leaves2 tree)
  (accumulate +
              0
              (map (lambda(x) 1)
                   (fringe tree))))
;其中用到了之前写的fringe过程,不知道是不是一定要用...
2月25日

2.34

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

2.33

(define (map p sequence)
  (accumulate (lambda(x y) (cons (p x) y))
              nil
              sequence))
(define nil ())

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length sequence)
  (accumulate (lambda (x y) (+ 1 y))
              0
              sequence))
;红字即是答案

2.32

(define (subset s)
  (if (null? s)
      (list nil)         ;之所以不是nil是因为即使原集合没有元素,它也至少有一个子集:空集
      (let ((rest (subset (cdr s))))
        (append rest (map (lambda(x)     
                            (cons (car s)
                                    x))
                          ;一个集合的子集是由它除去第一个元素剩下的集合的子集并上这个子集每个元素与第一个元素的并集
                          rest)))))
(define nil ())
;这题挺有意思的,寥寥几句就把求子集的过程描绘出来。
;所填入的那句话,举个例子就是(1 2 3)的子集就是(2 3)的子集{(),(2),(3),(2,3)}并上{(1),(1,2),(1,3),(1,2,3)}

2.31

(define (tree-map f tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (f tree))
        (else (cons (tree-map f (car tree))
              (tree-map f (cdr tree))))))
(define nil ())

(define (tree-map2 f tree)
  (map (lambda(subtree)
         (if (pair? subtree)
             (tree-map2 f subtree)
             (f subtree)))
       tree))

2.30

(define (square-tree1 x)
  (cond ((null? x) nil)
        ((not (pair? x)) (square x))
        (else (cons (square-tree1 (car x))
                    (square-tree1 (cdr x))))))
(define (square x) (* x x))
(define nil ())

(define (square-tree2 x)
  (map (lambda (subtree)
         (if (pair? subtree)
             (square-tree2 subtree)
             (square subtree)))
       x))

2.29

(define (make-mofile left right)
  (list left right))
(define (left-branch x)
  (car x))
(define (right-branch x)
  (car (cdr x)))

(define (make-branch length structure)
  (list length structure))
(define (branch-length x)
  (car x))
(define (branch-structure x)
  (car (cdr x)))

(define (total-weight x)
  (define (branch-weight t)
    (if (not (pair? (branch-structure t)))
        (branch-structure t)
        (total-weight (branch-structure t))))
  (if (not (pair? x))
      x
      (+ (branch-weight (left-branch x))
         (branch-weight (right-branch x)))))

(define (balance? x)
  (if (not (pair? x))
      #t
      (and (balance? (branch-structure (left-branch x)))
           (balance? (branch-structure (right-branch x)))
           (= (* (branch-length (left-branch x))
                 (total-weight (branch-structure (left-branch x))))
              (* (branch-length (right-branch x))
                 (total-weight (branch-structure (right-branch x))))))))

;d)的答案:直接用car cdr选择即可,代码如下:
(define (make-mofile left right)
  (cons left right))
(define (left-branch x)
  (car x))
(define (right-branch x)
  (cdr x))

(define (make-branch length structure)
  (cons length structure))
(define (branch-length x)
  (car x))
(define (branch-structure x)
  (cdr x))

2.27递归版

;2.27 deep-reverse递归版
(define (deep-reverse x)
  (cond ((null? x) ())
        ((not (pair? x)) (cons x ()))
        (else (append (deep-reverse (cdr x))
                      (deep-reverse (car x))))))

;从2.28得到的启示,利用append的话就可以不利用result而直接构造新的序对顺序了

2.28

(define (fringe x)
  (cond ((null? x) ())
        ((not (pair? x)) (cons x ()))     ;这里的返回的不是x而是(cons x ()) 是因为后面的append只接受过程
        (else (append (fringe (car x))
                      (fringe (cdr x))))))
;后面章节有个enumerate过程,与这相同

2.27

(define (deep-reverse x)
  (define (iter x result)
    (cond ((null? x) result)
          ((not (pair? x)) x)
          (else (iter (cdr x)
                      (cons (iter (car x)     ;与reverse不同的地方,替换car x
                                  ())
                            result)))))
  (iter x ()))

2.26

> (append x y)
(1 2 3 4 5 6)
> (cons x y)
((1 2 3) 4 5 6)
> (list x y)
((1 2 3) (4 5 6))
通过2.25的理解,应该这个题不难

2.25

(define x (list 1 3 (list 5 7) 9))
(define y (list (list 7)))
(define z (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))

(display (car (cdr (car (cdr (cdr x))))))
(newline)
(display (car (car y)))
(newline)
(display (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr z)))))))))))))
;第三个有点绕 举个简单的例子试一下就明白了 (define t (list 1 (list 2 3)))
;(cdr t)   >((2 3))