sicp: section 2.2

sicp/2/2/1.scm

+(display (cons (cons 1 2)
+               (cons 3 4)))
+(newline)
+(display (cons (cons 1
+               (cons 2 3))
+               4))
+(newline)
+
+(display (cons 1
+               (cons 2
+                     (cons 3
+                           (cons 4 'nil)))))
+(newline)
+
+(define one-through-four (list 1 2 3 4))
+(display one-through-four)
+(newline)
+
+(display (car one-through-four))
+(newline)
+(display (cdr one-through-four))
+(newline)
+(display (car (cdr one-through-four)))
+(newline)
+(display (cadr one-through-four))
+(newline)
+(display (cons 10 one-through-four))
+(newline)
+(display (cons 5 one-through-four))
+(newline)
+
+(define (list-ref items n)
+  (if (= n 0)
+    (car items)
+    (list-ref (cdr items) (- n 1))))
+(define squares (list 1 4 9 16 25))
+(display (list-ref squares 3))
+(newline)
+
+(define (length items)
+  (if (null? items)
+    0
+    (+ 1 (length (cdr items)))))
+(define odds (list 1 3 5 7))
+(display (length odds))
+(newline)
+
+(define (length items)
+  (define (iter a count)
+    (if (null? a)
+      count
+      (iter (cdr a) (+ count 1))))
+  (iter items 0))
+(display (length odds))
+(newline)
+
+(define (append list1 list2)
+  (if (null? list1)
+    list2
+    (cons (car list1) (append (cdr list1) list2))))
+(display (append squares odds))
+(newline)
+(display (append odds squares))
+
+(define (scale-list items factor)
+  (if (null? items)
+    items
+    (cons (* (car items) factor)
+          (scale-list (cdr items) factor))))
+(newline)
+(newline)
+(display (scale-list (list 1 2 3 4 5) 10))
+(newline)
+
+(define (map proc items)
+  (if (null? items)
+    items
+    (cons (proc (car items))
+          (map proc (cdr items)))))
+(display (map abs (list -10 2.5 -11.6 17)))
+(newline)
+(display (map (lambda (x) (* x x))
+              (list 1 2 3 4)))
+(newline)
+
+(define (scale-list items factor)
+  (map (lambda (x) (* x factor))
+       items))
+(display (scale-list (list 1 2 3 4 5) 10))
+(newline)

sicp/2/2/2.scm

+(display (cons (list 1 2) (list 3 4)))
+(newline)
+
+(define (count-leaves x)
+  (cond ((null? x) 0)
+        ((not (pair? x)) 1)
+        (else (+ (count-leaves (car x))
+                 (count-leaves (cdr x))))))
+
+(define x (cons (list 1 2) (list 3 4)))
+(display (length x))
+(newline)
+(display (count-leaves x))
+(newline)
+
+(display (list x x))
+(newline)
+(display (length (list x x)))
+(newline)
+(display (count-leaves (list x x)))
+(newline)
+
+(define (scale-tree tree factor)
+  (cond ((null? tree) tree)
+        ((not (pair? tree)) (* tree factor))
+        (else (cons (scale-tree (car tree) factor)
+                    (scale-tree (cdr tree) factor)))))
+
+(display (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
+                     10))
+(newline)
+
+(define (scale-tree tree factor)
+  (map (lambda (sub-tree)
+         (if (pair? sub-tree)
+           (scale-tree sub-tree factor)
+           (* sub-tree factor)))
+       tree))
+
+(display (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
+                     10))
+(newline)

sicp/2/2/3.scm

+(define (sum-odd-squares tree)
+  (cond ((null? tree) 0)
+        ((not (pair? tree))
+         (if (odd? tree) (square tree) 0))
+        (else (+ (sum-odd-squares (car tree))
+                 (sum-odd-squares (cdr tree))))))
+
+(display (sum-odd-squares (list 1 (list 2 (list 3 4) 5) (list 6 7))))
+
+(define (fib n)
+  (cond ((= n 0) 0)
+        ((= n 1) 1)
+        (else (+ (fib (- n 1))
+                 (fib (- n 2))))))
+
+(define nil (cdr (list 0)))
+(define (even-fibs n)
+  (define (next k)
+    (if (> k n)
+      nil
+      (let ((f (fib k)))
+        (if (even? f)
+          (cons f (next (+ k 1)))
+          (next (+ k 1))))))
+  (next 0))
+
+(newline)
+(display (even-fibs 10))
+
+(newline)
+(display (map square (list 1 2 3 4 5)))
+
+(define (filter predicate sequence)
+  (cond ((null? sequence) nil)
+        ((predicate (car sequence))
+         (cons (car sequence)
+               (filter predicate (cdr sequence))))
+        (else (filter predicate (cdr sequence)))))
+
+(newline)
+(display (filter odd? (list 1 2 3 4 5)))
+
+(define (accumulate op initial sequence)
+  (if (null? sequence)
+    initial
+    (op (car sequence)
+        (accumulate op initial (cdr sequence)))))
+
+(newline)
+(display (accumulate + 0 (list 1 2 3 4 5)))
+(newline)
+(display (accumulate * 1 (list 1 2 3 4 5)))
+(newline)
+(display (accumulate cons nil (list 1 2 3 4 5)))
+
+(define (enumerate-interval low high)
+  (if (> low high)
+    nil
+    (cons low (enumerate-interval (+ low 1) high))))
+
+(newline)
+(display (enumerate-interval 2 7))
+
+(define (enumerate-tree tree)
+  (cond ((null? tree) nil)
+        ((not (pair? tree)) (list tree))
+        (else (append (enumerate-tree (car tree))
+                      (enumerate-tree (cdr tree))))))
+
+(newline)
+(display (enumerate-tree (list 1 (list 2 (list 3 4) 5))))
+
+(define (sum-odd-squares tree)
+  (accumulate +
+              0
+              (map square
+                   (filter odd?
+                           (enumerate-tree tree)))))
+
+(newline)
+(display (sum-odd-squares (list 1 (list 2 (list 3 4) 5) (list 6 7))))
+
+(define (even-fibs n)
+  (accumulate cons
+              nil
+              (filter even?
+                      (map fib
+                           (enumerate-interval 0 n)))))
+
+(newline)
+(display (even-fibs 10))
+
+(define (list-fib-squares n)
+  (accumulate cons
+              nil
+              (map square
+                   (map fib
+                        (enumerate-interval 0 n)))))
+
+(newline)
+(display (list-fib-squares 10))
+
+(define (product-of-squares-of-odd-elements sequence)
+  (accumulate *
+              1
+              (map square
+                   (filter odd? sequence))))
+
+(newline)
+(display (product-of-squares-of-odd-elements (list 1 2 3 4 5)))
+
+(define (f n)
+  (accumulate append
+              nil
+              (map (lambda (i)
+                     (map (lambda (j) (list i j))
+                          (enumerate-interval 1 (- i 1))))
+                   (enumerate-interval 1 n))))
+
+(newline)
+(newline)
+(display (f 6))
+
+(define (flatmap proc seq)
+  (accumulate append nil (map proc seq)))
+
+(define (f n)
+  (flatmap (lambda (i)
+             (map (lambda (j) (list i j))
+                  (enumerate-interval 1 (- i 1))))
+           (enumerate-interval 1 n)))
+
+(newline)
+(display (f 6))
+
+(define (smallest-divisor n)
+  (define (find-divisor n test-divisor)
+    (define (divides? a b)
+      (= (remainder b a) 0))
+    (cond ((> (square test-divisor) n) n)
+          ((divides? test-divisor n) test-divisor)
+          (else (find-divisor n (+ test-divisor 1)))))
+  (find-divisor n 2))
+
+(define (prime? n)
+  (= n (smallest-divisor n)))
+(define (prime-sum? pair)
+  (prime? (+ (car pair) (cadr pair))))
+
+(define (make-pair-sum pair)
+  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
+
+(define (prime-sum-pairs n)
+  (map make-pair-sum
+       (filter prime-sum?
+               (flatmap
+                 (lambda (i)
+                   (map (lambda (j) (list i j))
+                        (enumerate-interval 1 (- i 1))))
+                 (enumerate-interval 1 n)))))
+
+(newline)
+(display (prime-sum-pairs 6))
+
+(define (remove item sequence)
+  (filter (lambda (x) (not (= x item)))
+          sequence))
+
+(define (permutations s)
+  (if (null? s)
+    (list s)
+    (flatmap (lambda (x)
+               (map (lambda (p) (cons x p))
+                    (permutations (remove x s))))
+             s)))
+
+(newline)
+(display (permutations (list 1 2 3)))
+
+(newline)

sicp/2/2/4.scm

+;(define wave2 (beside wave (flip-vert wave)))
+;(define wave4 (below wave2 wave2))
+
+(define (flipped-pairs painter)
+  (let ((painter2 (beside painter (flip-vert painter))))
+    (below painter2 painter2)))
+
+;(define wave4 flipped-pairs wave)
+
+(define (right-split painter n)
+  (if (= n 0)
+    painter
+    (let ((smaller (right-split painter (- n 1))))
+      (beside painter (below smaller smaller)))))
+
+(define (corner-split painter n)
+  (if (= n 0)
+    painter
+    (let ((up (up-split painter (- n 1)))
+          (right (right-split painter (- n 1))))
+      (let ((top-left (beside up up))
+            (bottom-right (below right right))
+            (corner (corner-split painter (- n 1))))
+        (beside (below painter top-left)
+                (below bottom-right corner))))))
+
+(define (square-limit painter n)
+  (let ((quarter (corner-split painter n)))
+    (let ((half (beside (flip-horiz quarter) quarter)))
+      (below (flip-vert half) half))))
+
+(define (square-of-four tl tr bl br)
+  (lambda (painter)
+    (let ((top (beside (tl painter) (tr painter)))
+          (bottom (beside (bl painter) (br painter))))
+      (below bottom top))))
+
+(define (flipped-pairs painter)
+  (let ((combine4 (square-of-four identity flip-vert
+                                  identity flip-vert)))
+    (combine4 painter)))
+
+(define (square-limit painter n)
+  (let ((combine4 (square-of-four flip-horiz identity
+                                  rotate180 flip-vert)))
+    (combine4 (corner-split painter n))))
+
+(define (frame-coord-map frame)
+  (lambda (v)
+    (add-vect
+      (origin-frame frame)
+      (add-vect (scale-vect (xcor-vect v)
+                            (edge1-frame frame))
+                (scale-vect (ycor-vect v)
+                            (edge2-frame frame))))))
+
+(define (segments->painter segment-list)
+  (lambda (frame)
+    (for-each
+      (lambda (segment)
+        (draw-line
+          ((frame-coord-map frame) (star-segment segment))
+          ((frame-coord-map frame) (end-segment segment))))
+      segment-list)))
+
+(define (transform-painter painter origin corner1 corner2)
+  (lambda (frame)
+    (let ((m (frame-coord-map frame)))
+      (let ((new-origin (m origin)))
+        (painter
+          (make-frame new-origin
+                      (sub-vect (m corner1) new-origin)
+                      (sub-vect (m corner2) new-origin)))))))
+
+(define (flip-vert painter)
+  (transform-painter painter
+                     (make-vect 0.0 1.0)
+                     (make-vect 1.0 1.0)
+                     (make-vect 0.0 0.0)))
+
+(define (shrink-to-upper-right painter)
+  (transform-painter painter
+                     (make-vect 0.5 0.5)
+                     (make-vect 1.0 0.5)
+                     (make-vect 0.5 1.0)))
+
+(define (rotate90 painter)
+  (transform-painter painter
+                     (make-vect 1.0 0.0)
+                     (make-vect 1.0 1.0)
+                     (make-vect 0.0 0.0)))
+
+(define (square-inwards painter)
+  (transform-painter painter
+                     (make-vect 0.0 0.0)
+                     (make-vect 0.65 0.35)
+                     (make-vect 0.35 0.65)))
+
+(define (beside painter1 painter2)
+  (let ((split-point (make-vect 0.5 0.0)))
+    (let ((paint-left
+            (transform-painter painter1
+                               (make-vect 0.0 0.0)
+                               split-point
+                               (make-vect 0.0 1.0)))
+          (paint-right
+            (transform-painter painter2
+                               split-point
+                               (make-vect 1.0 0.0)
+                               (make-vect 0.5 1.0))))
+      (lambda (frame)
+        (paint-left frame)
+        (paint-right frame)))))

sicp/2/2/ex_17.scm

+(define (last-pair l)
+  (if (null? (cdr l))
+    l
+    (last-pair (cdr l))))
+(display (last-pair (list 23 72 149 34)))
+(newline)

sicp/2/2/ex_18.scm

+(define (reverse l)
+  (define (iter l result)
+    (if (null? l)
+      result
+      (iter (cdr l) (cons (car l) result))))
+  (iter l '()))
+(display (reverse (list 1 4 9 16 25)))
+(newline)
+(display (reverse '()))
+(newline)

sicp/2/2/ex_19.scm

+(define us-coins (list 50 25 10 5 1))
+(define uk-coins (list 100 50 20 10 5 2 1 0.5))
+
+(define (cc amount coin-values)
+  (define no-more? null?)
+  (define except-first-denomination cdr)
+  (define first-denomination car)
+  (cond ((= amount 0) 1)
+        ((or (< amount 0) (no-more? coin-values)) 0)
+        (else
+          (+ (cc amount
+                 (except-first-denomination coin-values))
+             (cc (- amount
+                    (first-denomination coin-values))
+                 coin-values)))))
+
+(display (cc 100 us-coins))
+(newline)

sicp/2/2/ex_20.scm

+(define (same-parity . l)
+  (define (iter p l)
+    (cond ((null? l) l)
+          ((= (remainder (car l) 2) p)
+           (cons (car l) (iter p (cdr l))))
+          (else (iter p (cdr l)))))
+  (iter (remainder (car l) 2) l))
+
+(display (same-parity 1 2 3 4 5 6 7))
+(newline)
+(display (same-parity 2 3 4 5 6 7))
+(newline)

sicp/2/2/ex_21.scm

+(define (square-list items)
+  (if (null? items)
+    items
+    (cons (* (car items) (car items))
+          (square-list (cdr items)))))
+(display (square-list (list 1 2 3 4)))
+(newline)
+
+(define (square-list items)
+  (map (lambda (x) (* x x)) items))
+(display (square-list (list 1 2 3 4)))
+(newline)

sicp/2/2/ex_22.scm

+(define (square-list items)
+  (define (iter things answer)
+    (if (null? things)
+      answer
+      (iter (cdr things)
+            (cons (square (car things))
+                   answer))))
+  (iter items '()))
+(display (square-list (list 1 2 3 4)))
+(newline)
+
+(define (square-list items)
+  (define (iter things answer)
+    (if (null? things)
+      answer
+      (iter (cdr things)
+            (cons answer
+                  (square (car things))))))
+  (iter items '()))
+(display (square-list (list 1 2 3 4)))
+(newline)

sicp/2/2/ex_23.scm

+(define (for-each f l)
+  (cond ((not (null? l))
+         (f (car l))
+         (for-each f (cdr l)))))
+(for-each (lambda (x) (display x) (newline))
+          (list 57 312 88))

sicp/2/2/ex_24.scm

+(display (list 1 (list 2 (list 3 4))))
+(newline)

sicp/2/2/ex_25.scm

+(define l (list 1 3 (list 5 7) 9))
+(display l)
+(newline)
+(display (car (cdaddr l)))
+(newline)
+
+(define l (list (list 7)))
+(display l)
+(newline)
+(display (caar l))
+(newline)
+
+(define l (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
+(display l)
+(newline)
+(display (cadadr (cadadr (cadadr l))))
+(newline)

sicp/2/2/ex_26.scm

+(define x (list 1 2 3))
+(define y (list 4 5 6))
+
+(display (append x y))
+(newline)
+(display (cons x y))
+(newline)
+(display (list x y))
+(newline)

sicp/2/2/ex_27.scm

+(define (deep-reverse l)
+  (define (iter l result)
+    (cond ((null? l) result)
+          ((not (pair? (car l)))
+           (iter (cdr l)
+                 (cons (car l) result)))
+          (else
+            (iter (cdr l)
+                  (cons (deep-reverse (car l)) result)))))
+  (iter l '()))
+
+(define x (list (list 1 2) (list 3 4)))
+(display x)
+(newline)
+(display (reverse x))
+(newline)
+(display (deep-reverse x))
+(newline)

sicp/2/2/ex_28.scm

+(define x (list (list 1 2) (list 3 4)))
+(display x)
+(newline)
+
+(define (fringe l)
+  (cond ((null? l) l)
+        ((not (pair? (car l)))
+         (cons (car l) (fringe (cdr l))))
+        (else (append (fringe (car l)) (fringe (cdr l))))))
+
+(display (fringe x))
+(newline)
+(display (fringe (list x x)))
+(newline)

sicp/2/2/ex_29.scm

+(define (make-mobile left right)
+  (list left right))
+(define (make-branch length structure)
+  (list length structure))
+
+(define (left-branch m) (car m))
+(define (right-branch m) (cadr m))
+(define (branch-length b) (car b))
+(define (branch-structure b) (cadr b))
+
+(define (structure-weight s) (if (pair? s) (total-weight s) s))
+(define (total-weight m)
+  (if (null? m)
+    0
+    (+ (structure-weight (branch-structure (left-branch m)))