Scheme の雑多なメモ、練習帳。
実行環境
- Gauche: version 0.8.13
- Emacs: version 22.1.1
- OS: Vine Linux 4.2
リンク
- Gauche - A Scheme Interpreter
- Practical Scheme
- Gaucheクックブック
- WiLiKi
- インクリメンタルサーチ対応 Gauche ユーザリファレンス
(ローカルでも利用可能)
Emacsの設定
最近(2008/03)出版された"フムフム本"こと、「プログラミングGauche」の付録に載っている設定をしましょう。
web版: Gaucheプログラミング(立読み版) > 付録 > Emacsの設定
プログラミングGauche サポートページ からもダウンロードできます。
その他、個人的に導入している Scheme用の Emacs Lisp として、Quack と scheme-complete があります。
Quack
配布サイト: http://www.neilvandyke.org/quack/
上記サイトから、quack.el をダウンロードしてロードパス上に置き、次の設定をすれば利用できます。
(require 'quack)
scheme-complete
配布サイト: http://synthcode.com/
上記サイトから、scheme-complete.el.gz をダウンロードします。
特徴： context-sensitive な補完と eldoc をサポートしている。eldoc-mode はマイナーモードで、ポイント位置の関数呼び出しの引数リストをエコーエリアに表示する簡易ヘルプです。バッファのメジャーモードがサポートしていれば、 M-x eldoc-mode で enable と disable をトグルできます。scheme-mode ではサポートされていませんが、scheme-complete.el がそのための関数を定義しているので、設定すれば scheme-mode でも eldoc-mode を利用できます。
以下のような設定で利用できます。
(require 'scheme-complete)
(eval-after-load 'scheme
;; キーバインド
'(progn
;; scheme-smart-complete: M-TAB
(define-key scheme-mode-map "\e\t" 'scheme-smart-complete)
;; scheme-complete-or-indent: TAB
(define-key scheme-mode-map "\t" 'scheme-complete-or-indent))
)
(add-hook 'scheme-mode-hook
(lambda ()
;; Gauche の場合、次の2個の変数を設定しておいたほうがよいのかも。
(setq default-scheme-implementation 'gauche)
(setq *current-scheme-implementation* 'gauche)
;; eldoc-mode
(set (make-local-variable 'eldoc-documentation-function)
'scheme-get-current-symbol-info)
(eldoc-mode t)
)
)
メモ
空リスト(empty list)
- それ自身が独自の型となる特殊なオブジェクト。
- boolean? pair? symbol? number? char? string? vector? port? procedure? を満足しない。
- 要素を持たない長さが0の特殊なオブジェクト。
S式コメント
#;(define (factorial n)
(if (= n 0)
1
(* n (factorial (- n 1)))))
正と負の無限大
-inf.0 +inf.0
組み込みの手続きを再定義
(define length (with-module gauche length))
再帰の練習
length (再帰と反復とアキュムレーション)
append (再帰とアキュムレーション)
last-pair (空でないリストの最後の要素を返す)
reverse (再帰と反復と高階手続き(fold-rightとfold-left))
same-parity (reverse と 高階手続き)
count-leaves (deep-length) (再帰 アキュムレーション(fold-rightとfold-left))
deep-reverse (再帰 アキュムレーション)
fringe (enumerate-tree) (再帰 flatmap アキュムレーション)
scale-tree (再帰 高階手続き(Mapping over trees, tree-map))
square-tree (再帰 高階手続)
tree-map (再帰 Mapping over trees アキュムレーション)
tree-copy (再帰 Mapping over trees アキュムレーション)
subsets (集合の部分集合の集合)
accumulate (fold-right), fold-left
flatmap (append-map)
list-ref
(define (list-ref items n)
(if (= n 0)
(car items)
(list-ref (cdr items) (- n 1))))
length
;; 再帰
(define (length items)
(if (null? items)
0
(+ 1 (length (cdr items)))))
;; 反復
(define (length items)
(define (length-iter a count)
(if (null? a)
count
(length-iter (cdr a) (+ count 1))))
(length-iter items 0))
;; 高階手続き
(define (length items)
(fold (lambda (x y) (+ 1 y)) 0 items))
append
(define (append list1 list2)
(if (null? list1)
list2
(cons (car list1)
(append (cdr list1) list2))))
;; reverse
(define (append list1 list2)
(define (iter x a)
(if (null? x)
a
(iter (cdr x) (cons (car x) a))))
(iter (reverse list1) list2))
;; 高階手続き
(define (append list1 list2)
(fold-right cons list2 list1))
last-pair (空でないリストの最後の要素を返す)
(define (last-pair items)
(if (null? (cdr items))
items
(last-pair (cdr items))))
reverse
;; 再帰
(define (reverse items)
(if (null? items)
nil
(append (reverse (cdr items))
(list (car items)))))
;; 反復
(define (reverse items)
(define (reverse-iter items a)
(if (null? items)
a
(reverse-iter (cdr items) (cons (car items) a))))
(reverse-iter items nil))
;; 高階手続き
(define (reverse ls)
(fold-right (lambda (x y) (append y (list x))) nil ls))
(define (reverse ls)
(fold-left (lambda (x y) (cons y x)) nil ls))
;; srfi-1 fold
(define (reverse items)
(fold cons '() items))
same-parity
;; reverse を利用
(define (same-parity ca . cd)
(let ((p (if (even? ca) even? odd?)))
(define (iter items a)
(cond ((null? items) (reverse a))
((p (car items)) (iter (cdr items) (cons (car items) a)))
(else (iter (cdr items) a))))
(iter cd (list ca))))
;; 高階手続き
(define (same-parity ca . cd)
(filter (if (even? ca) even? odd?) (cons ca cd)))
count-leaves (deep-length)
(define (count-leaves tree)
(cond ((null? tree) 0)
((not (pair? tree)) 1)
(else (+ (count-leaves (car tree))
(count-leaves (cdr tree))))))
;; srfi-1 fold
(define (count-leaves tree)
(fold (lambda (x y)
(if (not (pair? x))
(+ 1 y)
(+ (count-leaves x) y)))
0
tree))
;; SICP fold-left
(define (count-leaves tree)
(fold-left (lambda (x y)
(if (not (pair? y))
(+ 1 x)
(+ (count-leaves y) x)))
0
tree))
(define (count-leaves tree)
(fold-right (lambda (x y) (+ x y))
0
(map (lambda (s)
(if (not (pair? s))
1
(count-leaves s)))
tree)))
(define (count-leaves tree)
(fold + 0 (map (lambda (s)
(if (pair? s)
(count-leaves s)
1))
tree)))
(count-leaves '((1 2 3) (4 5 (6 (7 8)) (9))))
deep-reverse
;; 再帰
(define (deep-reverse tree)
(cond ((null? tree) nil)
((not (pair? tree)) tree)
(else (append (deep-reverse (cdr tree))
(list (deep-reverse (car tree)))))))
;; アキュムレーション
(define (deep-reverse tree)
(fold (lambda (x y)
(if (pair? x)
(cons (deep-reverse x) y)
(cons x y)))
nil
tree))
(define (deep-reverse tree)
(fold cons nil
(map (lambda (s)
(if (pair? s)
(deep-reverse s)
s))
tree)))
fringe (enumerate-tree)
(define (fringe tree)
(cond ((null? tree) nil)
((not (pair? tree)) (list tree))
(else (append (fringe (car tree))
(fringe (cdr tree))))))
(define (fringe tree)
(if (list? tree)
(flatmap fringe tree)
(list tree)))
;; アキュムレーション
(define (fringe tree)
(fold-right append nil
(map (lambda (s)
(if (pair? s)
(fringe s)
(list s)))
tree)))
(define (fringe tree)
(fold-right cons nil
(flatmap (lambda (s)
(if (pair? s)
(fringe s)
(list s)))
tree)))
(define (fringe tree)
(fold append nil
(reverse (map (lambda (s)
(if (pair? s)
(fringe s)
(list s)))
tree))))
(define (fringe tree)
(fold (lambda (x y)
(if (pair? x)
(append y (fringe x))
(append y (list x))))
nil
tree))
(define (fringe tree)
(fold-right (lambda (x y)
(if (pair? x)
(append (fringe x) y)
(append (list x) y)))
nil
tree))
scale-tree
1.
(define (scale-tree tree factor)
(cond ((null? tree) nil)
((not (pair? tree)) (* tree factor))
(else (cons (scale-tree (car tree) factor)
(scale-tree (cdr tree) factor)))))
2. Mapping over trees
(define (scale-tree tree factor)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(scale-tree sub-tree factor)
(* sub-tree factor)))
tree))
3. 高階手続き
(define (scale-tree tree factor)
(tree-map (lambda (x) (* x factor)) tree))
square-tree
1.
(define (square-tree tree)
(cond ((null? tree) nil)
((not (pair? tree)) (square tree))
(else (cons (square-tree (car tree))
(square-tree (cdr tree))))))
2. Mapping over trees
(define (square-tree tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(square-tree sub-tree)
(square sub-tree)))
tree))
3. 高階手続き
(define (square-tree tree)
(tree-map square tree))
tree-map
1.
(define (tree-map proc tree)
(cond ((null? tree) nil)
((not (pair? tree)) (proc tree))
(else (cons (tree-map proc (car tree))
(tree-map proc (cdr tree))))))
2. Mapping over trees
(define (tree-map proc tree)
(map (lambda (sub-tree)
(if (not (pair? sub-tree))
(proc sub-tree)
(tree-map proc sub-tree)))
tree))
3. アキュムレーション
(define (tree-map proc tree)
(fold-right cons
nil
(map (lambda (s)
(if (pair? s)
(tree-map proc s)
(proc s)))
tree)))
tree-copy
1. 再帰
(define (tree-copy tree)
(cond ((null? tree) '())
((not (pair? tree)) tree)
(else (cons (tree-copy (car tree))
(tree-copy (cdr tree))))))
2. アキュムレーション
(define (tree-copy tree)
(fold cons
'()
(map (lambda (s)
(if (pair? s)
(tree-copy s)
s))
tree)))
3. Mapping over trees
(define (tree-copy tree)
(map (lambda (s)
(if (pair? s)
(tree-copy s)
s))
tree))
subsets
(define (subsets s)
(if (null? s)
(list nil)
(let ((rest (subsets (cdr s))))
(append rest
(map (lambda (x) (cons (car s) x))
rest)))))
(subsets nil)
=>(())
(subsets '(1 2 3))
=>(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))
map
-
filter
(define (filter pred seq)
(cond ((null? seq)
nil)
((pred (car seq))
(cons (car seq)
(filter pred (cdr seq))))
(else
(filter pred (cdr seq)))))
accumulate
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
accumulate-n
(define (accumulate-n op init seqs)
(if (null? (car seqs))
nil
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
fold-left
1.
(define (fold-left op initial sequence)
(if (null? sequence)
initial
(fold-left op (op (car sequence) initial) (cdr sequence))))
2.
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op (car rest) result)
(cdr rest))))
(iter initial sequence))
flatmap (append-map)
(define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (flatmap proc seq) (apply append (map proc seq)))
permutations
(define (permutations s)
(if (null? s)
(list nil)
(flatmap (lambda (x)
(map (lambda (p) (cons x p))
(permutations (remove x s))))
s)))
(define (remove item sequence)
(filter (lambda (x) (not (= x item))) sequence))
(permutations (list 1 2 3))
=>((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
unique-pairs
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(unique-pairs 5)
=>((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))
スクリプト
練習のために適当に作ったスクリプト。
Shell の cal コマンドもどき
3x4 の1年分のカレンダーを出力する。表示年、開始月、週の始めの曜日、表示する月数を指定できる。西暦1年以降対応。
$ cal.scm -y 1582 > cal.txt
Shell の tree コマンドもどき
尻尾が残るバグあり。
$ tree.scm /usr/local/share/gauche/0.8.13 > tree.txt
Shell の head コマンドもどき
出力行数を指定できる。
$ head.scm -n 1 *.scm
Shell の tail コマンドもどき
$ tail.scm *.scm