こういうのを書いてなかったので． ;; クイックソート (define (quick-sort lst) (if (null? lst) lst (let ((first (car lst))) (append (quick-sort (filter (lambda (x) (< x first)) (cdr lst))) (list first) (quick-sort (filter (lambda (x) (>= x fi…

何回も忘れてその都度ググったりプログライングGauche見るのでダメですね． ここに書いておきます． (define func-name (with-module gauche func-name))

;; A->B->Cという順に並んだ回線があったとする． ;; FIFOの場合Aが変化するとそれがBに伝わり，次のactionが実行されCに伝わる． ;; FILOの場合Aが変化してもまずB-C間のactionが実行されCは変化しない． ;; そのあとA-B間のactionが実行されるAの変化がBに…

;; accept-action-procedure!でprocを実行して初期化している部分で初期化しないとどうなるか． (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (s…

;; 最後のfull-adderのc-inは0． ;; (make-wire)の初期値は0と仮定してます． (define (ripple-carry-adder Ak Bk Sk C) (let ((c-in (make-wire))) (cond ((null? (cdr Ak)) (full-adder (car Ak) (car Bk) 0 (car Sk) C) 'ok) (else (full-adder (car Ak) …

(define (or-gate a1 a2 output) (let ((b1 (make-wire)) (b2 (make-wire)) (c (make-wire))) (inverter a1 b1) (inverter a2 b2) (and-gate b1 b2 c) (inverter c output))) ;; 遅延時間は(+ and-gate-delay (* 2 inverter-delay))

(define (or-gate a1 a2 output) (define (or-action-procedure) (let ((new-value (logical-or (get-signal a1) (get-signal a2)))) (after-delay or-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 or-action-procedure) (add…

(define (make-table) ;; tree (define (make-tree key value left-branch right-branch) (list key value left-branch right-branch)) ;; 選択子 (define (key-tree tree) (car tree)) (define (value-tree tree) (cadr tree)) (define (left-branch tree) …

;; keyではなくkey-listを'(x y z)という形で渡す ;; key-listのcdrがnullになるまで再帰すればkeyの数がいくつでも対応できる (define (make-table) (let ((local-table (list '*local-table*))) (define (lookup key-list) (let loop ((key-list key-list)…

assocをequal?以外を使ってテストできるようにする． make-table手続きはキーの等価性に使うsame-key?手続きを引数にとる． (define (make-table same-key?) (define (assoc key value records) (cond ((null? records) #f) ((same-key? key (caar records))…

対を使って前後へのポインタを持ったdequeを実装する． ;; dequeの実装 (define (value-ptr ptr) (caar ptr)) (define (prev-ptr ptr) (cdar ptr)) (define (next-ptr ptr) (cdr ptr)) ;; ((value))というリストを作る (define (make-ptr value) (list (list…

局所状態を持つ手続きとしてキューを定義する． (define (insert-queue! queue item) ((queue 'insert-queue!) item)) (define (delete-queue! queue) ((queue 'delete-queue!))) (define (make-queue) (let ((front-ptr '()) (rear-ptr '())) (define (empt…

(define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (empty-queue? queue) (null? (front-pt…

答え見た． https://github.com/nomnel/SICP/blob/master/3/19.scm 一歩ずつ進むポインタと二歩ずつ進むポインタが同じになれば循環している． うまいこと考えてるな. (define (look-check x) (define (check x0 x1) (cond ((eq? x0 x1) #t) ((null? (cdr x1…

;; 循環するリストを見つける手続き (define (cycle? x) (let recur ((x x) (record '())) (cond ((not (pair? x)) #f) ((memq x record) #t) (else (or (recur (car x) (cons x record)) (recur (cdr x) (cons x record)))))))

任意の構造の異なる対の個数を返すcount-pairsを完成させる． (define (count-pairs x) (define pair-list '()) (define (recur s) (cond ((not (pair? x)) 0) ((memq s pair-list) 0) (else (set! pair-list (cons s pair-list)) (+ (recur (car x)) (recur…

ポインタが同じ構造を指していた場合に重複して数えてしまう． さらに，循環リストの場合は結果が返ってこない． (define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1)))

(define x (list 'a 'b)) (define z1 (cons x x)) (define z2 (cons (list 'a 'b) (list 'a 'b))) (define (set-to-wow! x) (set-car! (car x) 'wow) x) (set-to-wow! z1)と(set-to-wow! z2)の結果の箱とポインタ図

mysteryはreverseと同じ結果を返し，xを先頭の要素だけを取り出したリストに置き換える． (define (mystery x) (define (loop x y) (if (null? x) y (let ((temp (cdr x))) (set-cdr! x y) (loop temp x)))) (loop x '()))

(define (make-cycle x) (set-cdr! (last-pair x) x) s) (define z (make-cycle (list 'a 'b 'c))) zのポインタ図． (last-pair z)を計算しようとするとlast-pair?が#tになることがないので終わらない．

(define w1 (make-withdraw 100)) ;; E2(balance:100)->E1(initial-amount:100)->global (w1 50) ;; E3->(amount:50)->E2(balance:50)->E1(initial-amount:100)->global (define (w2 (make-withdraw 100))) ;; E5(balance:100)->E4(initial-amount:100)->glo…

階乗を計算する手続き(factorial 6)の環境構造を示す． 再帰 (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) 反復 (define factorial (lambda (n) (fact-iter 1 1 n))) (define fact-iter (lambda (product counter max-count) (if (> co…

(define f (let ((a 1)) (lambda (x) (set! a (* a x)) a))) (f 0) (f 1)の順に評価したら0,0が返り，(f 1) (f 0)の順に評価すると1, 0 が返ってくれば題意を満たしたことになる． gosh> (define f (let ((a 1)) (lambda (x) (set! a (* a x)) a))) f gosh> …

(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define …

;; オリジナルのrand (define rand (let ((x random-init)) (lambda () (set! x (rand-update x)) x))) ;; 'generateで乱数生成，'resetで引数の数字で初期化するrand (define rand (let ((x random-init)) (define (reset new-rand) (set! x new-rand) x) (…

(use srfi-27) (define (random-in-range low high) (let ((range (- high low))) (+ low (* (random-real) range)))) ;; 問題分には(+ low (random range))となっている． (define (estimate-integral P x1 x2 y1 y2 trials) (let ((x-length (- x2 x1)) (y…

(define (make-account balance password) (let ((counter 0)) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)…

(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define …

(define (make-monitored f) (let ((mf 0)) (lambda (in) (cond ((eq? in 'how-many-calls?) mf) ((eq? in 'reset-count) (set! mf 0)) (else (set! mf (+ 1 mf)) (f in)))))) gosh> (define s (make-monitored sqrt)) s gosh> (s 100) 10 gosh> (s 'how-man…