初期値837799のコラッツ数列をmod 127を演算してMIDIの音階にしてみました。 こちらで聴けます。 https://soundcloud.com/user783056320/837799a package collatz; import java.math.BigInteger; import javax.sound.midi.Instrument; import javax.sound.mi…

秋から冬になろうとしています。少し肌寒いですね。 最近は、SICPとAwodeyの圏論を読んでいます。 SICPは面白いけれど、問題がとても難しいです。 最初は全問解こうと思っていたのですが、2章後半であきらめました。 今は3章の「標準部品化力、オブジェクト…

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

以下の積分 のフーリエ変換を求めます。 (※以下に述べることは、斉藤洋一著『信号とシステム (コロナ社)』に書いてあります。)方針としては、この積分はとヘビサイド関数の畳み込みなので、ヘビサイド関数のフーリエ変換を求めることに帰着します。(畳み込み…

import Data.Char type Bit = Int bin2int :: [Bit] -> Int bin2int = foldr (\x y -> x + 2*y) 0 int2bin :: Int -> [Bit] int2bin 0 = [] int2bin n = n `mod` 2 : int2bin (n `div` 2) make8 :: [Bit] -> [Bit] make8 bits = take 8 (bits ++ repeat 0) e…

type Bit = Int unfold :: (a -> Bool) -> (a -> b) -> (a -> a) -> a -> [b] unfold p h t x | p x = [] | otherwise = h x : unfold p h t (t x) chop8 :: [Bit] -> [[Bit]] chop8 = unfold (\x -> null x) (take 8) (drop 8) map' :: (a -> b) -> [a] -> …

import Data.Char -- caeser encription (upper case version) let2int :: Char -> Int let2int c = ord c - ord 'a' int2let :: Int -> Char int2let n = chr (ord 'a' + n) shift :: Int -> Char -> Char shift n c | isLower c = int2let ((let2int c + n…

;; 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…

このブログを参考にさせていただきました。 https://highmt.wordpress.com/2009/12/19/ntemacs%E3%81%A7tramp%E3%82%92%E4%BD%BF%E3%81%86/fakecygptyはcygwinのgccでコンパイルします。

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)]…

function Y(M){ return (function(f){ return M(function(a){ return f(f)(a); }); }) (function(f){ return M(function(a){ return f(f)(a); }); }); } function fib(r){ return function(n){ return (n <= 2)? 1 : r(n-1) + r(n-2); }; } console.log(Y(fi…

「プログラミング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)))