(define (for-each proc items) (cond ((null? items) 'done) (else (proc (car items)) (for-each proc (cdr items))))) gosh> (for-each (lambda (x) (newline) (display x)) (list 57 321 88)) 57 321 88done

(define (square-list items) (define (iter things answer) (if (null? things) answer (iter (cdr things) (cons (square (car things)) answer)))) (iter items nil)) ;; iter内でのconsで(square (car things))とanswerを引数として取っている． ;; この…

(define (square-list items) (if (null? items) nil (cons (* (car items) (car items)) (square-list (cdr items))))) (define (square-list items) (map (lambda (x) (* x x)) items))

(define (same-parity x . y) (define (recur lis pred?) (cond ((null? lis) nil) ((pred? (car lis)) (cons (car lis) (recur (cdr lis) pred?))) (else (recur (cdr lis) pred?)))) (cons x (recur y (if (odd? x) odd? even?)))) gosh> (same-parity 1 2…

(define (cc amount coin-values) (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))))) (define first…

(define (reverse items) (define (iter lis result) (if (null? lis) result (iter (cdr lis) (cons (car lis) result)))) (iter items nil))

(define (last-pair items) (if (null? (cdr items)) items (last-pair (cdr items))))

(define (par1 r1 r2) (div-interval (mul-interval r1 r2) (add-interval r1 r2))) (define (par2 r1 r2) (let ((one (make-interval 1 1))) (div-interval one (add-interval (div-interval one r1) (div-interval one r2))))) par1には不確かな数(r1,r2)…

(define (par1 r1 r2) (div-interval (mul-interval r1 r2) (add-interval r1 r2))) (define (par2 r1 r2) (let ((one (make-interval 1 1))) (div-interval one (add-interval (div-interval one r1) (div-interval one r2))))) gosh> (define small (make-…

(define (make-center-width c w) (make-interval (- c w) (+ c w))) (define (center i) (/ (+ (lower-bound i) (upper-bound i)) 2)) (define (width i) (/ (- (upper-bound i) (lower-bound i)) 2)) (define (make-center-percent c p) (make-interval c …

(define (div-interval x y) (let *1 (upx (upper-bound x)) (lowy (lower-bound y)) (upy (upper-bound y))) (cond lowx 0) ;;xは正 (cond ((> lowy 0) ;;yは正 (make-interval ( lowx lowy) ( upx upy))) ((< upy 0) ;;yは負 (make-interval ( upx upy) ( …

;; y が0をまたがる区間の時はエラーを返す (define (div-interval x y) (if (> 0 (* (lower-bound y) (upper-bound y))) (error "error") (mul-interval x (make-interval (/ (upper-bound y)) (/ (lower-bound y))))))

(define (upper-bound x) (cdr x)) (define (lower-bound x) (car x)) (define (sub-interval x y) (make-interval (- (upper-bound x) (lower-bound y)) (- (upper-bound y) (lower-bound x))))

(define (make-interval a b) (cons a b)) (define (upper-bound x) (if (> (car x) (cdr x)) (car x) (cdr x))) (define (lower-bound y) (if (< (car y) (cdr y)) (car y) (cdr y)))

(define zero (lambda (f) (lambda (x) x))) (define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x))))) (add-1 zero) (lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) x)) f) x)))) (lambda (f) (lambda (x) (f ((lambda (x) x) x)))) (lambda (f…

(define (cons a b) (* (expt 2 a) (expt 3 b))) (define (car c) (define (iter n count) (if (< 0 (remainder n 2)) count (iter (/ n 2) (+ count 1)))) (iter c 0)) (define (cdr c) (define (iter n count) (if (< 0 (remainder n 3)) count (iter (/ n…

(define (cons x y) (lambda (m) (m x y))) (define (car z) (z (lambda (p q) p))) ;; (car (cons x y)) (car (cons x y)) ((lambda (m) (m x y)) (lambda (p q) p)) ((lambda (p q) p) x y) x ;; cdr (define (cdr z) (lambda (p q) q))

;; 長方形を高さと幅で定義 (define (make-rectangle height width) (cons height width)) (define (perimeter-rect rect) (+ (* 2 (height-rect rect)) (* 2 (width-rect rect)))) (define (area-rect rect) (* (height-rect rect) (width-rect rect))) (de…

(define (make-segment start end) (cons start end)) (define (start-segment seg) (car seg)) (define (end-segment seg) (cdr seg)) (define (make-point x y) (cons x y)) (define (x-point point) (car point)) (define (y-point point) (cdr point)) (…

負の引数に対応したmake-rat (define (make-rat n d) (let* ((g (gcd n d)) (n1 (/ n g)) (d1 (/ d g))) (if (< d1 0) (cons (* -1 n1) (* -1 d1)) (cons n1 d1))))

(define (iterative-improve enough? improve) (lambda (guess) (define (iter guess) (if (enough? guess) (improve guess) (iter (improve guess)))) (iter guess))) (define (sqrt x) (define (improve guess) (average guess (/ x guess))) (define (goo…

;;実験用に作った手続き ;; x^n k回平均緩和 (define (test x n k) (fixed-point-of-transform (lambda (y) (/ x (expt y (- n 1)))) (lambda (z) ((repeated average-damp k) z)) 1.0)) 実験の結果， 2 ≦ n < 4 の時 k=1 4 ≦ n < 8 の時 k=2 8 ≦ n < 16 の…

平滑化関数とn重平滑化関数 (define (smooth f) (let ((dx 0.0001)) (lambda (x) (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3)))) (define (n-fold-smooth f n) (lambda (x) ((repeated smooth n) x)))

関数fをn回作用を計算する手続きrepeated (define (repeated f n) (define (iter fn count) (if (= count n) fn (iter (compose f fn) (+ count 1)))) (iter f 1)) gosh> ((repeated inc 5) 0) 5

合成関数を実装する手続きcompose (define (compose f g) (lambda (x) (f (g x)))) gosh> ((compose square inc) 6) 49

(define (inc n) (+ 1 n)) (define (double f) (lambda (x) (f (f x)))) (define D double) (define DD (D D)) (((D (D D)) inc) 5) (((D DD) inc) 5) ((DD (DD inc)) 5) ((DD (D (D inc)))) ((D (D (D (D inc)))) 5) ((D (D (D (lambda (x) (+ 2 x))))) 5) …

(define (cubic a b c) (lambda (x) (+ (cube x) (* a (square x)) (* b x) c))) gosh> (newtons-method (cubic 3 3 1) 1) -0.9999755158323895

(define (tan-cf x k) (cont-frac (lambda (i) (if (= i 1) x (- (square x)))) (lambda (i) (- (* 2.0 i) 1.0)) k))

(define (e-2 k) (cont-frac (lambda (i) 1.0) (lambda (i) (if (= (modulo i 3) 2) (* 2 (+ 1 (quotient i 3))) 1.0)) k))