最近プログラミングしてなかった。 授業で出てきた、木を0,1で表現するアルゴリズムってのが面白そうなのでリハビリということで実装してみた。

(use gauche.collection)
(use srfi-1)

; ex. pathls = ((1 2) (2 3))
(define (tree->label pathls)
  (let loop ((nodes (make-node-list pathls)))
    (cond ((<= (length nodes) 0) (error "why is there no node?"))
          ((= (length nodes) 1) (get-label (car nodes)))
          ((= (length nodes) 2) (apply append (sort (map get-label nodes) label>?)))
          (else
            (let1 non-leaf-nodes (filter (lambda (n) (not (leaf? n))) nodes)
                  (let iter ((nln non-leaf-nodes)
                             (promises '()))
                    (if (null? nln)
                      (begin
                        (for-each force promises)
                        (loop non-leaf-nodes))
                      (begin
                        (let1 node (car nln)
                              (set-label! node (concat-labels node))
                              (iter (cdr nln) (cons (delete-leaves! node) promises)))))))))))

(define (make-node id)
  (list id (list 0 1) '()))

(define (get-label node)
  (cadr node))

(define (get-id node)
  (car node))

(define (get-branches node)
  (caddr node))

(define (get-leaves node)
  (filter leaf? (get-branches node)))

(define (set-label! node label)
  (set-car! (cdr node) label))

(define (leaf? node)
  (>= 1 (length (get-branches node))))

; nodeと隣接する葉を削除するpromiseを返す
; 葉の削除後このnodeが葉になる可能性があり、削除を遅延しておかないと
; ほかのノードのdelete-leaves!でこのnodeが葉と見なされて消されてしまう
(define (delete-leaves! node)
  (let1 non-leaf-nodes (filter (lambda (br) (not (memq br (get-leaves node))))
                               (get-branches node))
        (delay (set-car! (cddr node) non-leaf-nodes))))

; nodeにbranch-nodeへの枝を追加する
(define (add-branch! node branch-node)
  (set-car! (cddr node) (cons branch-node (get-branches node))))

; pathで指定されたノード間をつなぐ ex. path: (1 2)
(define (connect! path nodes)
  (let ((node1 (get-node-by-id (car path) nodes))
        (node2 (get-node-by-id (cadr path) nodes)))
    (add-branch! node1 node2)
    (add-branch! node2 node1)))

(define (label>? label1 label2)
  (> (length label1) (length label2)))

(define (make-node-list pathls)
  (let1 nodes (map make-node (path-list->node-id-list pathls))
        (for-each (cut connect! <> nodes) pathls)
        nodes))

(define (get-node-by-id id nodes)
  (find (lambda (n) (eq? id (get-id n))) nodes))

(define (path-list->node-id-list pathls)
  (delete-duplicates (apply append pathls)))

(define (concat-labels node)
  (append '(0)
          (apply append (sort (cons (cdr (drop-right (get-label node) 1))
                                    (map get-label (get-leaves node)))
                              label>?))
          '(1)))

長いね。

アルゴリズムの詳しい説明はめんどくさいんでしないけど、 大まかに言うとノードにラベルを振って、 葉をそれが隣接するノードのラベルで表現したらその葉を消していくって感じ。 ノードのラベルが変化していくので代入の手続きを使ったけど、 代入はまだまだ慣れないなあ。混乱する。

個人的には遅延評価がうまいこと使えたのがよかったです。いや、うまいのかどうかはわかんね。 使いたかっただけじゃないかと。

ノードが1, 2, ...で、枝を(1 2)とかと表現。

gosh> (tree->label '((1 3) (2 3) (3 4) (5 6) (6 7) (8 9) (4 10) (7 10) (9 10)))　…☆
(0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1)
gosh> (tree->label '((1 2) (3 4) (2 5) (4 5) (5 6) (7 8) (8 10) (9 10) (5 10)))
(0 0 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1)
gosh> (tree->label '((a b) (b c) (c d) (e f) (f d) (d g) (g h) (h i) (h j)))　　…○
(0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1)

木が0, 1で表現できるなんて面白い。 そう言えば、これは木の同型判定アルゴリズムとかいってたな。☆と○が同じ結果だから 同じ木ですってことでいいんだったかな。

ん、待てよ。わざわざdelay使わなくても

(define (delete-leaves! node)
  (let1 non-leaf-nodes (filter (lambda (br) (not (memq br (get-leaves node))))
                               (get-branches node))
        (lambda () (set-car! (cddr node) non-leaf-nodes))))

として、tree->labelのところを

(for-each force promises)
　　↓
(for-each (lambda (p) (p)) delete-proc)

としても同じじゃないか。ハズカシス(´Д⊂)

やっぱり遅延評価はまだ使いどころがわからないっていうか、まず勉強するのが先か。

木を0,1のラベルにするやつの逆をやってみた。

(use srfi-1)

(define (label->tree label)
  (let loop ((label (cdr (normalize label)))
             (stack (list 1))
             (num 2)
             (pathls '()))
    (cond ((null? label) pathls)
          ((= 1 (car label)) (loop (cdr label) (cdr stack) num pathls))
          ((= 0 (car label))
           (loop (cdr label) (cons num stack) (+ num 1) (cons (list num (car stack))
                                                              pathls))))))

; label->treeがすっきりするようにlabelを変形
(define (normalize label)
  (let1 sp (split-point label)
        (if (= sp (length label)) label
          (append (cons 0 (take label sp))
                  (cdr (drop label sp))))))

(define (split-point label)
  (let loop ((num 1) (sum 0) (l label))
    (let1 n (if (= 0 (car l)) 1 -1)
          (if (= 0 (+ sum n)) num
            (loop (+ num 1) (+ sum n) (cdr l))))))

gosh> (tree->label '((1 3) (2 3) (3 4) (5 6) (6 7) (8 9) (4 10) (7 10) (9 10)))
(0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1)
gosh> (label->tree (list 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1))
((10 9) (9 1) (8 7) (7 6) (6 1) (5 3) (4 3) (3 2) (2 1))

ノードの番号は当然一致しないけど、同じ木ができたっぽい。もう一個。

gosh> (tree->label '((1 2) (3 4) (2 5) (4 5) (5 6) (7 8) (8 10) (9 10) (5 10)))
(0 0 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1)
gosh> (label->tree (list 0 0 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1))
((10 1) (9 8) (8 1) (7 2) (6 5) (5 2) (4 3) (3 2) (2 1))

同じっぽい。

ubuntuの6.06が出たので/etc/apt/sources.listを適当にs/breezy/dapper/してupgrade, dist-upgradeとかしつつ、 途中で再起動したらinitが起動せずに

ALERT! /dev/hda1 does not exist. Dropping to a shell.

となってBusyBoxとかいうのが起動した。(((( ；゜Д゜)))ガクガクブルブル

BusyBoxじゃなんもできないのでぐぐったら出てきたやつを 参考に、 以前使ってたハードディスクをつけて、そこに入ってるVine Linuxを起動、 ubuntuのハードディスクをマウントした後chrootでそちらへ。このコマンドすげぇ！　 見ためはVine、頭脳はUbuntu。そして何事もなかったかのようにdist-upgrade続行。

なるほど、ここで本来ならKnoppixを使うわけですか。まー今ドライブ死んでるからどうせ使えないんだけど。

Ubuntu-jaのページを見ると ubuntu-desktopとubuntu-desktop-jaを入れとけって感じなのでこれも。

それでも直らないので調べてたら、ちょうど

dpkg-reconfigure linux-image-2.6.15-19-k7 fixed it for me.

Bug #32123 in initramfs-tools (Ubuntu): “initramfs not generated correctly on upgrade to Dapper”

てのを見つけた。同じようにしたら解決。簡単に済んでよかった……。なんか最近解決のしかたが適当すぎ。

あれ？　Ubuntu6.06にしたときに何かあったのか、Rhythmboxでm4aファイルが聴けなくなった。 適当にaptitudeで突っ込んでも解決しない。 VIP STAR以外全部m4aなので、ここはとりあえずoggに変換しとく。

Howto:convert aac/mp4 to wav/mp3/ogg on Linuxという ページを参考に。

#m4a2ogg

infile=$1
wavfile=${infile%.*}.wav
mplayer -ao pcm "$infile" -ao pcm:file="$wavfile"
oggenc "$wavfile"
rm "$wavfile"

MPlayerすごい。MPlayerだとm4a再生できるんだよなぁ。てことはGStreamerとかいうのがいけないのかな。

これで

find . -name "*.m4a" -exec m4a2ogg {} ;

で全部再帰的にかたづくかと思ったけど、いくつか失敗する。ちっ。

ん、m4a再生できてるじゃん！　再起動が必要だったのかしらん。時間の無駄だった……。

ターミナルにバーっと結果を吐き出すプログラムをRubyで作ることが多いんで、 もうちょっと結果が見やすくなるように色とか付けたくなったんで作ってみた。

作ってる途中でこの車輪は先に発明されているんじゃないかと思って調べたらあった(´Д⊂)

• Text::Highlight
• Term::ANSIColor

でもこれ、両方ともうまくいかないケースがあるんですよ。

underlineが途中で切れちゃう。これでは気持ち悪いんで、作る。

class String
  BACKGROUND = {
    :on_black   => 40,
    :on_red     => 41,
    :on_green   => 42,
    :on_yellow  => 43,
    :on_blue    => 44,
    :on_magenta => 45,
    :on_cyan    => 46,
    :on_white   => 47
  }

  COLOR = {
    :black   => 30,
    :red     => 31,
    :green   => 32,
    :yellow  => 33,
    :blue    => 34,
    :magenta => 35,
    :cyan    => 36,
    :white   => 37
  }

  DECORATION = {
    :bold          => 1,
    :dark          => 2,
    :italic        => 3,
    :underline     => 4,
    :blink         => 5,
    :rapid_blink   => 6,
    :negative      => 7,
    :concealed     => 8,
    :strikethrough => 9
  }

  DECORATION.keys.each{|name| eval <<-EVAL }
    def #{name.to_s}
      apply_style(DECORATION[:#{name.to_s}])
    end
    EVAL

  COLOR.keys.each{|name| eval <<-EVAL }
    def #{name.to_s}
      apply_style(COLOR[:#{name.to_s}], COLOR.values)
    end
    EVAL

  BACKGROUND.keys.each{|name| eval <<-EVAL }
    def #{name.to_s}
      apply_style(BACKGROUND[:#{name.to_s}], BACKGROUND.values)
    end
    EVAL

  private

  def apply_style(style, ignored_styles = [])
    style_stack = [style]
    result = self.dup

    result.gsub!(/\e\[(\d+;)*\d+m/) do |match|
      if match == "\e[0m"
        if style_stack.pop.empty? or $'.empty?
          ""
        else
          match + create_parameter(style_stack)
        end
      else
        new_style = get_style(match) - ignored_styles
        style_stack << new_style
        create_parameter(new_style)
      end
    end

   "\e[#{style}m#{result}\e[0m"
  end

  def create_parameter(styles)
    if styles.empty?
      ""
    else
      "\e[#{styles.flatten.compact.uniq.join(";")}m"
    end
  end

  def get_style(param)
    param.scan(/\d+/).map{|d| d.to_i }
  end
end

underlineが切れたりとか、予想外のことは多分起こんない。

Term::ANSIColorからon_redなどの名前を拝借。 italicとかstrikethroughとかオレが調べたところには載ってなかったな……。つーか、 DECORATIONのメソッドはboldとunderlineとnegativeくらいしかまともに表示されなかった。 非対応ということなのかしらん。

あとyellow黄色じゃないんですが。whiteもon_whiteも灰色だし。 でもね、boldすると黄色くなったりするし、もう見ための色に名前を合わせるのは無駄だと悟った。

がんばれ日本！　うおおおおおおおおおおっ!！！

　　　 　 ┌─┐　　┌─┐
　　　 　 │●│　　│●│
　　　 　 └─┤　　└─┤
　　　　　 _ 　 ∩　　　_　 ∩　ニッポン！
　　　　(　゜∀゜)彡 　(　゜∀゜)彡　　ニッポン！
　┌─┬⊂彡┌─┬⊂彡
　｜●｜　 　 ｜●｜
　└─┘　 　 └─┘

……。

　　　 　 　　/~ヽ 　　/~ ヽ
　　 　 　　　| 　|i＿∧ゝ ノ
　　 　　　　ノ　ノ；´Д｀） / 　　うわぁぁぁぁぁっ！
　　　 　　（　ノ　　　　 ソ
　　　　 　　ヽ　　　　　 ヽ 　　最悪の時間帯に怒涛の失点キタ━━━━━━(゜∀。)━━━━━━ッ!!
　　　　　　　 ＼ 　　　　 ＼
　　　　 　　　　 ＼ 　　　　 ＼
　　　　　 ＿　　 ／　　 　 　　.＼ ＿
　　　　/ミ （⌒Ｙ.　　 ／￣.＼　 .＼　ミヽ
　　 　 　 ￣＼ ,_ _,／　　　 　＼,_ _,ノ￣

On Lispより。

関数は安全に書き換えられないものを返してはいけないということだ． だから返り値にクォート付きオブジェクトを含むような関数を書くのは避けるべきだ．

On Lisp --- 関数的プログラミング

んお。そうなのか。On LispにあるコードをSchemeで試してみる。

(define (exclaim expression)
  (append expression '(oh my)))

(exclaim '(lions and tigers and bears)) 
;;=> (lions and tigers and bears oh my)

(append! (exclaim '(lions and tigers and bears)) '(goodness))
;;=> (lions and tigers and bears oh my goodness)

(exclaim '(lions and tigers and bears))
;;=> (lions and tigers and bears oh my goodness)

おお。exclaimの'(oh my)のcddrがappend!によって変更されてしまうみたい。 クォートした'(oh my)ってのの実体は一体なんなんだろう。

(define (exclaim2 expression)
  (append expression '(oh my)))

(exclaim2 '(lions and tigers and bears))
;;=> (lions and tigers and bears oh my)

別の手続きに'(oh my)を使ってもそちらの'(oh my)は変更されていないようなので、 クオートされたものは手続きごとに環境のような形で持っているんだろうか。 それともそんなまどろっこしいことはなくて、適当にどこかに確保されるだけかな？

まさかこんなことも……。

(define (foo) '(a))

(foo)
;;=> (a)

(set-car! (foo) 3)

(foo)
;;=> (3)

(set-cdr! (foo) 4)

(foo)
;;=> (3 . 4)

Cで言うstaticのついたローカル変数のような、オブジェクト指向言語で言うクラス変数のような。 とにかく呼び出しごとに毎回生成されるものではないみたい。考えたこともなかったよ。

(define (exclaim expression)
  (append expression (list 'oh 'my)))

なら安全。なんとなくそうしてたけど、なるほどねぇ。

　　　 　 ┌─┐　　┌─┐
　　　 　 │●│　　│●│
　　　 　 └─┤　　└─┤
　　　　　 _ 　 ∩　　　_　 ∩　ニッポン！
　　　　(　゜∀゜)彡 　(　゜∀゜)彡　　ニッポン！
　┌─┬⊂彡┌─┬⊂彡
　｜●｜　 　 ｜●｜
　└─┘　 　 └─┘

まさかのスコアレスドロー……(つД｀)

ヒント：ゴールにボールを蹴りこむと点が入る

　　　　　　　　　　　　　ヽ(Д´ )ヘ ＜ シュートお前が打てよ！！
　　　　＿＿_　　　　　　 　（┌ ）　≡≡≡≡≡
　　　/　　　/|　　　　　　 Ｍ ＼　;。:;。
　　 /　　　/ | （ ゜д）　　 ‖
　　/　　　/　| （┘）┘ 　 ‖
　 /　　　/　　　>　>　　　 ‖
　/　　　/　　　　　　　　　 ‖
　|￣￣|　　　　∧　 　 　　 ○ ヽ(Д´ )ヘ ＜ いやお前が打てよ！！
　|　　　|　　じゃあ俺が　　　　　 （┌ ）　≡≡
　|　　　|　　　　　　　　　　　　　　　　＼ 　;。:



　　　　　　　　　　　　　
　　　　＿＿_　　　　　　ヽ(゜д゜)ヘ
　　　/　　　/|　　　　　　 （┌ ）　
　　 /　　　/ |○（゜д゜）　 　　 ＼　
　　/　　　/　|　（┘）┘
　 /　　　/　　　 >丶>
　/　　　/　　　　　 ヽ
　|￣￣|　　　　　　　ヽ　(∀｀)　 ＜ どうぞどうぞ
　|　　　|　　　　　　　 ヽノ（ ノ）
　|　　　|　　　　　　　　ヾ < ＼

痛いニュースより、 秀逸なAA。 どこまでいいやつなんだ、柳沢……。 そこは敵のゴールだからシュート打っていいんだよ？(´;ω;｀)

YouTubeのコメント欄見てるとよく「lol」って書き込みがあるんで、調べてみた。

LOL (also spelled lol) is an abbreviation for "laughing out loud", "laugh out loud", or less commonly "lots of laughter".

LOL （Internet slang） - Wikipedia, the free encyclopedia

なるほど、「糞ワロタ」か。

にしても、YouTubeのコメントは見て気持ちのいいもんじゃないことが多い。 「kill jap」だの「fuck jap」だの……。fuckin' japくらいわかるよ、ばがちんがー！

いやー嫌われてますねー、一部に。

ひげぽんさんが戦隊ものCDをとりあげていたんだけど、 ちょうど少し前オレもYouTubeで戦隊ものとかメタルヒーローものを漁ってた。

せっかくなんでブックマークから少し出してこよう。 スーパー戦隊魂ライブ。これもやばげ。2004年か……生で見たかったなぁ。

• Dynaman Live
• Bioman Live
• Changeman 2004
• Flashman Live
• Maskman Live
• Turboranger 2004
• Jetman Live

チェンジマンとフラッシュマンのかっこよさは異常。 まー、こういうのは一番熱心に見てたものが一番かっこいいんだろうね。

CDはこれかな（↓アサマシ注意w）。金に余裕ができたら買いそうだ。

スーパー戦隊魂2004 LIVE

posted with amazlet on 06.06.28

オムニバス ささきいさお 堀江美都子 スーパーレスキューBAND ザ・カインズ アップルパイ 石ノ森章太郎 Mojo 山川啓介 串田アキラ
コロムビアミュージックエンタテインメント (2005/01/19)
売り上げランキング: 39,506

おすすめ度の平均:

豪華な顔ぶれ

Amazon.co.jp で詳細を見る

このブログがトラックバック・スパマーにモテモテなので、 このブログへのリンクのないトラックバックは蹴ることにした。

ついでに蹴ったやつのログをとるようにしたんだけど、それ見ると3日連続で20件/日。 何がしたいんだろう……。

やっぱ後々いろんなところに響いてくるのは英語力だろうってんで、 英語の勉強をはじめることにする。

やるのは、数年前に買って本棚に眠っていた ヒーローズinアメリカ。

VOAスペシャルイングリッシュ・シリーズ ヒーローズinアメリカ―アメリカン・スピリッツを伝える偉人たちの半生を聞く

posted with amazlet on 06.06.30

アルク (1999/05)
売り上げランキング: 203,849

Amazon.co.jp で詳細を見る

リスニングの本なんだけど、シャドーイングに使う。 と言っても本見ながらなんで、正確にはシャドーイングとは言わないらしい。

きっかけはOn Off and Beyondさんの「すばらしい英語勉強法」 というエントリ。本の使い道ができてよかった。