勉強会二日目 exercise 3.1~3.23
部活の勉強会で3.3.2のRepresenting Queまで終了。
とりあえず、書いた演習問題でもさらしてみる。
動作については多分大丈夫、多分。とはいってもごちゃごちゃしたコードの集まりからコピってきたので不安もある。コード書くときは後で見返すことを考えよう、うん。
・・・しかし、2日間で結構進んだ気がする。追いつかれ無いように頑張らないとなぁ。
あと、エラー処理のところの文章とかがやる気なさすぎるのは仕様です。
;;3.1 (define (make-accumulater n) (lambda (x) (set! n (+ n x)) n)) ;;3.2 (define (make-monitored f) (let ((count 0)) (define (dispatch m) (if (eq? m 'how-many-calls?) count (begin (set! count (+ count 1)) (f m)))) dispatch)) ;;3.3 + 3.7 (define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "error")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (miss amount) (print "Incorrect Password!!")) (define (dispatch p m) (cond ((eq? m 'correct-pass?) (eq? p password)) ((not (eq? p password)) miss) ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Uknown operation " m)))) dispatch) (define (make-joint old-acc old-pass new-pass) (if (old-acc old-pass 'correct-pass?) (lambda (pass m) (if (eq? pass new-pass) (old-acc old-pass m) (error "Incorrect Password!!" new-pass))) (error "Incorrect Password!!" old-pass))) ;;3.4 -> 解き忘れてた・・・ (use srfi-27) ;乱数欲しいので ;;どっかからコピペ。すいませんどこからか忘れました・・・ (define (random n) (* (random-real) n)) (define (random-in-range low high) (let ((range (- high low))) (+ low (random range)))) (define (monte-carlo trials experiment) (define (iter r p) (cond ((= r 0) (/ p trials)) ((experiment) (iter (- r 1) (+ p 1))) (else (iter (- r 1) p)))) (iter trials 0)) (define (estimate-integral P x1 x2 y1 y2 trials) (define (test) (let ((x (random-in-range x1 x2)) (y (random-in-range y1 y2))) (P x y))) (* (- x2 x1) (- y2 y1) (monte-carlo trials test))) (define (P1 x y) (<= (+ (square (- x 5)) (square (- y 7))) 9)) (define (square n) (* n n)) ;;3.6はrand-initとかないしめんどいのでパス。・・・ってこれくらいなら自分で適当にやれよ -> 俺 ;;3.7は上に乗っけた ;;3.8 これでいいのかなぁ (define (make-f) (let ((x 1)) (lambda (y) (set! x (* x y)) x))) (define f (make-f)) ;;3.9 10 11 うpするのめんどい。先輩はなんかソフト使ってかいてたし俺もやってみようかしら ;;3.12 だから図を書くのは(ry ;;3.13 終わりません。循環リストだから ;;3.14 リストを反転させた結果になる。これも図を書けばすぐ分かる。図… ;;3.15 だからz（ry ;;3.16 このcount-pairsの場合、循環リストの場合とか、あるペアが複数のポインタから参照されていた場合、重複して数えられるのでダメ。 ;;3.17 たぶん以下のコードで動いた・・・と思う。 (define (count-pairs? x) (let ((finded-pointers '())) (define (iter x) (if (not (pair? x)) 0 (begin (set! finded-pointers (cons x finded-pointers)) (+ 1 (if (memq (car x) finded-pointers) 0 (iter (car x))) (if (memq (cdr x) finded-pointers) 0 (iter (cdr x))))))) (iter x))) ;;3.18 (define (cycle? x) (let ((finded-pointers '())) (define (iter x) (cond ((null? x) #f) ((memq x finded-pointers) #t) (else (set! finded-pointers (cons x finded-pointers))(iter (cdr x))))) (iter x))) ;;3.19 頭よすぎるだろ、考えた人・・・jk (define (cycle? x) (define (iter p1 p2) (cond ((null? (cdr p2)) #f) ((null? (cddr p2)) #f) ((eq? p1 p2) #t) (else (iter (cdr p1) (cddr p2))))) (if (or (not (pair? x)) (null? (cdr x)) (null? (cddr x))) #f (iter (cdr x) (cddr x)))) ;;3.20 printなくてもそれっぽくは動くか。 (define (print-queue queue) (print (front-ptr queue))) ;;3.21 (define (make-queu) (let ((front-ptr '()) (rear-ptr '())) (define (set-front-ptr! item) (set! front-ptr item)) (define (set-rear-ptr! item) (set! rear-ptr item)) (define (empty-queue?) (null? front-ptr)) (define (front-queue) (if (empty-queue?) (error "FRONT called with an empty queue" (cons front-ptr rear-ptr)) (car front-ptr))) (define (insert-queue! item) (let ((new-pair (cons item '()))) (cond ((empty-queue?) (set-front-ptr! new-pair) (set-rear-ptr! new-pair) (cons front-ptr rear-ptr)) (else (set-cdr! rear-ptr new-pair) (set-rear-ptr! new-pair) (cons front-ptr rear-ptr))))) (define (delete-queue!) (cond ((empty-queue?) (error "DELETE! called with an empty queue" (cons front-ptr rear-ptr))) (else (set-front-ptr! (cdr front-ptr)) (cons front-ptr rear-ptr)))) (define (print-queue) (print front-ptr)) (define (dispatch m) (cond ((eq? m 'insert-queue!) insert-queue!) ((eq? m 'delete-queue!) (delete-queue!)) ((eq? m 'front-queue) (front-queue)) ((eq? m 'empty-queue?) (empty-queue?)) ((eq? m 'print-queue) (print-queue)) (else (error "aaaaaaaaaaaaaaaaaaaaaa" )))) dispatch)) ;;3.22 しまった、引数がdequeでなくてqueueになっているのを発見 (define (make-deque) (cons '() '())) (define (make-item x) (cons x (cons '() '()))) (define (content item) (car item)) (define (next-item item) (car (cdr item))) (define (prev-item item) (cdr (cdr item))) (define (set-next-item! item next) (set-car! (cdr item) next)) (define (set-prev-item! item prev) (set-cdr! (cdr item) prev)) (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-deque? queue) (null? empty-queue?)) (define (front-deque queue) (if (empty-queue? queue) (error "FRONT called width an empty queue" queue) (content (front-ptr queue)))) (define (rear-deque queue) (if (empty-queue? queue) (error "ERRORRRRRRRRRRRRRR" queue) (content (rear-ptr queue)))) (define (rear-insert-deque! queue content) (let ((new-item (make-item content))) (cond ((empty-queue? queue) (set-front-ptr! queue new-item) (set-rear-ptr! queue new-item) queue) (else (set-next-item! (rear-ptr queue) new-item) (set-prev-item! new-item (rear-ptr queue)) (set-rear-ptr! queue new-item) queue)))) (define (print-deque queue) (define (iter ptr) (if (eq? ptr (rear-ptr queue)) (list (content ptr)) (cons (content ptr) (iter (next-item ptr))))) (iter (front-ptr queue))) (define (front-insert-deque! queue content) (let ((new-item (make-item content))) (cond ((empty-queue? queue) (set-front-ptr! queue new-item) (set-rear-ptr! queue new-item) queue) (else (set-prev-item! (front-ptr queue) new-item) (set-next-item! new-item (front-ptr queue)) (set-front-ptr! queue new-item) queue)))) (define (front-delete-deque queue) (cond ((empty-queue? queue) (error "AAAAAAAAAAAAAAAAAAAAAAa" queue)) (else (set-prev-item! (next-item (front-ptr queue)) '()) (set-front-ptr! queue (next-item (front-ptr queue))) queue))) (define (rear-delete-deque queue) (cond ((empty-queue? queue) (error "AAAAAAAAAAAAAAAAAAAAAAa" queue)) (else (set-next-item! (prev-item (rear-ptr queue)) '()) (set-rear-ptr! queue (prev-item (rear-ptr queue))) queue)))
しかしHDDの中にある以前書いた奴とは少し違うのがおもしろい。
まぁ一度答え合わせしているからだろうけどさ。
