クリスマス

メリークリスマス。一応。

今日は26日なので、日本ならケーキが半値以下になっているはず。
っが、こっちはセカンドクリスマスといって、祝日！だったりする。
(ちなみに、クリスマス自体も祝日)
今年は土曜日なのであんまり関係ないが。
(来年は25と26で土日なので最悪だが)

クリスマスということで、えらい勢いで(名古屋弁)物が売れたらしい。
買い物にいったら売り切れとかどんだけ・・・
しかも売り切れたのは3日前とかどんだけ・・・
という状態だった。
この不況に消費が活性化されるのはいいことだとは思うけどね。

そんな感じであった。
取り留めないなぁ・・・

Scheme: ソースを色づけするスクリプトを書いてみた

何か実用的なものを作ってみようと思い書いてみた。
(実用的かどうかはよく分からんが・・・)

1: (require rnrs/hashtables-6)
2: (define keywords (make-eq-hashtable))
3: (define (set-keywords)
4:   (begin
5:     (hashtable-set! keywords 'define "<span style=\"color: blue;\">define</span>")
6:     (hashtable-set! keywords 'if "<span style=\"color: blue;\">if</span>")
7:     (hashtable-set! keywords 'let "<span style=\"color: blue;\">let</span>")
8:     (hashtable-set! keywords 'letrec "<span style=\"color: blue;\">letrec</span>")
9:     (hashtable-set! keywords 'lambda "<span style=\"color: blue;\">lambda</span>")
10:     (hashtable-set! keywords 'cond "<span style=\"color: blue;\">cond</span>")))
11: (define (keyword? key)
12:   (hashtable-contains? keywords key))
13: (define (highlighted-keyword key)
14:   (hashtable-ref keywords key ""))
15: ; string might be like this "(define",
16: ; this function should return like this -> "(<span style=\"color: blue;\">define</span>"
17: (define (has-tag? str)
18:   (let loop((strls (string->list str)))
19:     (cond ((null? strls) #f)
20:           ((char=? (car strls) #\<) #t) ; if the string has "<" it's must be tag(might be < procedure...)
21:           (else (loop (cdr strls))))))
22: (define (list->symbol ls)
23:   (string->symbol (list->string ls)))
24: (define (parse-keyword str)
25:   (if (has-tag? str)
26:       str ; if the string has tag, just return.
27:     (letrec ((ls (string->list str))
28:              (set ((lambda (l)
29:                     (let firstb((c (car l))
30:                                 (rest (cdr l))
31:                                 (ret '()))
32:                       (cond ((null? rest) (cons ret rest))
33:                             ((char=? c #\() (cons (append ret (list c)) rest))
34:                             (else (firstb (car rest) (cdr rest) (append ret (list c)))))))
35:                       ls)) ; blanket + space
36:              (br (car set))
37:              (rest (cdr set)))
38:             (if (null? rest) 
39:                 str ; only ( or spaces
40:               (let ((key (list->symbol rest)))
41:                 (if (keyword? key)
42:                     (string-append (list->string br) (highlighted-keyword key))
43:                   str))))))
44: 
45: (define (read-file file-name)
46:   (with-input-from-file
47:    file-name
48:    (lambda ()
49:      (let loop((ls '())
50:                (c (read-char)))
51:        (if (eof-object? c)
52:            (reverse ls)
53:          (loop (cons c ls)(read-char)))))))
54: 
55: (define (last-char str)
56:   (let ((l (string-length str)))
57:     (if (= l 0)
58:         (integer->char 0)
59:       (string-ref str (- l 1)))))
60: 
61: (define (high-light str)
62:   (let ((ls (string->list str)))
63:     (if (null? ls)
64:         "" 
65:       (let loop((forward "")
66:                 (c (car ls))
67:                 (src (cdr ls))
68:                 (is-quoted #f)
69:                 (is-escape #f))
70:         (cond ((null? src) (string-append forward (string c)))
71:               ; escape begin
72:               ((char=? c #\&)
73:                (loop (string-append forward (string c)) (car src) (cdr src) is-quoted #t))
74:               ; escapse end
75:               ((and is-escape (char=? c #\;))
76:                (loop (string-append forward (string c)) (car src) (cdr src) is-quoted #f))
77:               ; quote
78:               ((and (char=? c #\") (not (char=? #\\ (last-char forward))))
79:                (cond ((and is-quoted) ; end quote
80:                       (loop (string-append forward (string c) "</span>") (car src) (cdr src) #f is-escape))
81:                      ((not is-quoted) ; begin quote
82:                       (loop (string-append forward "<span style=\"color: green;\">" (string c))
83:                         (car src) (cdr src) #t is-escape))
84:                      ; in quote
85:                      (else (loop (string-append forward (string c)) (car src) (cdr src) is-quoted is-escape))))
86:               ; comment
87:               ((and (not is-quoted)
88:                     (not is-escape)
89:                     (not (char=? #\\ (last-char forward)))
90:                     (char=? c #\;))
91:                (string-append forward
92:                               "<span style=\"color: #006600; font-style: italic;\">" 
93:                               (string c)
94:                               (list->string src)
95:                               "</span>"))
96:               (else 
97:                (if (and (< 0 (string-length forward)) (char-whitespace? c)) ; if the charactor is whitespace
98:                    (begin
99:                      (set! forward (parse-keyword forward)); check if the string is keyword
100:                      (loop (string-append forward (string c))(car src) (cdr src) is-quoted is-escape))
101:                  (loop (string-append forward (string c))(car src) (cdr src) is-quoted is-escape))))))))
102: 
103: (define (make-line str num)
104:   (string-append "<div><span style=\"display: inline-block; width: 30px; font-weight: bold; text-align: right;\">" 
105:                  (number->string num)
106:                  "</span>: " 
107:                  (high-light str)
108:                  "</div>"))
109: 
110: (define (escape c)
111:   (cond ((char=? #\< c) "<")
112:         ((char=? #\> c) ">")
113:         ;((char=? #\" c) """)
114:         ;((char=? #\& c) "&")
115:         (else (string c))))
116: 
117: (define (read-line source)
118:   (if (null? source)
119:       '()
120:     (let line((ret (cons "" (cdr source)))
121:               (c (escape (car source))))
122:       (cond ((null? (cdr ret)) ret)
123:             ((string=? "\r" c) (line (cons (car ret)(cddr ret)) (escape (cadr ret))))
124:             ((string=? "\n" c) ret)
125:             ((string=? "\t" c) (line (cons (string-append (make-string 8 #\Space)
126:                                                           (car ret))
127:                                            (cddr ret))
128:                                      (escape (cadr ret))))
129:             (else (line (cons (string-append (car ret) c)
130:                               (cddr ret))
131:                         (escape (cadr ret))))))))
132: 
133: (define (build-html contents)
134:   (define (build-itr contents)
135:     (let build((ret "")
136:                (line (read-line contents))
137:                (num 1))
138:       (if (null? line)
139:           ret
140:         (build (string-append ret (make-line (car line) num))
141:                (read-line (cdr line))
142:                (+ num 1)))))
143:   (string-append "<pre>" (build-itr contents) "</pre>"))
144: 
145: (define (main args)
146:   (if (null? args)
147:       (begin
148:         (display "usage: scm2html file-name")
149:         -1)
150:     (let ((contents (read-file args)))
151:       (set-keywords)
152:       (display (build-html contents))
153:       (newline))))
154: 
155: (main "scm2html.scm") ; test

長い上に汚い・・・っが、開き直ってさらしてみた。

仕様：
* 行番号付与
* コメント、文字列及びキーワード色づけ
* タブをスペースに変換。

既知の不具合：
ダブルクオート(文字列)の色づけ周りは大分怪しい。文字列の後ろになんか文字がないとタグがおかしくなる。(ブラウザで見る分には問題ないけど、HTMLとして不正になる)

Perlで作れば簡単なのに何やってんだろうとか思いながら作った。Schemeは文字列処理得意じゃないのかしら？
(正規表現使ってないからだと思うが・・・R6RSって正規表現サポートしてるのかな？)

寒い寒い

雪が溶けない。土曜日にこんな感じだった。

今のところ、そのまま足跡がついた程度でとどまっていたりする。寒い。

こんな雪の中、ドイツに行こうとした(実際には以前から計画していた)。
ユトレヒトで国際列車(？)に乗り換えてという感じ。
ユトレヒトの駅はこんなだった。(ユトレヒト中央駅のバーガーキングから)

国際線は来ませんでした(昨日の話)。
まぁ、いかないと決めたのだが、今日電車がドイツまで走っているか調べてみた。


はい、ありませんでした～(ごちバトルの羽鳥アナ風)

この量の雪は珍しい(らしい)とは言え、いくらなんでも雪に弱すぎだろうオランダ。

寒い

現在、オランダは冬です。当たり前です、北半球なんだから。
寒い。マジで。
最高気温１度って何ですか？殺す気ですか？
秋の雨で(工事中の穴に)たまった水が凍って、スケートできそう。
そんな気分です。

これだけ寒いと、当然彼が来るわけです。そう、白い悪魔君が・・・
ってか、来ました。１０ｃｍくらい・・・

雪が降ると日本でもそうだけど交通事情がえらいことに(名古屋弁)なります。
特に電車。
３０分おくれは当たり前。
運休とか勝手に路線変更とか連発。
７時に家をでて９時半ちょい過ぎに職場に着きました。
いつもなら８時ちょい過ぎです。勘弁してください。

ってか、雪が降ること分かってる国のはずなのに、雪対策が無いってどういうことだよ！
おかしいだろ！！

Scheme: SICPの練習問題(2.68)

飛んでたりする。いや、これ以前もちゃんとやってますよ(^^;

以前Huffman符号のことを(LHAの話か？)をちらっと書いて、あきらめたとも書いたがその話題だったのでついつい。
とりあえず、Huffman符号木について。木自体はこんな感じ。

{A B C D E F G H} 17
               *
             /   \
           A 8     * {B C D E F G H} 9
                 /     \
     {B C D} 5 *           \
             /   \             \
           B 3     * {C D} 2      * {E F G H} 4
                 /   \        /       \ 
               C 1   D 1    * {E F} 2     * {G H} 2
                          /   \         /     \
                        E 1  F 1      G 1     H 1

いまいち二分木に見えないのはご愛嬌。
ここではなのか、一般的になのか、左に行けば１、右にいけば０となっている。数字は重み(多分、頻出度)

デコードは、ビット列から文字列を復元するので、先頭からビット見て行って葉にたどり着いたところで一文字復元完了という感じ。
エンコードは逆。上から木を舐めて、葉にたどり着くまでもビットを記録するって感じ。

っで、２．６８の解凍

(define (encode-symbol symbol tree)
  (define (has-symbol? symbol tree)
    (if (leaf? tree)
 (eq? symbol (symbol-leaf tree))
      (or (has-symbol? symbol (left-branch tree))
   (has-symbol? symbol (right-branch tree)))))
  (if (leaf? tree) ; 葉ならシンボルを見つけた
      '()
    (let ((left (left-branch tree))
   (right (right-branch tree)))
      (cond ((has-symbol? symbol left)
      (cons 0 (encode-symbol symbol left)))
     ((has-symbol? symbol right)
      (cons 1 (encode-symbol symbol right)))
     (else (error "error"))))))

最初はcondの中でifを使って変な場合分けをしてlistを返してappendしていたが、解答はすっきりconsを使ってた。いまいちこの辺の使い方がまだ身について無い感じ。う～ん。
まぁ、でもHuffman符号の具体的なやり方がわかったということでちと満足。
(もやもやとは分かっていたが、木の作り方とかいまいちだった)

TopCoder

アルゴリズムでググッたら出てきた。
面白そうなので登録。

サイト自体はプログラムコンテストサイトで、与えられた問題を解いていくというもの。
解ける問題から、そうでもないのまで幅広い・・・
とりあえず自力で解いて、誰かが書いた解答を見る。
自分が未熟を通り越して、スタート地点にも立ってないのかと思わされた。

基本的なことでできるのだが、柔軟な発想とか、数学的知識がぜんぜん足りない。
気づいたのだから勉強しないと・・・

Scheme: SICPの練習問題(2.17～2.28)

最近SICPを読み始めた(オンラインなので、英語。きつい・・・)
SICPはMITが出してる本で、バイブル的な何からしい。
1章の問題は数学チックなのが多いので、半分くらい飛ばしてしまった。後でやろう。
折角なので、(自分の)答えを載せてみたり。

下のは職場のGaucheで作って(おいおい)、家のMzSchemeで確認。
MzSchemeだと「()」が使えないので、「'()」に変更。
一つMzSchemeで動かないのがあった。処理系依存なコードだったのかしら？

; 2.17
(define (last-pair list)
  (define (last-pair-itr val list2)
    (if (null? list2)
 val
      (last-pair-itr (car list2) (cdr list2))))
  (last-pair-itr (car list)(cdr list)))
(last-pair '(1 2 3 4 5 6))

; 2.18
(define (reverse list)
  (define (reverse-itr ret list2)
    (if (null? list2)
 ret
      (reverse-itr (cons (car list2) ret) (cdr list2))))
 (reverse-itr '() list))
(reverse '(1 2 3 4 5 6))


; 2.21
(define (square-list-no-map list)
  (if (null? list)
      '()
    (cons (* (car list) (car list))
   (square-list-no-map (cdr list)))))
(square-list-no-map '(1 2 3 4 5 6))



(define (square-list list)
  (map (lambda (x)(* x x)) list))
(square-list '(1 2 3 4))


; 2.22
(define (square-list items)
  (define (square x)(* x x))
  (define (iter things answer)
    (if (null? things)
 answer
      (cons (square (car things))
     (iter (cdr things) answer))))
  (iter items '()))
(square-list '(1 2 3 4 5))


; 2.23
(define (for-each proc items)
  (if (null? items)
      #f 
    (and (proc (car items))
  (for-each proc (cdr items)))))

; 2.25
(car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))
(car (car '((7))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7))))))))))))))))))

; 2.26
(define x (list 1 2 3))
(define y (list 4 5 6))
(append x y)
(cons x y)
(list x y)

; 2.27
(define x (list (list 1 (list 2 3) (list 4 5)) (list 6 7 8)))
(reverse x)
(define (deep-reverse list)
  (define (reverse-itr ret list)
    (cond 
     ((null? list) ret)
     ((pair? (car list))
      (reverse-itr (cons (reverse-itr '() (car list)) ret) (cdr list)))
     (else (reverse-itr (cons (car list) ret)
   (cdr list)))))
  (reverse-itr '() list))

; Gaucheでは動いたコード
;(define (deep-reverse list)
;  (cond
;   ((null? list) '())
;   ((pair? (car list)) (cons (car (cdr (car list)))(car (car list))))
;   (else (cons (deep-reverse (cdr list)) (car list)))))
(deep-reverse x)


; 2.28
(define (fringe l2)
  (cond ((null? l2) '())
 ((not (pair? l2)) (cons l2 '()))
 (else (append (fringe (car l2))
        (fringe (cdr l2))))))
(fringe (list x x))

時間がほしい

働きつつ、(オランダ語)学校にいってるから平日は時間が全然無い。
日が昇らないうちに出社して、暗くなってから帰宅なんて生活だ。
(ちなみに、今の時期は8時ちょい過ぎに日が昇り、5時前に日が沈むけど:-P)

最近つらつらと考えていることの備忘録。

1. 何か実用的なものを作りたいなぁ
   
   
   • ちょっと考えてるのはC++実装のServletサーバー。需要なさそうだけど・・・
   • OSとか言語処理系とかも面白そうだ。
   • 最近意図的にBoostを避けてたけど、そろそろ使おうかな。やっぱり便利だし・・・
   
   
2. オランダ語の文法で意味不明だった部分が理解できた

2. について。
オランダ語の変な文法が理解できた。こんなの↓
Vandaag ben ik moe.
(英訳) Today am I tired.
ずっと、何で主語が動詞の真後ろに移動してるんだ？と疑問だった。なにしろ、普通に書くと
Ik ben moe vandaag.
になるのに、Vandaag(今日)を強調すると、上記みたいになる。
なぜ？
っで、理由。
Persoonsvormen(人称系？誰か訳教えて)は必ず2番目に来る。
Persoonsvormenとは英語で言うところの、三単現のSが適用される位置にある動詞のこと。つまり、格変化する動詞。
変なルールとか思いながらも、そのルールに当てはめれば確かに納得がいく。
ちなみに、他の文法は結構英語に似てるので、そんなに苦労はしない。っが、語彙が圧倒的に足りないのでぜんぜん話せない。先は長そうだ・・・