src/sicp/misc.rkt

   1 #lang racket
   2
   3 (define (map1 f list)
   4   (cond
   5     [(empty? list) '()]
   6     [else (cons (f (first list))
   7                 (map1 f (rest list)))]))
   8
   9 (define (mymap f lists)
  10   (cond
  11     [(empty? (first lists)) '()]
  12     [else (cons (apply f (map1 first lists))
  13                 (mymap f (map1 rest lists)))]))
  14
  15 ;; 2.28
  16 (define (fringe coll)
  17   (cond
  18     [(null? coll) '()]
  19     [(not (pair? coll)) (list coll)]
  20     [else (append (fringe (first coll))
  21                   (fringe (rest coll)))]))
  22
  23 (define (scale-tree tree factor)
  24   (map (lambda (subtree)
  25          (if (pair? subtree)
  26              (scale-tree subtree factor)
  27              (* subtree factor)))
  28        tree))
  29
  30 ;; 2.30
  31 (define (square-tree1 tree)
  32   (map (lambda (subtree)
  33          (if (pair? subtree)
  34              (square-tree1 subtree)
  35              (* subtree subtree)))
  36        tree))
  37
  38 (define (square-tree2 tree)
  39   (cond
  40     [(null? tree) '()]
  41     [(not (pair? tree)) (* tree tree)]
  42     [else (cons (square-tree2 (car tree))
  43                 (square-tree2 (cdr tree)))]))
  44
  45 (define (fringe1 tree)
  46   (map (lambda (subtree)
  47          (if (not (pair? subtree))
  48              subtree
  49              (fringe1 subtree)))
  50        tree))
  51
  52
  53 (define (tree-map f tree)
  54   (map (lambda (subtree)
  55          (if (pair? subtree)
  56              (tree-map f subtree)
  57              (f subtree)))
  58        tree))