]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/misc.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / 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))