src/sicp/ch2_2.rkt

   1 #lang scheme
   2
   3 (require (planet soegaard/sicp:2:1/sicp))
   4
   5 ;; count-leaves
   6 (define (count-leaves x)
   7   (cond
   8     [(null? x) 0]
   9     [(not (pair? x)) 1]
  10     [else (+ (count-leaves (first x))
  11              (count-leaves (rest x)))]))
  12
  13 ;; scale tree
  14 (define (scale-tree tree factor)
  15   (cond [(null? tree) '()]
  16         [(not (pair? tree)) (* tree factor)]
  17         [else (cons (scale-tree (first tree) factor)
  18                     (scale-tree (rest tree) factor))]))
  19
  20 (define (scale-tree-map tree factor)
  21   (map (lambda (x)
  22          (if (not (pair? x))
  23              (* x factor)
  24              (scale-tree-map x factor)))
  25        tree))
  26
  27 (define (square-of-four tl tr bl br)
  28   (lambda (painter)
  29     (let ((top (beside (tl painter) (tr painter)))
  30           (bottom (beside (bl painter) (br painter))))
  31       (below bottom top))))
  32
  33 (define (flipped-pairs painter)
  34   (let ((combine4 (square-of-four identity flip-vert
  35                                   identity flip-vert)))
  36     (combine4 painter)))
  37
  38 (define (identity x) x)
  39
  40 (define (corner-split painter n)
  41   (if (= n 0)
  42       painter
  43       (let ((up (up-split painter (- n 1)))
  44             (right (right-split painter (- n 1))))
  45         (let ((top-left (beside up up))
  46               (bottom-right (below right right))
  47               (corner (corner-split painter (- n 1))))
  48           (beside (below painter top-left)
  49                   (below bottom-right corner))))))
  50
  51 (define (right-split painter n)
  52   (if (= n 0)
  53       painter
  54       (let ((smaller (right-split painter (- n 1))))
  55         (beside painter (below smaller smaller)))))
  56
  57 (define (up-split painter n)
  58   (if (= n 0)
  59       painter
  60       (let ((smaller (up-split painter (- n 1))))
  61         (below painter (beside smaller smaller)))))
  62
  63 (define (square-limit painter n)
  64   (let ((combine4 (square-of-four flip-horiz identity
  65                                   rotate180 flip-vert)))
  66     (combine4 (corner-split painter n))))