今度ある先生に熊本（KPF）でPrologのお話をして頂けることになったので♪
2009/05/22
[The Little Schemer]Y Combinator（再）
Y Combinatorとは
全景
「The Little Schemer」P.160 ～
| ;; Road to Y Combinator (define inc
;; normal length
;; without "define"
;; empty-list-length
;; execute with empty-list
;; execute with non-empty-list
;; 1-element-list-length
((lambda (l)
((lambda (l)
((lambda (l)
;;2-elements-list-length
;; execute 2-elements-list-length
((lambda (l)
((lambda (l)
((lambda (l)
;;((lambda (length)
;; eternity style empty-list-length (((lambda (f)
;; eternity style 1-element-list-length
;; eternity style 2-elements-list-length
;; without repetitions
;; execute without-repetitions-eternity-stryle-length
(((lambda (make-length)
(((lambda (make-length)
;;What is recursion like?
;;Do we readly need an infinite tower?
;; meke-length to make-length
;; execute make-length to make-length
(((lambda (make-length)
(((lambda (make-length)
(((lambda (make-length)
;; without (f f)
;; move out (f f)
;; execute move-out-(f f)
;; extract function's body
;; named y
;; execute y with length |
参考
| posted with amazlet at 09.03.30 Daniel P. Friedman Matthias Felleisen おすすめ度の平均:
|
2009/05/20
[scheme]Ackermann（アッカーマン関数）
コード
| (define inc
(define dec
(define Ackermann |
| gosh> (Ackermann 1 0) |
参考
- アッカーマン関数 - Wikipedia
- The Little Schemer
| posted with amazlet at 09.03.30 Daniel P. Friedman Matthias Felleisen おすすめ度の平均:
|
[scheme][2ch]10 times print "hello"
10 times print "hello
10回"hello"と表示するプログラムについて2chのスレで話題になっていたのがおもしろかったので。私はよく寝る前にimonaとかでム板とかマ板とかのぞいてます。主にLispとかScheme関連のスレとあとはC#やF#など。
do
手続き型の言語に染まっていれば最もストレートなコードではないでしょうか。| ;; do (do ((i 0 (+ i 1))) ((= i 10)) (print "hello")) |
let loop
これもまぁdoとあまり変わりませんね。| ;; let loop (let loop ((s 0)) (if (< s 10) (begin (print "hello") (loop (+ 1 s))))) |
for-each
これは結構schemeらしいと思います。Scheme的には一番ストレートでは？| ;; for-each (use srfi-1) (for-each (lambda (i) (print "hello")) (iota 10)) |
recursive lambda
これもSchemeらしいですね（笑）Y Combinatorを思い出しますね。| ;; recursive lambda ((lambda (f) (f f 10)) (lambda (f n) (cond ((< 0 n) (print "hello") (f f (- n 1)))))) |
参考
2009/05/18
[scheme][Lisp]SchemeでLispインタプリタ書いた
とっても簡易なインタプリタです。初めて書いたインタプリタです。やったー！まだバグってますが、取り合えずコードをさらしてみる。
とはいっても「schemeによる記号処理入門」P.125 ～ のほぼ写経だけど。
(slisp)を実行すればREPLが起動します。終了は(end*)、(exit*)、(bye*)、(quiet*)のいずれかを実行すれば終了します。
;; Small-Lisp ver 1.4 ;; defined by valvallow ;; 2009/05/18 ;; referenced 「Schemeによる記号処理入門」P.125 ～ (define *prompt* ">> ") (define *version* "Small-Lisp Ver.1.4") (define *environment* '()) (define init-environment (lambda () (set! *environment* '((t . t)(nil . nil))))) (define error-message (lambda (x) (display " **** Unknown expression : ") (display x) (newline))) (define assoc* (lambda (x y) (cond ((null? y) (error-message x) '()) ((equal? x (caar y)) (cdar y)) (else (assoc* x (cdr y)))))) (define atom? (lambda (x) (not (pair? x)))) (define eval-args (lambda (exp env) (cond ((null? exp) '()) (else (cons (myeval (car exp) env) (eval-args (cdr exp) env)))))) (define myatom? (lambda (foo) (cond ((not (pair? foo)) 't) (else 'nil)))) (define myeq? (lambda (foo baz) (cond ((eqv? foo baz) 't) (else 'nil)))) (define pairlis (lambda (x y z) (cond ((or (null? x)(null? y)) z) (else (append (pairlis-aux x y) z))))) (define pairlis-aux (lambda (x y) (cond ((or (null? x)(null? y)) '()) (else (cons (cons (car x)(car y)) (pairlis-aux (cdr x)(cdr y))))))) (define myapply (lambda (func args env) (cond ((and (atom? func) (not (null? func))) (cond ((eq? func 'car*)(caar args)) ((eq? func 'cdr*)(cdar args)) ((eq? func 'cons*)(cons (car args)(cadr args))) ((eq? func 'atom*)(myatom? (car args))) ((eq? func 'eq*)(myeq? (car args)(cadr args))) ((eq? func 'caar*)(caar args)) ((eq? func 'cadr*)(cadr args)) ((eq? func 'cdar*)(cdar args)) ((eq? func 'cddr*)(cddr args)) ((eq? func 'caaar*)(caaar args)) ((eq? func 'caadr*)(caadr args)) ((eq? func 'cadar*)(cadar args)) ((eq? func 'caddr*)(caddr args)) ((eq? func 'cdaar*)(cdaar args)) ((eq? func 'cdadr*)(cdadr args)) ((eq? func 'cddar*)(cddar args)) ((eq? func 'cdddr*)(cdddr args)) ((eq? func 'null*) (if (null? (car args)) 't 'nil)) ((eq? func 'zero*) (if (zero? (car args)) 't 'nil)) ((eq? func 'plus*)(+ (car args)(cadr args))) ((eq? func 'minus*)(- (car args)(cadr args))) ((eq? func 'multiple*)(* (car args)(cadr args))) ((eq? func 'divide*)(/ (car args)(cadr args))) ((eq? func 'greater*) (if (> (car args)(cadr args)) 't 'nil)) (else (myapply (myeval func env) args env)))) ((eq? (car func) 'lambda*) (myeval (caddr func) (pairlis (cadr func) args env))) (else (error-message args))))) (define eval-cond (lambda (con env) (cond ((null? con) 'nil) ((eq? 'nil (myeval (caar con) env)) (eval-cond (cdr con) env)) (else (myeval (cadar con) env))))) (define eval-defun (lambda (exp env) (let ((name (car exp)) (args (cadr exp)) (body (caddr exp))) (set! *environment* (cons `(,name . (lambda* ,args ,body)) env)) name))) (define eval-setq (lambda (exp env) (let ((var (car exp)) (val (myeval (cadr exp) env))) (set! *environment* (cons (cons var val) env)) val))) (define myeval (lambda (exp env) (cond ((atom? exp) (cond ((number? exp) exp) (else (assoc* exp env)))) ((eq? (car exp) 'cond*)(eval-cond (cdr exp) env)) ((eq? (car exp) 'setq*)(eval-setq (cdr exp) env)) ((eq? (car exp) 'defun*)(eval-defun (cdr exp) env)) ((eq? (car exp) 'quote*)(cadr exp)) ((eq? (car exp) 'if*) (cond ((eq? (myeval (cadr exp) env) 'nil)) (else (myeval (caddr exp) env)))) (else (myapply (car exp) (eval-args (cdr exp) env) env))))) (define slisp (lambda () (print *version*) (init-environment) (display *prompt*) (do ((exp (read)(read))) ((and (list? exp) (member (car exp) '(bye* quite* end* exit*))) 'good-bye) (print (myeval exp *environment*)) (display *prompt*)))) (use slib) (require 'trace) (trace myeval)
2009/05/17
[scheme]eq?, equal?, eqv?
「schemeによる記号処理入門」P.41 ～ P.42
eq? と equal?
;; eq? equal? eqv? (eq? (list 1 2 3)(list 1 2 3)) ;; => #f (equal? (list 1 2 3)(list 1 2 3)) ;; => #t (eq? (cons 1 '(2 3))(cons 1 '(2 3))) ;; => #f (equal? (cons 1 '(2 3))(cons 1 '(2 3))) ;; => #t (eq? '(1 2 3)'(1 2 3)) ;; => #f (equal? '(1 2 3)'(1 2 3)) ;; => #t (define x '(1 2 3)) (define y '(1 2 3)) (define z x) (eq? x y) ;; => #f (equal? x y) ;; => #t (eq? x '(1 2 3)) ;; => #f (eq? x x) ;; => #t (eq? x z) ;; => #t (equal? x '(1 2 3)) ;; => #t
eqv?と=
- (eq? x y)の評価値が#tなら(eqv? x y)の評価値も#t
- (eqv? x y)が数同士の等値性の判定の場合、等しければ#t
- (eqv? x y)の評価値が#tなら(equal? x y)の評価値も#t
追記
eq?,eqv?,equal?では，等しいと判定される判断基準が異なる．
* eq?は，比較する2つの引数がシステム内部で同一のデータ(セル)を指し示している場合に#tを返す．
* eqv?は，eq?で等しいか数値として等しい2つの引数が与えられたとき#tを返す．
* equal?は，評価した結果が等しいような2つの引数が与えられたとき#tを返す．
* eq?で等しいと判定されるデータは，eqv?,equal?でも等しい．
* eqv?で等しいと判定されるデータは，equal?でも等しい．
* equal?で等しいと判定されるデータがeqv?,eq?で等しいとは限らない．
* eqv?で等しいと判定されるデータがeq?で等しいとは限らない．
* equal?は汎用的．eq?は高速．
直観的には，
* symbolの比較には，eq?
* symbolと数値を同時に扱う場合は，eqv?(数値のみを扱う場合は，"="の方がよい)
* listの構造の比較には，equal?
を使う．
[scheme]queue（キュー：待ち行列）
追記
「schemeによる記号処理入門」 P.40
大域変数を使用するもの
| (define *queue* '()) (define *last* '()) (define enqueue (lambda (data) (cond ((null? *queue*) (set! *queue* (list data)) (set! *last* *queue*)) (else (set-cdr! *last* (list data)) (set! *last* (cdr *last*)))) *queue*)) (define dequeue (lambda () (cond ((null? *queue*) 'empty) (else ((lambda (x) (set! x (car *queue*)) (set! *queue* (cdr *queue*)) x) '()))))) |
| (enqueue 'one) ;; => (one) (enqueue 'two) ;; => (one two) (enqueue 'three) ;; => (one two three) (dequeue) ;; => one |
大域変数を使用しない（クロージャ）
| ;; queue with closure (define make-queue (lambda () (let ((queue '()) (last '())) (lambda (msg . args) (cond ((eq? msg 'enqueue) (cond ((null? queue) (set! queue (list (car args))) (set! last queue)) (else (set-cdr! last (list (car args))) (set! last (cdr last)))) queue) ((eq? msg 'dequeue) (cond ((null? queue) 'empty) (else ((lambda (x) (set! x (car queue)) (set! queue (cdr queue)) x) '())))) ((eq? msg 'len) (length queue)) ((eq? msg 'clear) (set! queue '())) ((eq? msg 'each) (cond ((null? args) queue) (else (map (car args) queue)))) (else #f)))))) |
| (define q (make-queue)) ;; => q (q 'enqueue 'one) ;; => (one) (q 'enqueue 'two) ;; => (one two) (q 'enqueue 'three) ;; => (one two three) (q 'enqueue 'four) ;; => (one two three four) (q 'enqueue 'five) ;; => (one two three four five) (q 'dequeue) ;; => one (q 'len) ;; => 4 (q 'each) ;; => (two three four five) (q 'each (lambda (n)(print n))) ;; => two ;; => three ;; => four ;; => five ;; => (#<undef> #<undef> #<undef> #<undef>) |
参考
Schemeによる記号処理入門 posted with amazlet at 09.05.10 猪股 俊光 益崎 真治 森北出版 売り上げランキング: 305671 Amazon.co.jp で詳細を見る |
[Ruby]「Rubylist九州5月例会」に参加してきた
あ・・・ありのまま今起こったことを話すぜ
| ,. -‐'''''""¨¨¨ヽ |
| 「Rubylist九州にRubyの勉強をしにいったと思ったら いつのまにかサルサを踊っていたんだ」 な・・・ 何を言ってるかわからねーと思うが おれも何をされたのかわからなかった 頭がどうにかなりそうだった フォークダンスだとか盆踊りだとか そんなチャチなもんじゃあ 断じてねぇ もっと恐ろしいものの片鱗を味わったぜ・・・ |
懇親会がなぜかサルサパーティだったんです。正直どうなることかと思いましたが・・・、サルサいい！（・∀・）
収穫
「日本で最もPrologのコードを書いた」であろうお方に熊本でPrologのお話をして頂く約束を取り付けた！！（第五世代コンピュータを実際に使っていた方）
すばらしい！
（もうRuby全然関係ないですね）
メモ
| ■Rubylist九州(2009/05/16) ・Ruby
＊橋本さん
＊新井さん |
Ruby熟練者のライブコーディングを見れてラッキー♪
2009/05/15
[scheme]stack（クロージャ）
stack
stackを見てもコインシリンダーしか思い出せません。コインシリンダー欲しいです。あと再帰的な彼女も欲しいです。
コード
| (define make-stack |
| (define s (make-stack)) (s 'empty?) |
ほとんどが下記参照先の写経です。len、each、clearを追加しただけ。
参考
関連
[C#]EachControls
昔自分が書いたC#のコードのコメントメンテナンスをする機会がきました。（コメント書いてなかったので書かないといけなくなった）
そこで面白いコードを見つけたのでメモ。残念ながらいつものようにC#1.1です。
| private delegate bool Selection (Control ctl);
private static IList EachControls (Control parent, IList list, Selection s, Filter f) if (!list.Contains(parent)) if (parent.HasChildren) |
| private static IDictionary EachControls (Control parent, IDictionary dic, Selection s, Filter f) if (s(parent)) if (parent.HasChildren) |
2009/05/14
[scheme]階乗を末尾再帰にして計算過程もlistで欲しい
こういう初歩的なことでも苦戦するから困る。
階乗
| (define fact |
| (fact 10) |
階乗（末尾再帰）（のはず）
| (define fact |
| (fact 10) |
末尾再帰＋計算過程list
| (define fact |
| (fact 10) |
Cons the Magnificent !!
関連：
[scheme]またもやcollatz（角谷の予想）
問題の概要は、「任意の0でない自然数 n をとり、
|
おもしろい問題ですよね。この問題が好きで何度かやってます。
あまりしっくり来てなかったのでもう一度Schemeで書いてみました。（それでもまだなんだか・・・）
コード。ちょっと右よりなりますが気になるが・・・
(define collatz (lambda (n) (letrec ((iter (lambda (x col) (append col (cons x (cond ((= x 1) '()) ((odd? x) (iter (+ (* x 3) 1) col)) ((even? x) (iter (/ x 2) col)) (else (list #f)))))))) (iter n '()))))
実行結果。
(collatz 100) ;; = (100 50 25 76 38 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1) (collatz 1000) ;; =>(1000 500 250 125 376 188 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1)
[emacs]テーマ（色調）を変える
Emacsの色調：
最終的に現在こんな感じ↑。以前はこんな感じ。方法：
- color-theme.elをダウンロードする。
- color-theme.elを所定の場所に格納
- .emacsファイルに以下のような記述を追加
- emacsを起動
- M-x color-theme-select
- テーマが一覧されるので一つずつ適用して好みのテーマを見つける
- 起動時からテーマを適用したい場合
- .emacsに以下のように記述
| (require 'color-theme) (color-theme-initialize) |
| (color-theme-lawrence) ;; lawrenceという名前のテーマを適用 |
テーマ一覧（一部）
迷ったテーマ
現在はこれにしている。
別に黒いテーマしかないわけではない。私が黒背景にしたかっただけです。こんなのもあります。↓
参考：
登録:
投稿 (Atom)