diff --git a/2_27.sch b/2_27.sch new file mode 100644 index 0000000..7f9869b --- /dev/null +++ b/2_27.sch @@ -0,0 +1,8 @@ +(define (deep-reverse l) + (define (reverse-acc l acc) + (cond ((null? l) acc) + ((pair? (car l)) + (reverse-acc (cdr l) (cons (deep-reverse (car l)) acc))) + (else + (reverse-acc (cdr l) (cons (car l) acc))))) + (reverse-acc l '())) diff --git a/2_28.sch b/2_28.sch new file mode 100644 index 0000000..8d78015 --- /dev/null +++ b/2_28.sch @@ -0,0 +1,5 @@ +(define (fringe t) + (cond ((null? t) '()) + ((not (pair? t)) (list t)) + (else (append (fringe (car t)) + (fringe (cdr t)))))) diff --git a/2_29.sch b/2_29.sch new file mode 100644 index 0000000..7e96634 --- /dev/null +++ b/2_29.sch @@ -0,0 +1,60 @@ +;(define (make-mobile left right) + ;(list left right)) + +(define (make-mobile left right) + (cons left right)) + +;(define (make-branch length structure) + ;(list length structure)) + +(define (make-branch length structure) + (cons length structure)) + +(define (left-branch mobile) + (car mobile)) + +;(define (right-branch mobile) + ;(cadr mobile)) + +(define (right-branch mobile) + (cdr mobile)) + +(define (branch-length branch) + (car branch)) + +;(define (branch-structure branch) + ;(cadr branch)) + +(define (branch-structure branch) + (cdr branch)) + + +(define (mobile? m) (pair? m)) + +(define (branch-weight branch) + (let ((struct (branch-structure branch))) + (if (mobile? struct) + (total-weight struct) + struct))) + +(define (total-weight mobile) + (+ (branch-weight (left-branch mobile)) + (branch-weight (right-branch mobile)))) + + +(define (torque branch) + (* (branch-length branch) + (branch-weight branch))) + +(define (balanced? struct) + (cond ((null? struct) #t) + ((not (mobile? struct)) #t) + (else + (let* ((l (left-branch struct)) + (r (right-branch struct)) + (l-struct (branch-structure l)) + (r-struct (branch-structure r))) + (and (balanced? l-struct) + (balanced? r-struct) + (= (torque l) (torque r))))))) + diff --git a/2_30.sch b/2_30.sch new file mode 100644 index 0000000..9c6945a --- /dev/null +++ b/2_30.sch @@ -0,0 +1,23 @@ +(define (square x) (* x x)) + +(define (square-tree tree) + (cond ((null? tree) '()) + ((not (pair? tree)) (square tree)) + (else + (cons (square-tree (car tree)) + (square-tree (cdr tree)))))) + +(define (square-tree-map tree) + (map (lambda (sub-tree) + (if (pair? sub-tree) + (square-tree-map sub-tree) + (square sub-tree))) + tree)) + +(define (tree-map fn tree) + (map (lambda (sub-tree) + (if (pair? sub-tree) + (tree-map fn sub-tree) + (fn sub-tree))) + tree)) + diff --git a/2_32.sch b/2_32.sch new file mode 100644 index 0000000..03426c7 --- /dev/null +++ b/2_32.sch @@ -0,0 +1,10 @@ +(define (subsets s) + (if (null? s) + (list '()) + (let ((rest (subsets (cdr s)))) + (append rest (map (lambda (l) (cons (car s) l)) rest))))) + +; By induction: Empty case is obvious. Suppose we have T_n, the set of subsets of +; S_n = {s_1, ... , s_n}. Let S_{n+1} = S + {s_{n+1}}. Then T_n is a subset of +; T_{n+1}. Any element of T_{n+1}\T_n must contain s_{n+1}, otherwise it would +; have been in T_n. diff --git a/2_33.sch b/2_33.sch new file mode 100644 index 0000000..f5fddda --- /dev/null +++ b/2_33.sch @@ -0,0 +1,14 @@ +(define (accumulate op initial sequence) + (if (null? sequence) + initial + (op (car sequence) + (accumulate op initial (cdr sequence))))) + +(define (map p sequence) + (accumulate (lambda (x y) (cons (p x) y)) '() sequence)) + +(define (append seq1 seq2) + (accumulate cons seq2 seq1)) + +(define (length sequence) + (accumulate (lambda (x y) (+ 1 y)) 0 sequence)) diff --git a/2_34.sch b/2_34.sch new file mode 100644 index 0000000..83c8018 --- /dev/null +++ b/2_34.sch @@ -0,0 +1,5 @@ +(define (horner-eval x coefficient-sequence) + (accumulate (lambda (this-coeff higher-terms) + (+ (* higher-terms x) this-coeff)) + 0 + coefficient-sequence)) diff --git a/2_35.sch b/2_35.sch new file mode 100644 index 0000000..d9775da --- /dev/null +++ b/2_35.sch @@ -0,0 +1,19 @@ +;(define (count-leaves x) +; (cond ((null? x) 0) +; ((not (pair? x)) 1) +; (else (+ (count-leaves (car x)) +; (count-leaves (cdr x)))))) + +(define (accumulate op initial sequence) + (if (null? sequence) + initial + (op (car sequence) + (accumulate op initial (cdr sequence))))) + + +(define (count-leaves x) + (accumulate + 0 (map (lambda (y) + (if (not (pair? y)) + 1 + (+ (count-leaves (car y)) + (count-leaves (cdr y))))) x))) diff --git a/2_36.sch b/2_36.sch new file mode 100644 index 0000000..1314774 --- /dev/null +++ b/2_36.sch @@ -0,0 +1,11 @@ +(define (accumulate op initial sequence) + (if (null? sequence) + initial + (op (car sequence) + (accumulate op initial (cdr sequence))))) + +(define (accumulate-n op init seqs) + (if (null? (car seqs)) + '() + (cons (accumulate op init (map car seqs)) + (accumulate-n op init (map cdr seqs))))) diff --git a/2_44.sch b/2_44.sch new file mode 100644 index 0000000..7b956f1 --- /dev/null +++ b/2_44.sch @@ -0,0 +1,58 @@ +;: (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)))) + + +; 2.44 +(define (up-split painter n) + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below painter (beside smaller smaller))))) + +(define (right-split painter n) + (if (= n 0) + painter + (let ((smaller (right-split painter (- n 1)))) + (beside painter (below smaller smaller))))) + +; 2.45 +(define (split inner-op outer-op) + (define (compose painter n) + (if (= n 0) + painter + (let ((smaller (compose painter (- n 1)))) + (outer-op painter (inner-op smaller smaller))))) + (compose)) diff --git a/2_54.sch b/2_54.sch new file mode 100644 index 0000000..e2c5b70 --- /dev/null +++ b/2_54.sch @@ -0,0 +1,6 @@ +(define (equal? a b) + (cond ((eq? a b) #t) + ((not (and (pair? a) (pair? b))) #f) + (else (and (equal? (car a) (car b)) + (equal? (cdr a) (cdr b)))))) +