2010年9月29日水曜日

学者猿コンサル

前回のブログ(コンサル)は, 検討も設計も多少杜撰であった. 改めて考えた描き方はこうだ.

これは2変数関数の値を表示するいわば計算図表みたいなものである. 計算図表には, 変数の変域があるわけで, 今回はそれをxminと, xmaxとする. また2つの変数をx0と, x1とする. つまりxmin≤x0, x1≤xmaxである.



xminとxmaxの基線の上に, x0とx1の点A, Bをとり, それを脚とする長さlの二等辺三角形CABを描く. ACをCで左に135度曲げてDの方向へ長さm(=l/√2)だけ伸ばしDとする. BCをCで右に135度曲げてFの方向へ長さmだけ伸ばしFとする. CD, CFを2辺とする菱形CDEFを作ると, Eが関数の値の場所になり, その座標は(x0+x1)/2, (x1-x0)/2となる.



x座標は誰にでもすぐ分かるが, y座標がかくもきれいな形なのは不思議である. これからは幾何学だが, まず二等辺三角形CABの底角はどちらもαなので, 頂角∠ACB180-2αである. ACの長さはl, ∠ACDは45度, CDはl/(√2)なので, DACは直角二等辺三角形である. DEの線はDから下向きに45-αなので, 菱形で上半分の角度も同じゆえ, ∠CDEは2α-90. 従って, ∠ADEは180-2αとなり, 先程の頂角とおなじである. また, DA=DE=mだから, DAEはCABと1:√2の相似形であった. 従って, AEはABの1/√2であり, 右側も同じなので, EABは直角二等辺三角形である. ゆえにEのy座標, EHはABの半分, つまり(x1-x0)/2である.

y座標は, x0≤x1なら正だが, 反対だと負になり, 基線より下になることに注意しよう.


こうして作った減算表(x1-x0)が次のものだ. 8-3=5と3-8=-5を示している. もうアニメーションを作る必要はないと思う.


2010年9月26日日曜日

学者猿コンサル

2010年9月 Brisbaneで開催されたIFIP WCC2010でHistory of Computingのシンポジウムがあった. そこでオーストラリアのMonash大学のJudy Sheardさんが同大学のコンピュータ博物館を紹介した. そのスライドの中に, おや?と思う絵があった. 一瞬の内に次に進んだが, 同行の山田さんがその絵を写真に撮っておられたので, 頂いた.

Consul, the Educated Monkeyという計算関連の教育玩具である. ウェブページで調べると, 1916年頃にアメリカで売り出されたものらしい.


