スキップします。あとで

;;n = 5 '(1 2 4 8 16) 31--15--7--3--1 | | | |-2 | | |-4 | |-8 |-16 ;;n = 10 '(1 2 4 8 16 32 64 128 256 512) 1023--511--255--127--63--31--15--7--3--1 | | | | | | | | +-2 | | | | | | | +-4 | | | | | | +-8 | | | | | +-16 | | | | +-32 | | | +-…

(define rock-1950-tree (generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))) (define song '( GET A JOB SHA NA NA NA NA NA NA NA NA GET A JOB SHA NA NA NA NA NA NA NA NA WAH YIP YIP YIP YIP YIP YIP YIP Y…

(define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs))) (define (successive-merge leaf-set) (if (> (length leaf-set) 1) (successive-merge (adjoin-set (make-code-tree (car leaf-set) (cadr leaf-set)) (cddr leaf-set)))…

(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) ;; rec (define (encode-symbol message tree) (if (leaf? tree) '() (if (memq message (symbols (left-branch tree))…

define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (make-code-tree left right) (list left right (append…

(define (lookup given-key set-of-records) (if (null? set-of-records) #f (let ((record (entry set-of-records))) (cond ((= given-key (key record)) record) ((< given-key (key record)) (lookup given-key (left-branch set-of-records))) ((> given…

(define (union-tree tree1 tree2) (let ((list1 (tree->list-2 tree1)) (list2 (tree->list-2 tree2))) (list->tree (union-set list1 list2)))) (define (intersection-tree tree1 tree2) (let ((list1 (tree->list-2 tree1)) (list2 (tree->list-2 tree2)…

(define (list->tree elements) (car (partial-tree elements (length elements)))) (define (partial-tree elts n) (if (= n 0) (cons '() elts) (let ((left-size (quotient (- n 1) 2))) (let ((left-result (partial-tree elts left-size))) (let ((left…

SICP超久しぶり。 思えば学部2-3年のころに一生懸命やっていたな。 ranobaの開発に移ってから、ずっとほったらかしにしていた。 やっぱり難しい。あまり成長してないのか。。。。 なんにしろ、いい加減に終わらせないとね。ぱっぱと飛ばしてこう。 (define (…

(define (deriv exp var) (cond ((number? exp) 0) ((variable? exp) (if (same-variable? exp var) 1 0)) ((sum? exp) (make-sum (deriv (addend exp) var) (deriv (augend exp) var))) ((product? exp) (make-sum (make-product (multiplier exp) (deriv (…

(define (union-set set1 set2) (define (iter set1 set2 product) (cond ((null? set1) (append product set2)) ((null? set2) (append product set1)) (else (let ((x1 (car set1)) (x2 (car set2))) (cond ((= x1 x2) (iter (cdr set1) (cdr set2) (appen…

(define (element-of-set? x set) (cond ((null? set) #f) ((= x (car set)) #t) ((< x (car set)) #f) (else (element-of-set? x (cdr set))))) (define (intersection-set set1 set2) (if (or (null? set1) (null? set2)) '() (let ((x1 (car set1)) (x2 (…

(define (element-of-set? x set) (cond ((null? set) #f) ((equal? x (car set)) #t) (else (element-of-set? x (cdr set))))) (element-of-set? 4 '(1 2 3 2 3 1 5 4)) ;#t (element-of-set? 6 '(1 2 3 2 3 1 5 4)) ;#f (define adjoin-set cons) (adjoin-…

(define (element-of-set? x set) (cond ((null? set) #f) ((equal? x (car set)) #t) (else (element-of-set? x (cdr set))))) (define (adjoin-set x set) (if (element-of-set? x set) set (cons x set))) (define (intersection-set set1 set2) (cond ((…

;わかるまでに時間がかかりそうなのでひとまず飛ばす

;わかるまでに時間がかかりそうなのでひとまず飛ばす

(car ''abracadabra) (car (quote (quote abracadabra))) ;(quote (quoteなので、quoteは「そのものをあらわす」(つまり、評価しない)という意味があるので、quoteと表示された。

(define (equal? li1 li2) (cond ((and (null? li1) (null? li2)) #t) ((and (symbol? li1) (symbol? li2)) (eq? li1 li2)) ((and (pair? li1) (pair? li2)) (and (equal? (car li1) (car li2)) (equal? (cdr li1) (cdr li2)))) (else (eq? li1 li2)))) (equ…

(list 'a 'b 'c) ;(a b c) (list (list 'george)) ;((george)) (cdr '((x1 x2) (y1 y2))) ;((y1 y2)) (cadr '((x1 x2) (y1 y2))) ;((y1 y2)) (pair? (car '(a short list))) ;#f (memq 'red '((red shoes) (blue socks))) ;#f (memq 'red '(red shoes blue s…

(add-load-path ".") (load "2.49.scm") (define (corner-split2 painter n) (if (= n 0) painter (let ((right (right-split painter (- n 1))) ((up (rotate90 (right-split (rotate270 painter)))))) (let ((top-left (beside up up)) (bottom-right (bel…

(use gl) (use gl.glut) (define (make-vect x y) (cons x y)) (define (xcor-vect vect) (car vect)) (define (ycor-vect vect) (cdr vect)) (define (add-vect v1 v2) (make-vect (+ (xcor-vect v1) (xcor-vect v2)) (+ (ycor-vect v1) (ycor-vect v2)))) …

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

(define (make-frame origin edge1 edge2) (list origin edge1 edge2)) (define (edge1-frame frame) (cadr frame)) (define (edge2-frame frame) (caddr frame)) (define (origin-frame frame) (car frame)) (define f1 (make-frame (cons 1 2) 1 2)) (edge…

この前のやつにスターとかつけてくれた人がいて申し訳ないんだけど、あれは、問題2.45までしか出来ない形だ。 そのあとに、ちゃんとSICPなりの作り方が書いてあった。 基本手続きの定義を作るのはちょっと早すぎた。 これ以降のほうが正しい。 (define (make…

こちらも上で定義した。 (define (split f1 f2) (lambda (painter n) (if (= n 0) painter (let ((smaller ((split f1 f2) painter (- n 1)))) (f1 painter (f2 smaller smaller)))))) (define right-split (split beside below)) (define up-split (split b…

上で定義した。 (define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (- n 1)))) (below painter (beside smaller smaller)))))

図形を出せるようにしよう。 http://www.xmission.com/~nate/glut.html から、glut-3.7.6-bin.zip (117 KB) をダウンロードし glut32.dll を C:/windows/system以下とかsystem32以下とかに置く。 そして、 http://practical-scheme.net/gauche/packages-j.ht…

#| (flatmap (lambda (new-row) (map (lambda (rest-of-queens) (adjoin-position new-row k rest-of-queens)) (queen-cols (- k 1)))) (enumerate-interval 1 board-size)) |# ;mapの中に(queen-cols (- k 1))があるので、そこでboard-size分 ;queen-colsが…

(define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (filter condition seq) (accumulate (lambda (x y) (if (condition x) (cons x y) y)) null seq)) (define…