『プログラミングGauche』17章総称関数とオブジェクトの練習問題をやってみました。総称関数subは、関数呼び出しの回数と、関数実行にかかった時間を保持するクラスと、引数と結果を出力するクラスを継承しています。このままだと、クラスが保持する時間には…

アドベンチャーゲーム ;; -*- coding: utf-8 -*- (use util.match) (define *player* (make-player 'hp 320 'mp 66 'position (car *dungeon*) 'inventory '(potion potion daggar cookie daggar))) (define (reset!) (set! *player* (make-player 'hp 320 '…

最近、「プログラミングGauche」を読み直しています。SICPを読んでいて行き詰まってしまったのと、実践で使えるSchemeを修得したいという考えからです。今日はSchemeにおける関数の記法の変換をやってみました。 (define (mit-form->primitive-form expr) (l…

interp関数の(extend-env (bind (fdC-arg fd) (interp a env fds)) mt-env)を(extend-env (bind (fdC-arg fd) (interp a env fds)) env)とするとダイナミックスコープになってしまうので注意。(schemeはダイナミックスコープではなく、レキシカルスコープ) #…

「Programming Languages: Application and Interpretation by Shriram Krishnamurthi」というPDFを読んでいます。http://cs.brown.edu/~sk/Publications/Books/ProgLangs/ これは、言語処理系に関する本のようです。インターネットで調べたところCPS変換に…

乱数生成のアルゴリズムとしてメルセンヌツイスターを使うときにはsrfi-27を使います。 テストをするときなど、乱数列を再現させたいときがあります。 以下のrand関数は((rand 'reset) )で乱数源を初期化します。 (rand 'generate)を複数回実行することによ…

;; 2.87, 2.88 ;;;;;;;;;;;;; ;; 汎用演算 ;; ;;;;;;;;;;;;; (define (equ? x y) (apply-generic 'equ? x y)) (define (project x) (apply-generic 'project x)) (define (raise x) (apply-generic 'raise x)) (define (add x y) (apply-generic 'add x y)) …

;; 2.86 ;;;;;;;;;;;;; ;; 汎用演算 ;; ;;;;;;;;;;;;; (define (equ? x y) (apply-generic 'equ? x y)) (define (project x) (apply-generic 'project x)) (define (raise x) (apply-generic 'raise x)) (define (add x y) (apply-generic 'add x y)) (defin…

b問題がちょっと難しかったので、記録しておきます。 b問題 不要なかっこは省き, 乗算は加算より前に行うと仮定する(x + 3 * (x + y + 2))のような, 標準の代数記法を許すと問題は実質的に難しくなる. われわれの微分プログラムが相変わらず動作するように, …

(define (make-sum a b . rest) (letrec ((make-sum-sub (lambda (terms sum) (cond [(zero? sum) (cond [(null? terms) 0] [(null? (cdr terms)) (car terms)] [else (cons '+ terms)])] [(null? terms) sum] [else (cons '+ (cons sum terms))])))) (let (…

(use gl) (use gl.glut) (define (display) (gl-clear GL_COLOR_BUFFER_BIT) (gl-begin GL_LINES) (gl-color 1.0 0.0 0.0) ((square-limit painter-wave 5) (make-frame (make-vect -1.0 -1.0) (make-vect 2.0 0.0) (make-vect 0.0 2.0))) (gl-end) (gl-flus…

;; 2.42 (define (queens board-size) (letrec ((queen-cols (lambda (k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-o…

;; 2.29 (define (make-mobile left right) (list left right)) (define (make-branch length structure) (list length structure)) ;; a (define left-branch car) (define right-branch cadr) (define branch-length car) (define branch-structure cadr) …

SICPの問題1.29です。 (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) (define (integral f a b n) (let* ((h (/ (- b a) n)) (inc (lambda (x) (+ x 1))) (term (lambda (k) (cond [(or (= k 0) (= k n)) (f (+ a (…

; 1.28 (use srfi-27) (define (expmod base exp m) (cond [(= exp 0) 1] [(even? exp) (miller-rabin (expmod base (/ exp 2) m) m)] [else (remainder (* base (expmod base (- exp 1) m)) m)])) (define (miller-rabin a m) (if (and (not (= a 1)) (not …

以下は、ふつうのフィボナッチ数列のアルゴリズムです。 (define (fib n) (cond [(= n 0) 0] [(= n 1) 1] [else (+ (fib (- n 1)) (fib (- n 2)))])) これを反復的になるように書き換えると以下のようになります。ステップ数はです。 (define (fib n) (fib-i…

SICPの問題1.18。「ロシア農民の方法」として知られるアルゴリズムらしい。これは30分くらい考えてわかった。解けたときすっきりした。 ; 1.18 (define (fast-* a b) (*-iter a b 0)) (define (*-iter a b n) (cond [(= b 0) n] [(even? b) (*-iter (double …

SICPの問題1.16。これは思いつかなかった。 ; 1.16 (define (fast-expt b n) (expt-iter b n 1)) (define (expt-iter b n a) (cond [(= n 0) a] [(even? n) (expt-iter (* b b) (/ n 2) a)] [else (expt-iter b (- n 1) (* a b))]))

平方根 (define sqrt-iter (lambda (guess x guess-prev) (if (good-enough? guess guess-prev) guess (sqrt-iter (improve guess x) x guess)))) (define improve (lambda (guess x) (average guess (/ x guess)))) (define average (lambda (x y) (/ (+ x …

Scheme修行20章のインタープリタをまとめて書いてみました。以下です。 ;; utility (define atom? (lambda (x) (and (not (pair? x)) (not (null? x))))) (define add1 (lambda (x) (+ x 1))) (define sub1 (lambda (x) (- x 1))) (define name-of (lambda (…

(define atom? (lambda (x) (and (not (pair? x)) (not (null? x))))) (define fill) (define leave) (define waddle (lambda (l) (cond [(null? l) '()] [(atom? (car l)) (let () (call-with-current-continuation (lambda (rest) (set! fill rest) (leave…

Scheme修行の14章を今、読んでいます。13章ではじめての構文letccというのが出てきます。letccは処理系で実装されていないことが多いらしく、そのときにはcall/ccというのが使えます。(call-with-current-continuationと省略せずに書くこともできます。) こ…

Scheme手習い10章のインタープリタを書いてみた。 (define value (lambda (e) (meaning e '()))) (define meaning (lambda (e table) ((expression-to-action e) e table))) (define expression-to-action (lambda (e) (cond [(atom? e) (atom-to-action e)]…

「プログラミングGauche」の継続のところが理解できず、「Scheme手習い」という本に手を出した。このシリーズの本は、現在、3冊出版されているようだ。「Scheme手習い」、「Scheme修行」、「The Reasond Schemer」の3冊である。「The Reasond Schemer」は翻…

こっちのほうがシンプルでいいような気もする。 (define (flatten lis) (cond [(null? lis) '()] [(not (list? lis)) (list lis)] [else (append (flatten (car lis)) (flatten (cdr lis)))])) 早く継続を勉強して、継続で書いてみたい。

(define (flatten list) (let loop ((list1 (reverse list)) (list2 '())) (if (null? list1) list2 (if (list? (car list1)) (loop (cdr list1) (append (flatten (car list1)) list2)) (loop (cdr list1) (cons (car list1) list2))))))

(define (any-pred . preds) (lambda (x) (fold (lambda (pred res) (or (pred x) res)) #f preds))) (define (every-pred . preds) (lambda (x) (fold (lambda (pred res) (and (pred x) res)) #t preds)))

3通り書いてみた。 (define (append2 lis1 lis2) (if (pair? lis1) (cons (car lis1) (append2 (cdr lis1) lis2)) lis2)) (define (append22 lis1 lis2) (define (append22-sub lisa lisb) (if (null? lisa) lisb (append22-sub (cdr lisa) (cons (car lisa)…

(define (tree-walk walker proc lis) (walker (lambda (elm) (if (list? elm) (tree-walk walker proc elm) (proc elm))) lis)) walkerにfor-eachとかmapを入れて、procにprintとかを入れちゃう。lisには入れ子になったリストを入れちゃおう。