(出典http://www.rechenwerkzeug.de/consul.htm)

使い方はこうだ. 猿の両足を, 図のように下の目盛の3と9に合わせると, 猿の手が示す枠の中に積の27が現れるのである. 目盛の右端の12の右には四角が見えるが, 片足をそこに合わせると, 他方の足の自乗が現れる.

これは乗算表であるが, この表は差し換えられ, 加算にも使える.

こういうものがあると知ったら, プログラムしたくなるのは当然である.

http://playground.iijlab.net/~ew/consul/consul.htmlを見て欲しい. これは十六進の乗算表である. 下の目盛は0からfまであり, 目盛に乗っている足の辺りをマウスで横に動かすと, リンク機構がつられて動き, 赤印の交点の直ぐ上に積が現れるようになっている.


多少の設計ミスで, 0とfの積などでは, 赤印が頭の上に行ってしまうのは, ご愛敬である.

なお, Consulのシミュレータもウェブにあった.

http://www.edumedia-sciences.com/de/a572-consul-the-educated-monkey

2010年9月16日木曜日

入れ子のかっこ

前回のブログの点記法の続きである. とりあえず練習をしよう. 私の手元のPaul Rosenbloom, The Elements of Mathematical Logic (Dover 1950)に点記法の論理式が沢山出てくる. それでテストしてみた. まずSchemeでBoole値が0と1のnot, or, impを定義する.

(define (not p) (- 1 p))
(define (or p q) (quotient (+ p q 2) 3))
(define (imp p q) (or (not p) q))

テストをするには, mapが便利.

(map not '(0 1)) => (1 0)
(map or '(0 0 1 1) (0 1 0 1)) => (0 1 1 1)
(map imp '(0 0 1 1) '(0 1 0 1)) => (1 1 0 1)


上の本では, 沢山並ぶ -> には特にかっこを(点で)示さない. -> はleft associativeであって, (p -> q -> r) は ((p -> q) -> r) なのだ.

ではやってみよう.

I4 p -> .q -> r. -> .p -> q -> .p -> r
かっこに変えると
((p -> (q -> r)) -> ((p -> q) -> (p -> r)))
Schemeの定義は
(define (i4 p q r)
(imp (imp p (imp q r)) (imp (imp p q) (imp p r))))
実行
(map i4 '(0 0 0 0 1 1 1 1) '(0 0 1 1 0 0 1 1)
'(0 1 0 1 0 1 0 1))
=> (1 1 1 1 1 1 1 1)

もう1つ.

T2 q -> r -> .p -> q -> .p -> r
かっこに変えると
((q -> r) -> ((p -> q) -> (p -> r)))
Schemeの定義は
(define (t2 p q r)
(imp (imp q r) (imp (imp p q) (imp p r))))
実行
(map t2 '(0 0 0 0 1 1 1 1) '(0 0 1 1 0 0 1 1)
'(0 1 0 1 0 1 0 1))
=> (1 1 1 1 1 1 1 1)

とうまくいく.

かっこ記法と点記法の変換だが, まずかっこから点へは, すべての2項演算子をかっこでくくることにし, つまり

<primary>==<letter>|(<expression>)
<expression>==<primary>|<expression>*<expression>

だけとする. expressionの例は a, a * b, (a * b) * c, ...など.

expression * expression を点記法にするには, expression' lp * rp expression とする. expression'はexpressionを点記法に変えたものである. lpとrpは, 左右のexpressionをひとまとまりにする点である. lpは左のexpression'で使った最大の右点の数より多く, rpは右のexpressionで使った最大の左点の数より多くなければならない. 従って, 下請けの変換は, expression'を返すと同時に, 自分の使った右点, 左点を返すことにする.

letterの場合は, letterの他に, 右点,左点として, 0,0を返す.

* の場合は, 左の式を変換て置き, その右点+1の左点を置き, 演算子を置き, 右の式を変換し, その左点+1の右点を置き, 右の式を置く. また自分で使った左点, 右点も返す.

(define (dotconv exp)
(display (list exp))
(if (symbol? exp) (list '(0 0) exp)
(let* ((l (dotconv (car exp)))
(r (dotconv (caddr exp)))
(op (cadr exp))
(rlp (+ (cadar l) 1))
(le (cadr l))
(lrp (+ (cadar r) 1))
(re (cadr r)))
(list (list rlp lrp)(list le rlp op lrp re)))))


(dotconv 'a) => ((0 0) a)
(dotconv '(a * b)) => ((1 1) (a 1 * 1 b))
(dotconv '((a * b) * c)) => ((2 1) ((a 1 * 1 b) 2 * 1 c))
(dotconv '((a * b) * (c * d))) =>
((2 2) ((a 1 * 1 b) 2 * 2 (c 1 * 1 d)))

この後は ((a 1 * 1 b) 2 * 2 (c 1 * 1 d)) を a * b . * . c * d にしたい. flattenし, 整数はそれ引く1の点を出力する.

(flatten '((a 1 * 1 b) 2 * 2 (c 1 * 1 d))) => (a 1 * 1 b 2 * 2 c 1 * 1 d)

(define (convstream l)
(apply string-append (apply append
(map (lambda (x)
(list (if (number? x) (make-string (- x 1) #\.)
(symbol->string x)) " "))
(flatten l)))))

(convstream '((a 1 * 1 b) 2 * 2 (c 1 * 1 d)))

(define (par->dot exp) (convstream (cdr (dotconv exp))))

(par->dot 'a) => "a "
(par->dot '(a * b)) => "a * b "
(par->dot '((a * b) * c)) => "a * b . * c "
(par->dot '((a * b) * (c * d))) => "a * b . * . c * d "


一方, 私の考えた逆変換はこうだ.


1.(((a * b) * (c * d)) * ((e * f) * (g * h)))
2."a * b . * . c * d .. * .. e * f . * . g * h "

1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8
3.(a 0 * 0 b 1 * 1 c 0 * 0 d 2 * 2 e 0 * 0 f 1 * 1 g 0 * 0 h)
4.29
5.((-1 5) (-1 13) (15 21) (23 29) (15 29) (7 13))
6.(< < < a * b > * < c * d > > * < < e * f > * < g * h > > >)
7.(((a * b) * (c * d)) * ((e * f) * (g * h)))


上の例で, 1. は元のかっこ記法の式. 2. はそれを点記法にしたもの. 逆変換はここから始まる. まず各演算子に左点と右点があるものとし, 3のように変換する. その上の2行は, 各要素の位置を示す. 0から28まであるから, lengthをとると, 4. のように, 29.

位置 1,5,9,..のように, 4を法として1の位置は左点. 3の位置は右点である. さらに, 演算子は2(mod 4), 変数は0(mod 4)である.

次に各右点>0にはこの右方にある相棒の左点を探し, また左点>0にはこの左方にある右点を探し, 対にする. 上の例では 5. が対のリストである. この読み方は, 5の位置の左点を越える右点は, 左方にはないので, -1とし, (-1 5)とする. 13の位置の左点も同じ. 21の位置の左点は, 15の位置の右点の方が大きいので, スコープはここまでとなり, (15 21)が出来る. 3. と5. の情報から, 6. を作るのだが, (-1 5)のような対があれば, -1に左かっこ, 5に右かっこを置く. この挿入で, 位置がずれると困るから, 挿入は番号の多い右端から行う. 右かっこと左かっこの区別は, 4を法とした剰余の1か3で決る. まだこの段階は記号列であるが, 通常のかっこを記号として挿入すると, 分かり難いから, 角かっこを使っている. 出来たのは6. である.後は, 入れ子の式の読込みルーチンを書けばよい. それにより, 7. が得られる.

(define (iconv s) ;2. -> 3.
(define (char->symbol c)
(string->symbol (list->string (list c))))
(define (reads n s)
(cond ((null? s) s)
((char=? (car s) #\Space) (reads n (cdr s)))
((char=? (car s) #\.) (reads (+ n 1) (cdr s)))
(else (cons n
(cons (char->symbol (car s)) (reads 0 (cdr s)))))))
(let ((ss (string->list s)))
(cons (char->symbol (car ss)) (reads 0 (cdr ss)))))

(define (makepair s) ;3. -> 5.
(let ((len (length s)) (ps '()))
(do ((i 3 (+ i 4))) ((>= i len))
(let ((r (list-ref s i)) (k len))
(do ((j (- len 4) (- j 4))) ((< j i))
(let ((l (list-ref s j)))
(if (< r l) (set! k j))))
(if (> (- k i) 2) (set! ps (cons (list i k) ps)))))
(do ((i (- len 4) (- i 4))) ((< i 0))
(let ((l (list-ref s i)) (k -1))
(do ((j 3 (+ j 4))) ((> j i))
(let ((r (list-ref s j)))
(if (> r l) (set! k j))))
(if (> (- i k) 2) (set! ps (cons (list k i) ps)))))
ps))

(define (makestr ps s len) ;5. 3. (length 3) -> 6.
(define (insert l n a)
(if (<= n 0) (cons a l)
(cons (car l) (insert (cdr l) (- n 1) a))))
(set! ps (sort (apply append ps) >))
(for-each (lambda (x) (set! s (insert s x
(if (= (modulo x 4) 3) '< '>)))) ps)
(append '(<) (filter symbol? s) '(>)))

(define (str->sexp str) (define i 0) ;6. -> 7.
(define (getch) (let ((ch (list-ref str i)))
(set! i (+ i 1)) ch))
(define (read) (let ((ch (getch)))
(cond ((eq? ch '<) (readtail))
((eq? ch '>) '())
(else ch))))
(define (readtail) (let ((x (read)))
(if (null? x) x (cons x (readtail)))))
(read))

2010年9月5日日曜日

入れ子のかっこ

Lispの好きな人は, かっこだらけのS式を何とも思わない. 反対にhtmlのようなタグでの入れ子には耐えられない.

しかし, S式を声を出して読む時, 「かっこ開く」「かっこ閉じる」や「左かっこ」「右かっこ」というのは煩わしい. 私は昔から,左かっこを「かっこ」, 右かっこを「こっか」と読むことにしている. (Algol 68で, 添字に使う [ と ] を, sub symbol, bus symbolと呼んでいたのをまねした.)

ところで, 今回の話題は, 自然言語の構文解析である. 構文解析木を図で表わすのは容易だが, かっこ付きでも表わせる.

Time flies like an arrow は 光陰矢の如し と構文解析するのが普通だが, 時間の蝿は矢が好きだ という笑い話もある. 前者は Time (flies (like an arrow)), 後者は (Time flies) like an arrow と表現すればよい.

SICPに簡単な自然言語解析の話がある. その問題4.45は, The professor lectures to the student in the class with the cat を5通りに構文解析せよ, だ. やってみると

1 ((the professor)
(((lectures
(to (the student)))
(in (the class)))
(with (the cat))))
2 ((the professor)
((lectures
(to (the student)))
(in ((the class)
(with (the cat))))))
3 ((the professor)
((lectures
(to ((the student)
(in (the class)))))
(with (the cat))))
4 ((the professor)
(lectures
(to (((the student)
(in (the class)))
(with (the cat))))))
5 ((the professor)
(lectures
(to ((the student)
(in ((the class)
(with (the cat))))))))

それぞれの和訳は

1 教授は(猫を連れて(教室で(学生に講義する)))
2 教授は((猫を連れた教室)で(学生に講義する))
3 教授は(猫を連れて((教室の学生)に講義する))
4 教授は((猫を連れた(教室の学生))に講義する)
5 教授は(((猫を連れた教室)の学生)に講義する)

猫を連れているのは, 1と3は教授. 2と5は教室. 4は学生である.

ウェブを眺めていて, H.B.Curryの書いたページを見つけた. ただで見られるのは1ページ目だけだが, 今はそれだけ見られれば充分である.

論理の式には, かっこの代りに点が打ってあるものがある. 件のページには, その提案が書いてある.

Let us suppose that a group of dots on the right of an operation or prefix denotes the beginning of a bracket which extends to the right until it meets a group with an equal or larger number of dots on the left of an operation; and that the scope of a group of dots on the left of an operation shall extend to the left unitl it reaches a larger group of dots on right of some operation.


つまり,
p -> q . -> . q -> r .. -> . p -> r

((p -> q) -> (q -> r)) -> (p -> r)
のことである.

この方式を何と言うか知らないが, dot notation つまり 点記法ということにする.

上の和訳の入れ子のかっこ構造から, 点記法を使い, かっこを外したい. それには, 演算子がどれか決めたい. 演算子は左かっこの右, 右かっこの左にあるのだから,

教授猫を連れ教室学生講義する

の赤字の助詞類を演算子と考える. (猫を連れた, 教室の は形容詞句の時で, 副詞句の時は, 猫を連れて, 教室で になる.)

すると, それぞれの例文は

1 教授は . 猫を連れて . 教室で . 学生に講義する
2 教授は .. 猫を連れた教室 . で . 学生に講義する
3 教授は . 猫を連れて .. 教室の学生 . に講義する
4 教授は ... 猫を連れた . 教室の学生 .. に講義する
5 教授は .. 猫を連れた教室 . の学生 . に講義する

となる.

この点を , 2点を ,, に変えると
1 教授は, 猫を連れて, 教室で, 学生に講義する
2 教授は,, 猫を連れた教室, で, 学生に講義する
3 教授は, 猫を連れて,, 教室の学生, に講義する
4 教授は,,, 猫を連れた, 教室の学生,, に講義する
5 教授は,, 猫を連れた教室, の学生, に講義する
のようになる.

点記法に慣れると, これで読めなくもない. では声を出して読むにはどうするか.

Shakespeareの時代, 劇の台本には句読点が何種類かあり, それぞれで間の取り方が違うという話を読んだことがある. そのように, カンマ2つはカンマ1つより長く間をとれば, この例は構文木が分かるのではないかと考えるが, どうだろうか.

2010年8月29日日曜日

Penroseタイル

GoogleでPenrose tileの記事を眺めていたら, Penrose tileは3 colorableという記述が! ジャジャーン. 平面の地図は4色で塗り分けられるが, 3色で塗り分けられるというわけだ. さっそく前回のブログの最後の図をプリントし, 4色のマーカーを手に, 塗り分けてみると, 確かに3色でうまく行く.

余談だが, 慶應の皆さんは, 慶應の校旗はblue red and blueの3色といい, 私の2010年5月13日のブログのように, オランダ国旗も3色だ. ジャジャーン.言語学者の用語では, 「サイタ サイタ サクラ ガ サイタ」は, 延べ語数5,異なり語数3という. その伝では, 慶應の校旗は述べ3色旗. オランダ国旗は異なり3色旗である. Penrose tileは異なり3色で塗り分け可能である.

数学者なら, 3色塗り分け可能を証明するわけだが, 私の場合はプログラムで,3色塗り分けしたい. さっそくトライ.

前回のブログの最後にプログラムがあるが, そこで分かるように, それぞれの線分はtranslateで原点を移動し, rotateで向きを変えたユーザ座標て描いている. これでは誰が隣りかは判明しない. どうすれば絶対座標(装置座標)で描けるか, PostScriptのマニュアルをみると, transformという関数がある. PostScriptでは,装置座標とユーザ座標の関係は, current matrixが記憶していて, transformはユーザ座標を装置座標にしてくれるらしい.

ところが,例えば kite0のn=0の部分を0 0 transform == phi2 36 xy transform == phi -72 xy transform ==のようにし,
[1 0 0 1 0 0] setmatrix
300 400 translate
/n 0 def init
0 0 0 kite0

で起動すると, kite0の3点は,

A 300.0 400.0
B 469.442719 523.107361
C 340.0 276.892639
と出力された.

今, 単位長さが80なので, すこし計算してみる.
(* 80 phi phi (cos (d2r 36))) => 169.4427190999916
(* 80 phi phi (sin (d2r 36))) => 123.10734148701015
(* 80 phi (cos (d2r -72)) => 40.00000000000001
(* 80 phi (sin (d2r -72))) => -123.10734148701013

理由は分からないが, AとBは正しい; CはAから-72度の方向に移動した距離になっている. それが分かればあとはプログラムでCの位置は計算出来る.

こうしてkite0, kite1, dart0, dart1の3点の座標が得られた. 次はkite0とkite1, dart0とdart1を組合わせる. 始点と終点は合っているから, それらを対にする. 相棒のないのは外す. こうして95の四辺形が揃った. 各四辺形には0から94まで番号をつける.

次は隣りどうしを探す作業で, alistを作り, 辺を登録したり探索したりして,隣組のリストが出来た. 両方から指すこともないので, 自分より番号の少ない隣りの四辺形のリストになっている.

次にそれぞれに色0,1,2を対応させる. 目で見てやるのと違うから,バックトラックすることになる. SICPの8クィーン(ex2.42)のプログラムをちょっと改造して書いてみたが, これは全解探索だし, 深さも8段から95段になるので,たちまち再帰のオーバーフローを起した. うーん. 駄目か.

仕方ないので, 通常のバックトラックのプログラムを書く.解が1つ見つかったところで, call-ccを使って脱出する.

(define next' (() (0) () (0 2) (2 1) (3) (5) () (7) ()
(7 9 0) (10 0) (9 8) (7) (7 13 5 3) (6 13) (15 6) () (17) ()
(17 19) (19 18) (20) (22) () (24 2) (25 2 5) (4) ()
(24 28 17) (29 17) (28 27 25) (24 26) (24 32 22 20)
(23 6 32) (16 34 23) () (36) () (36 38) (38 37) (39) (41) ()
(43 19) (44 19 22) (21) () (43 47 36) (48 36) (47 46 44)
(43 45) (43 51 41 39) (42 23 51) (35 53 42) () (55) ()
(55 57) (57 56) (58) (60) () (62 38) (63 38 41) (40) ()
(62 66 55) (67 55) (66 65 63) (62 64) (62 70 60 58)
(61 42 70) (54 72 61) () (74) (8) (76 8 13) (74 76) (76 75)
(79 12) (78 77) (81 15) () (83 57) (84 57 60) (59) ()
(83 87 74) (88 74) (87 86 84) (83 85) (83 91 81 78)
(82 61 91) (73 93 82 16)))
(define colorlist '())
(define (search)
(call-with-current-continuation
(lambda (throw)
(define (safe? n c)
(let ((es (list-ref next n)) (revc (reverse colorlist)))
(not (member c (map (lambda (x) (list-ref revc x)) es)))))
(define (test n)
(if (= n 95) (throw (reverse colorlist))
(do ((m 0 (+ m 1))) ((= m 3))
(let ((c (modulo (+ m n) 3)))
(if (safe? n c)
(begin (set! colorlist (cons c colorlist))
(test (+ n 1))
(set! colorlist (cdr colorlist))))))))
(test 0))))
(search)

ジャジャーン. これでやっと色のリストが得られた.

(0 1 2 1 0 2 0 1 2 0 2 1 1 2 0 1 2 2 0 1 0 2 1 2 1 0 1 1 1 0
1 2 0 2 1 0 0 1 2 1 0 2 0 1 2 0 1 1 2 1 0 2 0 1 2 1 2 0 2 1
0 1 2 0 1 2 2 0 2 1 0 1 2 0 2 0 1 0 0 2 0 1 2 0 1 2 2 2 1 0
0 1 2 0 1)

結果はご覧の通り.

2010年8月25日水曜日

Penroseタイル

今回はPenrose tilingの絵の描き方のことである. Penrose tileには

のようにkite(凧)とdart(矢)の2種類のタイルを使うものと,

のようにthick(でぶ)とthis(やせ)の2種類のタイルを使うものとがあるらしい.

これらのタイルは, 菱形以外に組合わせると, 平行移動方向の周期的パターンで平面を埋めることが出来ないことで知られている. どちらのタイルにも, 赤と青の円弧が描いてあるのは, 菱形が出来るのを禁止するからで, タイルを置く時は, 同じ色の円弧が接続する必要がある.

従って, 沢山のタイルによるパターンを描くには, タイルを同型のタイルに分割し(これをdeflationという), 再帰的に埋めていく方法を用いる.

分割はタイルの半分について行うので, 分割を示す破線が描いてあり, 緑の線は半分のタイルの起点を示す.

半分のタイルは, 上には0, 下には1をつけて区別する.

今回は, 私がPostScriptで書いたプログラムの話をしたい.

上の2組のタイルの絵は, googleで探したもので, 凧の方はWolfram MathWorldのだ. kiteとdartが長さで与えられ, thickとthinが角度で与えられているのも, 出所が違うからだ.

kiteの辺ABがφ+1, BCがφ-1+1と示されているが, WolframMathWorldにそう書いてあったからだが, kiteの青の円弧の半径がφで, 赤の円弧の半径が1, dartの青の円弧の半径が1で, 赤の円弧の半径がφ-1であることも示す. φはもちろん黄金比 (√5+1)/2である. φの計算に慣れている人には分かるように, φ+1は実はφ2, φ-1+1は実はφである. 従ってAB:BCはφ:1である. kiteとdartは, dartを左右逆にするとkiteに密着出来て菱形になる. 菱形の長い対角線をφ:1に分けた点がCになる. つまりkiteのAC:dartのAC=φ:1. kiteのCABもdartのBCAも2等辺三角形である.

kiteの∠CABを計算しよう. AからBCの中点Eに垂線を引くと, 直角三角形AEBについて, sin ∠EAB=1/2φ=sin 18°, つまり∠CAB=36°である. ゆえに∠ABC = ∠ACB=72°である. dartについては, ∠CAB=∠ABC=36° である.

(注: sin 3α=3 sin α-4 sin3α, cos 2&alpha=1-2 sin2α. &alpha=18°の時, sin 54°=cos 36°からsin 18°は解ける. sin 18°は(√5+1)/4.)

ここでthinの上半分を見ると, ∠CAB=∠ABC=72°だから, thin0はkite0と同じ形である. また大きさは違うが, thick0はdart0と相似形である.

kite0は下のようである. この図の上は, 1個のkite0の描き方で, 左端の原点(緑の線が出発する位置)から, 36°方向へφ2だけ線を引き, 次にそこから-72°方へφだけ引くことを示す.

図の下は, 1個のkite0の分割法で, kite0'が出来るところである. (分割後のタイルにはプライム(')をつけて区別する.)kite0'の左の三角は, dartの片割れだが, 緑の線からdart1であることが分かる. また右の方はkite0とkite1で出来ている. つまり左端に原点を持ち, 36°に向けたdart1を置き, 36°方向へφ2行った所に原点を持ち, 252°に向けたkite0とkite1を置けばよいことを示す. kite0は長い辺がφ, 短い辺が1であった. 分割の結果は, 短い辺がkiteの長い辺で出来ているから, タイルの大きさは1/φになった. 従って, 分割の図のスケールはφ倍で示してある. 上の図のφ2が下の図ではφ3になるのは, そのためである.

そろそろプログラムの出番だ.

描画の出発点は緑の線のついている頂点で, 頂点の座標x, yと緑の基本の線の方向aを貰い, タイルを描く. kite0は(0,0)から出発, 36度の方向にφの長さの線を引く. 次に-72度の方向に1の長さの線を引く. これをPostScriptで

0 0 moveto φ 36 xy lineto one -72 xy rlineto

のように書く. xyは線の長さ l と方向 a を貰い, その先のx, yの位置を返す関数である.

/xy {2 dict begin /a exch def /l exch def l a cos mul l a sin
mul end} def

kite0'の描き方は, まずスケールを1/φにする. (0,0)の位置に36度の方向でdart1を描く. 次は36度の方向にφ行った所を原点とし, -108度の方向でkite0とkite1を描く. 注意点は, φ行ったところといっても, スケールが1/φになっているから, φ2行く必要があることだ. このことさえ忘れなければ, すべての絵は描ける.

0 0 36 dirt1 phi3 36 xy 252 kite0 phi3 36 xy 252 kite1

phi3はφ3に相当する長さのつもりである.

kite1, dart0, dart1の分割は以下の通り.

dart0

dart1

thickとthinも同じだ.
thick0

thick1

thin0

thin1


kiteとdartのプログラムは以下のとおり.

/phi 5 sqrt 1 add 2 div def /one 80 def
/init {/phs n 5 add array def /f one def
n -1 0 {/i exch def /f f phi div def phs i f put} for
phs n 1 add one put /one one phi mul def phs n 2 add one put
/one one phi mul def phs n 3 add one put
/one one phi mul def phs n 4 add one put} def
/ph {phs exch n add get} def
/xy {2 copy cos mul 3 1 roll sin mul} def
/red {1 0 0 setrgbcolor arc stroke} def
/blue {0 0 1 setrgbcolor arc stroke} def
/green {0 1 0 setrgbcolor 0 0 moveto 1 ph 0 lineto stroke}def

/kite0 {3 dict begin /a exch def /y exch def /x exch def
gsave x y translate a rotate
n 0 eq {0 setgray 0 0 moveto 3 ph 36 xy rlineto
2 ph -72 xy rlineto stroke
0 0 2 ph 0 36 blue 3 ph 0 1 ph 108 180 red green}
{/n n 1 sub def 0 0 36 dart1 4 ph 36 xy 252 kite0
4 ph 36 xy 252 kite1 /n n 1 add def} ifelse
grestore end} def

/kite1 {3 dict begin /a exch def /y exch def /x exch def
gsave x y translate a rotate
n 0 eq {0 setgray 0 0 moveto 3 ph -36 xy rlineto
2 ph 72 xy rlineto stroke
0 0 2 ph -36 0 blue 3 ph 0 1 ph 180 252 red green}
{/n n 1 sub def 0 0 -36 dart0 4 ph -36 xy 108 kite0
4 ph -36 xy 108 kite1 /n n 1 add def} ifelse
grestore end} def

/dart0 {3 dict begin /a exch def /y exch def /x exch def
gsave x y translate a rotate
n 0 eq {0 setgray 0 0 moveto 3 ph 36 xy rlineto
2 ph 252 xy rlineto stroke
0 0 1 ph 0 36 blue 2 ph 0 0 ph 72 180 red green}
{/n n 1 sub def 0 0 0 kite0 4 ph 36 xy 216 dart0
/n n 1 add def} ifelse
grestore end} def

/dart1 {3 dict begin /a exch def /y exch def /x exch def
gsave x y translate a rotate
n 0 eq {0 setgray 0 0 moveto 3 ph -36 xy rlineto
2 ph 108 xy rlineto stroke
0 0 1 ph -36 0 blue 2 ph 0 0 ph 180 288 red green}
{/n n 1 sub def 0 0 0 kite1 4 ph -36 xy 144 dart1
/n n 1 add def} ifelse
grestore end} def

300 400 translate
/n 3 def init
0 72 288 {/a exch def 0 0 a kite0 0 0 a kite1} for
showpage

これで描いたn=3の図は次のようだ.

ここで, 最初に作る配列 phs は, φの等比級数を保持する. 再帰が深くなる, つまり, nが小さくなるにつれ, phsの添字の小さい方を使うようになっている.

thickとthinも同様なので, 省略する.

余計なことながら, YouTubeにdeflationの面白い動画があった.

2010年8月20日金曜日

都府県の接続グラフ

TAOCP vol.4にContiguous United States of Americaというグラフがある.



アメリカのハワイとアラスカを除く, 本土の48州とDCの隣接関係をグラフにしたものだ. 州名は郵便コードか何かの略号で書いてあるが, 大体は推測がつく. 殆んどは3つの州を頂点とする三角形の辺のグラフで, 注目すべきは左のUT, CD, NM, AZの四角と,中央上のWI, MI, IN, ILの四角だ. 前者は有名な4 sates cornerであり, 後者はミシガン湖である.

前から日本の都府県についても書いてみたいと思っていたところ, やっと書くことが出来た. もちろん北海道と沖縄は入っていない.


関東地方では古河のあたり, 茨城と埼玉が隣接し, 栃木と千葉を隔てているなど, クリティカルな場所がはっきりする. 隣接県の数(次数)が多い県は長野(8)であり, 最小は長崎(1)である. 長野が多いのは 信濃の国は十州に境連ぬる国にして の歌の通りだ.


ついでだが, 隣接する辺は次の通り. 頂点の番号は, 都道府県コードである.

((2 3)(2 5)(3 4)(3 5)(4 5)(4 6)(4 7)(5 6)(6 7)(6 15)(7 8)
(7 9)(7 10)(7 15)(8 9)(8 11)(8 12)(9 10)(9 11)(10 11)(10 15)
(10 20)(11 12)(11 13)(11 19)(11 20)(12 13)(13 14)(13 19)
(14 19)(14 22)(15 16)(15 20)(16 17)(16 20)(16 21)(17 18)
(17 21)(18 21)(18 25)(18 26)(19 20)(19 22)(20 21)(20 22)
(20 23)(21 23)(21 24)(21 25)(22 23)(23 24)(24 25)(24 26)
(24 29)(24 30)(25 26)(26 27)(26 28)(26 29)(27 28)(27 29)
(27 30)(28 31)(28 33)(29 30)(31 32)(31 33)(31 34)(32 34)
(32 35)(33 34)(34 35)(36 37)(36 38)(36 39)(37 38)(38 39)
(40 41)(40 43)(40 44)(41 42)(43 44)(43 45)(43 46)(44 45)
(45 46))

辺の数は86である.