2005年09月

夏休みがも終了．明日から新学期．でも明後日までまだ休み．最後に寝溜めだ．

お昼を買って研究室に行くのが最近の行動なのだが今日は朝っぱらから行くことにした．案の定，誰もいやしない．昼まで作業してたけど誰もきやしない．きたのはルータの調子を見に来た方のみ（ハングアップしてたからリブートしただけ...）．ま，作業はその分進んだからいいけどね．

いろいろなところで使われている LZSS の実装は多種多様である．なので，ありそうなパターンに対応できるようにソースを書いてみた．速度は度外視．あとで最適化すればいいし．圧縮部分の検索ルーチンをもう少し大きなハッシュにしたほうが速いだろうか？　ま，どうでもいいか．つーことで，そーすをおいておく．

Java で自分自身を出力する quine program を書いてみた．

結果はこんなん：

class Self {
    static String s="class Self {%n%tstatic String s=%c%s%c;%n%tpublic static void main(String [] args) {%n%t%tString ss=s.replaceAll(new String(new byte []{37, 110}), new String(new byte []{10}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 116}), new String(new byte []{9}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 99}), new String(new byte []{34}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 115}), s);%n%t%tSystem.out.print(ss);%n%t}%n}%n";
    public static void main(String [] args) {
        String ss=s.replaceAll(new String(new byte []{37, 110}), new String(new byte []{10}));
        ss=ss.replaceAll(new String(new byte []{37, 116}), new String(new byte []{9}));
        ss=ss.replaceAll(new String(new byte []{37, 99}), new String(new byte []{34}));
        ss=ss.replaceAll(new String(new byte []{37, 115}), s);
        System.out.print(ss);
    }
}

ほとんど printf をエミュレートするような形で...　美しくないなぁ．%n, %c, %t, %s を改行，ダブルクオート，タブ，自身の文字列で置換すると．ついでなので（ある程度）任意のプログラムを読み込んで quine program にしてしまうプログラムも作ったので置いておこう．

コンテストの規定は画像処理プログラムを書いて， fingerprint を実行するたびに異なるように入れろと．さたに，その fingerprint に意味はなくてもいいけどあるほうがよいと．んで，受賞した単に減色するだけのプログラムを見たけど...　まったく普通のプログラムにしか見えん．種明かしとしてはスタックフレームにローカル変数の値が残ることを利用して連続しているらしい．うーん，こんな方法思いつかんなぁ．もっと柔軟にならねば．

研究室の入っている建物が停電．当然ながら研究室のサーバ群はとめられている．ということで， cvs のコミットができないから今のうちに修正を入れようと思ったが...　よく考えたら update すらできないんじゃん orz．他の人の修正を反映せず何かやるのは危険なので今日は作業がすすまない．だめだこりゃ．

Singleton パターンではインスタンスを一つ作ってそれを使いまわす．そのために，そのインスタンスを取得する関数でインスタンスを作ってあるかを調べ，あったらそれをかえす，なければ新しく作るという動作をさせるのが一番楽．で，コンストラクタはプライベートにしておくと．

しかしながらとあるプログラマは次のようなコードを書いて，うまく動かないと騒いでいた．

AClass* AClass::getInstance(){
	static bool isFirst = false;
	if(!isFirst){
		instance = new AClass();
	}
	return instance;
}

isFirst が false のままだし...　あなたインスタンス取得するたびに新しいの作るんですか？　Singleton とか言ってたのにインスタンスはひとつじゃないんですね．そもそも isFirst などというフラグを持たずに if(!instance) と書いていれば間違いがなかったものを．

とりあえず今後の参考のためにこの事実を記しておこう．ちなみに彼はコンストラクタすらもプライベートでなかったという...　（まあ，このソース以外では正しいコードを書いていたそうだが．）

研究室の忘れ去られていたマシンにFreeBSDをいれて新しいWebサーバを作る手伝いをした．しかし，Linux ならインストールしまくりだけど FreeBSD のインストールはやったことがない．ということで，インストールはパッケージの選択だけやらしてもらった．

一通り入れ終わったら ports を最新にして，あとは必要なものを make; make install と．Gentoo と同じで地球環境にやさしくないなぁと思いつつ apache のモジュールを追加．途中，コンパイル前のオプション選択で変なものを選んだら make がエラーでこけて，どうやってオプション選択まで戻ればいいのかわからず悪戦苦闘．結局 make clean で解決したわけだが...　とにかくインストール完了．

そしたら apache のコンフィグを書き換えて cgi の動作と php の動作を確認．とりあえず PukiWiki が動くとこまではこぎつけた．まあ，PukiWiki の実行時にところどころ関数を参照渡しできませんとか言われてソースを一部書き換えたりしたけど．これって誰が悪いんだろう？

ここ三日間ほど替え玉が無料だったそうで遅めの昼飯は福のれんにてらぁめんを．ただとはいえ替え玉３つ食べればおなかいっぱい．３９０円の得か...　６００円超えまであと二つ．次回のときはもっとおなかをすかせてから行くとしよう．ちなみに「替え玉ダブル」なるものもあるそうな．３つ以上もあるのか？

Haskell で副作用のない LZSS を実装してみようと考えてやってみた．

検索には二分木を用いるとして，有限サイズの窓では二分木の古いノードを消さなければならない．ということで，キューでも使って追加したノードを覚えとけばいいのだけど，Haskell でO(1)操作のキューを作るのはただ事でないので...　とりあえずヒープを使って O(log n) のキューを作りましょうと．（まあ，Chris Okasaki: Simple and efficient purely functional queues and deques. JFP 5(4):583-592, October 1995. のキューが使えるんだけどよく理解してないし）

import Char
import List
import Monad
import System.Random
import System.IO
import System
import IO
import CPUTime
  
 -- 検索およびHeap用 BinaryTree 
  
data BTree a = Node a (BTree a) (BTree a) | Nil
  
 -- 表示
  
instance Show a => Show (BTree a) where
 showsPrec n x = xshowsB x 
xshowsB (Node a l r) = ("Node ("++) . (shows a) . (") ("++). (shows l) . (") ("++). (shows r) . (")"++)
xshowsB (Nil) = ("Nil"++)
  
 -- 表示2
  
printBTree b = mapM_ putStr (map (++"\n") (bstr b))
bstr (Node a l r) = let 
                    ba = shows a ""
                    sp = map (\x -> ' ') [1..(length ba)]
                    sps = ba:map (\x -> sp) [1..]
                    bstrr = bstr r
                    bstrl = (if isNil l then [""] else bstr l)
                    leftes = (if isNil r then leftedges2 else leftedges)
                    bl = map (\(p,e,s)->p++e++s) (zip3 sps leftes bstrl) 
                    br = map (\(e,s) -> sp++e++s) (zip rightedges bstrr)
                    in if (isNil l) && (isNil r) then [ba] else bl++br
    where
    leftedges = "-+-":leftedges'
    leftedges' = " | ":leftedges'
    leftedges2 = "-+-":leftedges2'
    leftedges2' = "   ":leftedges2'
    rightedges = " +-":rightedges'
    rightedges' = "   ":rightedges'
bstr Nil = [] 
  
 -- ノードのテストと置換
  
isNil Nil = True
isNil (Node a l r) = False
getVal (Node a l r) = a
getLeft (Node a l r) = l
getRight (Node a l r) = r
insRight (Node a l r) r' = Node a l r'
insLeft (Node a l r) l' = Node a l' r
insRoot (Node a l r) a' = Node a' l r
newNode x = Node x Nil Nil
  
 -- ヒープはサイズと二分木のペア
  
type HeapTree a = (Int, BTree a)
  
 -- heap の印刷用
  
printHeap (n, t) = printBTree t
  
 -- ヒープに値を入れる(key, val)
  
insertHeap::Ord a => HeapTree a -> a -> HeapTree a
insertHeap heap item = let news = fst heap + 1 in (news, ins news (snd heap))
    where
    ins n t = if n==1 then Node item Nil Nil
              else (if mod n 2 == 0 then (let 
                                          tl = getLeft t
                                          tl' = ins (div n 2) tl
                                          in swapHeapNodeLeft t tl'
                                         )
                    else (let 
                          tr = getRight t
                          tr' = ins (div n 2) tr
                          in swapHeapNodeRight t tr'
                         )
                   )
  
 -- 左右の子と適宜入れ替える
  
swapHeapNodeLeft (p@((Node ki1 l1 r1))) (c@((Node ki2 l2 r2))) 
    = if ki1 <= ki2 then Node ki1 c r1
      else Node ki2 (Node ki1 l2 r2) r1
swapHeapNodeLeft (Node ki1 l1 r1) Nil = Node ki1 Nil r1
  
swapHeapNodeRight (p@((Node ki1 l1 r1))) (c@((Node ki2 l2 r2))) 
    = if ki1 <= ki2 then Node ki1 l1 c
      else Node ki2 l1 (Node ki1 l2 r2)
swapHeapNodeRight (Node ki1 l1 r1) Nil = Node ki1 l1 Nil
  
 -- ヒープの最小値を覗く
  
peepMinimumHeap heap = getVal (snd heap)
  
 -- 空？
  
isEmpty (_, Nil) = True
isEmpty (_, Node _ _ _) = False
  
 -- 最小値と更新されたヒープを返す
  
minimumHeap::Ord a => HeapTree a -> (a, HeapTree a)
minimumHeap heap = let 
                   size = fst heap
                   t = snd heap
                   in if size == 1 then (getVal t, (0, Nil))
                      else let (h, l, r) =  moveLastToHead t size
                               in (getVal t, (size-1, reHeap h l r))
    where
    reHeap ki Nil Nil = Node ki Nil Nil
    reHeap ki Nil (r@(Node kir lr rr)) = if ki <= kir then Node ki Nil r
                                                else recR kir Nil ki lr rr
    reHeap ki (l@(Node kil ll rl)) Nil = if ki <= kil then Node ki l Nil
                                                else recL kil Nil ki ll rl
    reHeap ki (l@(Node kil ll rl)) (r@(Node kir lr rr))
        = if ki <= kir && ki <= kil then  Node ki l r
          else (if kir <= kil then recR kir l ki lr rr
                else recL kil r ki ll rl
               )
    recR kir l ki lr rr = Node kir l (reHeap ki lr rr)
    recL kil r ki ll rl = Node kil (reHeap ki ll rl) r
    moveLastToHead t s = let 
                         (h, t') = mov t s 
                         in (h, getLeft t', getRight t') 
    mov t n = if n==1 then (getVal t, Nil)
              else (if mod n 2 == 0 then (let 
                                          tl = getLeft t
                                          (h, tl') = mov tl (div n 2)
                                          in (h, swapHeapNodeLeft t tl')
                                         )
                    else (let 
                          tr = getRight t
                          (h, tr') = mov tr (div n 2)
                          in (h, swapHeapNodeRight t tr')
                         )
                   )
  
 -- ヒープソート
  
heapsort xs = heapsortrec (foldl (\t x -> insertHeap t x) (0, Nil) xs)
    where 
    heapsortrec heap = case heap of 
                                 (0, _) -> []
                                 (_,_) -> (let (ki, h') = minimumHeap heap
                                           in ki:heapsortrec h')
  
 -- ヒープのテスト
  
 -- 挿入過程
  
heaptest2 xs = foldl (\mt x -> mt>>= (\t -> let t' = insertHeap t x in printBTree (snd t')>> putStr "\n" >> return t')) (return (0, Nil)) xs
  
 -- 取り出し過程
  
heaptest3 heap = case heap of 
                           (0, _) -> print ""
                           (_,_) -> (let (ki, h') = minimumHeap heap
                                       in print ki >> printBTree (snd h') >> heaptest3 h')
  
 -- 挿入して取り出す
heaptest4 xs = heaptest2 xs >>= (\h -> heaptest3 h)
  

んで，検索木とキューの用意ができたので本体をば．展開はかなりきれいにかけるが圧縮部分が汚い...　ループ使わずに全部再帰だし．ちなみに符号は Direct c で圧縮なしのキャラクタ c, Compress a l で自分より a 前から l + threlength キャラクタで圧縮と．

 -- LZSS 符号
  
data LZCode = Direct Char
            | Compress Int Int
  
instance Show LZCode where
 showsPrec n x = xshowsLZ x 
xshowsLZ (Direct x) = ("D "++) . (shows x)
xshowsLZ (Compress a l) = ("C "++) . (shows (a, l))
  
instance Eq LZCode where
 (Direct x) == (Direct y) = x==y
 (Compress a l) == (Compress b m) = a==b && l == m
  
 -- 最大一致長
  
maxlength = 18
  
 -- これ未満の一致は圧縮しない
  
threlength = 3
  

- 窓のサイズ

  
windowsize = 4096
  
 -- 最大一致長までの文字列比較
  
cmpstrlen x y = csl x y 0 
    where
    csl (x:xs) (y:ys) n = if n == maxlength then (0, n)
                          else (if y==x then csl xs ys (n+1)
                                else (if x < y then -1 else 1, n))
    csl [] [] n = (0, n)
    csl [] y n = (-1, n)
    csl (x:xs) [] n = (1, n)
  
 -- 探索用 Binary tree の 初期値
  
initTree' = Node ("", -1) Nil Nil
initTree = map (\x -> initTree') [0..255]   
  
fst3 (x, y, z) = x
  
 -- 検索木を一文字目で選択して検索 (insertNode' を呼び出す)
 -- trees が探索木, str が探索文字列, pos が文字列の出現アドレス
 -- リターンは (新しい木, 一致長，一致アドレス)
  
insertNode trees str pos = let 
                           h = head str
                           k = (Char.ord h)
                           tree = trees!!k
                           (t, len, p) = insertNode' tree str pos
                           in ((take k trees)++(t:drop (k+1) trees), len, p)
  
 -- 検索木を検索
 -- trees が探索木, str が探索文字列, pos が文字列の出現アドレス
 -- リターンは (新しい木, 一致長，一致アドレス)
  
insertNode' tree str pos = ins True tree (0,-1)
    where
    ins True tree (len, p) = let
                             rtree = getRight tree
                             in 
                             if isNil rtree then 
                             (let 
                              t = insRight tree (newNode (str, pos))
                              in (t, len, p))
                             else 
                             (let 
                              (rstr, rpos) = getVal rtree
                              (cmp, lenr) = cmpstrlen rstr str
                              in (if lenr == maxlength then 
                                  (insRight tree (insRoot rtree (str, pos)), lenr, rpos)
                                  else
                                  let (t, l, pp) = ins (cmp>=0) (getRight tree) (if len < lenr then (lenr, rpos) else (len, p))
                                  in (insRight tree t, l, pp)))
    ins False tree (len, p) = let
                             ltree = getLeft tree
                             in 
                             if isNil ltree then 
                             (let 
                              t = insLeft tree (newNode (str, pos))
                              in (t, len, p))
                             else 
                             (let 
                              (lstr, lpos) = getVal ltree
                              (cmp, lenl) = cmpstrlen lstr str
                              in (if lenl == maxlength then 
                                  (insLeft tree (insRoot ltree (str, pos)), lenl, lpos)
                                  else
                                  let (t, l, pp) = ins (cmp>=0) (getLeft tree) (if len < lenl then (lenl, lpos) else (len, p))
                                  in (insLeft tree t, l, pp)))
  
 -- 検索用 Binary Tree のノードを消す(一文字ハッシュで木を選択して deleteNode')
  
deleteNode trees str pos = let 
                           h = head str
                           k = (Char.ord h)
                           tree = trees!!k
                           t = deleteNode' tree str pos
                           in (take k trees)++(t:drop (k+1) trees)
  
 -- 検索用 Binary Tree のノードを消す
  
deleteNode' tree str pos = fst (del True tree)
    where
    del True tree = let
                    rtree = getRight tree
                    in 
                    (let 
                     (rstr, rpos) = (case rtree of (Node _a _l _r) -> getVal rtree)
                     (cmp, lenr) = cmpstrlen rstr str
                     in (if cmp == 0 then 
                         (if rpos == pos then (insRight tree (replaceRootByBiggest rtree), False)
                          else (tree, True))
                         else
                         let (t, f) = del (cmp>=0) (getRight tree)
                         in if f then (tree, True) else (insRight tree t, False)))
    del False tree = let
                     ltree = getLeft tree
                     in 
                     (let 
                      (lstr, lpos) = (case ltree of (Node _a _l _r) -> getVal ltree)
                      (cmp, lenl) = cmpstrlen lstr str
                      in (if cmp == 0 then 
                          (if lpos == pos then (insLeft tree (replaceRootByBiggest ltree), False)
                           else (tree, True))
                          else
                          let (t, f) = del (cmp>=0) (getLeft tree)
                          in if f then (tree, True) else (insLeft tree t, False)))
    replaceRootByBiggest (Node a l Nil) = l
    replaceRootByBiggest (Node a Nil r) = r
    replaceRootByBiggest (Node a l r) = let 
                                        (v, l') = reprec l
                                        in Node v l' r
        where
        reprec (t@(Node a l Nil)) = (a, replaceRootByBiggest t)
        reprec (Node a l r) = let (v, r') = reprec r
                                  in (v, Node a l r')
  
 -- n' より前のエントリを que と 検索木に追加する
  
insentry que ts n' xx n = ins que ts xx n
 where 
 ins que ts xx n = if n==n' then (que, ts) 
                   else (case xx of 
                         (x:xs) -> (let 
                                    que' = (insertHeap que (n , xx))
                                    nn = n + 1
                                    ts' = if nn < n' then fst3 (insertNode ts (xs) nn) else ts
                                    in ins que' ts' xs nn)
                         [] -> (que, ts))
  
 -- n より前の que に入っているエントリを que と 検索木から削除する
  
delentry que ts n = del que ts
 where
 del que ts = if isEmpty que then (que, ts)
              else let
                   (n', s) = peepMinimumHeap que
                   in (if n' >= n then (que, ts)
                       else (let ((pos, str), que') = minimumHeap que
                             in del que' (deleteNode ts str pos)
                            ))
  
 -- 文字列 str を圧縮する 窓なし (参考)
 -- compress str = let
 --             (ts, c) = comp str 0 initTree []
 --             in c
 --  where 
 --  comp [] n ts code = (ts, List.reverse code)
 --  comp (xx@(x:xs)) n ts code = let 
 --                    (ts', l, p) = (insertNode ts xx n)
 --                    ll = (if l < threlength then 1 else l)
 --                    n' = n+ll
 --                    ts'' = ins ts' n' xx (n+1)
 --                    in comp (drop ll xx) n' ts'' ((if ll <= 1 then Direct x else Compress (n-p-1) (ll-threlength)):code) 
 --  ins ts n' xx n = if n==n' then ts
 --                   else case xx of
 --                            (x:xs) -> ins (fst3 (insertNode ts xx n)) n' xs (n+1)
  
 -- 有限サイズの窓を使った圧縮
  
compress2 str  = let (t, c) = comp str 0 initTree [] initQue in c
    where 
    initQue = (0, Nil)
    comp [] n ts code que = (ts, List.reverse code)
    comp (xx@(x:xs)) n ts code que = let 
                                     (ts', l, p) = (insertNode ts (xx) n)
                                     ll = (if l < threlength then 1 else l)
                                     n' = n+ll
                                     (que', ts'') = insentry que ts' n' xx n
                                     (que'', ts''') = delentry que' ts'' (n' - windowsize)
                                     in comp (drop ll xx) n' ts''' ((if ll <= 1 then Direct x else Compress (n-p-1) (ll-threlength)):code) que''
  
 -- 展開
  
decompress cs = text
    where
    text = dec cs 0
    dec [] n = []
    dec (c:cs) n = 
        case c of
        Direct x -> x:dec cs (n+1)
        Compress a l -> take (l+threlength) (drop (n-a-1) text)++dec cs (n+l+threlength)

んで，さらにこれを８符号ごとにまとめてバイトストリームに変換するのとそれをファイルに読み書きする部分を足し合わせると．最後にコマンドラインからファイル名とかを取るようにして完成．

 -- コードを８ずつまとめてフラグビットを作るのと
 -- アドレスとかをエンコードする
 -- Compress a l で， 0<=a<4096, 0<=l<16 で使用のこと
  
encode xs = enc xs 128 0 [] []
 where
 enc [] mask flags cs codes = List.reverse (cs ++ (Char.chr(flags):codes))
 enc (x:xs) mask flags cs codes = case mask of 
                                   0 -> (enc (x:xs) 128 0 [] (cs ++ (Char.chr(flags):codes)))
                                   _ -> (case x of 
                                         Direct c -> enc xs (div mask 2) flags (c:cs) codes
                                         Compress a l -> enc xs (div mask 2) (flags+mask) (Char.chr((div a 256)+l*16):Char.chr(mod a 256):cs) codes
                                        )
decode xs = dec xs 0 0 []
 where
 dec [] mask flags codes = List.reverse codes
 dec (x:xs) mask flags codes = case mask of 
                               0 -> (dec xs 128 (Char.ord x) codes)
                               _ -> (if (flags - mask < 0) then dec xs (div mask 2) flags (Direct x:codes)
                                     else 
                                     case xs of 
                                     (x':xs') -> dec xs' (div mask 2) (flags-mask) (Compress ((Char.ord x) + (mod (Char.ord x') 16)*256) (div (Char.ord x') 16):codes)
                                    )
  
 -- pico second から秒数表示
showSec psec = let msec = (div psec 1000000000)
                   in (show (div msec 1000) ++"."++ shown 3 '0' (mod msec 1000)++" sec\n")
  
 -- n 文字で c をパディングにして a を文字列化
  
shown n c a = let str = show a in sh (n - length str) str
    where
    sh k str = if k<= 0 then str else sh (k-1) (c:str)
  
 -- バイナリでオープンしないとならんので...
  
readBinaryFile path = openBinaryFile path ReadMode >>= hGetContents
writeBinaryFile path str = bracket (openBinaryFile path WriteMode)
                           hClose
                           (`hPutStr` str)
  
 -- ファイルを圧縮, 展開
  
compfile path = do 
                putStr (("output: "++path++".cmp\n"))
                st <- getCPUTime
                str <- readBinaryFile path
                c <- return (compress2 str)
                ec <- return (encode c) 
                writeBinaryFile (path++".cmp") ec
                ed <- getCPUTime
                putStr (showSec (ed-st))
                return c
  
decompfile path = do 
                putStr (("output: "++path++".dec\n"))
                st <- getCPUTime
                ec <- readBinaryFile path
                c <- return (decode ec) 
                str <- return (decompress c)
                writeBinaryFile (path++".dec") str
                ed <- getCPUTime
                putStr (showSec (ed-st))
                return str
  
usage = ["usage: [compress]   > lzss file",
         "       [decompress] > lzss -d compressedfile"]
  
printUsage = mapM_ (\x->putStr (x++"\n")) usage
main = do
       args <- getArgs
       if args ==[] then printUsage
          else if head args == "-d" then (decompfile (head (tail args)) >> putStr "done.")
               else (compfile (head args) >> putStr "\n")

720k のファイルで圧縮 88sec, 展開 ... 終わらん．130k で圧縮 15sec, 展開 7sec．ふむ，実用には絶対に耐えられん．意外に速かったけど．でも展開に変に時間がかかってるなぁ，どこが問題なのやら．ま，いいや．

数ヶ月前にグラボのドライバをボードのメーカーにある新しいのに変えたらアスペクト比固定の設定が起動ごとにリセットされるようになってしまっていた．んで，SXGA の液晶なのでゲームをやるごとにアスペクト比固定の設定をやらされていた．ドライバが悪いのかなぁと思って nVIDIA のサイトから最新のドライバ落として入れたら直った．どうでもいいけどバグのあるドライバを最新版のように置き続けるなよ某ボードメーカさん．

凸多角形と軸が与えられ，その多角形を軸周りに回転したときの回転体の体積を求める．こんなプログラムを書いたのだが...　　交差判定とかめんどくさすぎ．数式書いたらそれを計算してくれるプログラムをはく変換器がほしいと真剣に思う．そーいや，みんな戦略ソフトウェアの課題どうしたんだろ？

とうとう完全に壊れていまい，正しい姿勢で座るだけで筋トレができそうなぐらいぐらぐら．仕事にならんのでハンズまで新しい椅子を探しに．とにかく安くて回るやつを．んで，回って4000円弱のがあったのでそれを購入．背もたれ動かんので変な姿勢ができないけど...　壊れた椅子のパーツ使って背もたれの支え部分にばね仕込むか？

を買ってきた．プレクスターの PX-716A/JP2．シリアルＡＴＡのやつも気になったけど1.5倍の値段では手を出しづらい．ちなみに今日のヨドバシカメラは昨日よりも人が多くて動きづらかった．さらには後ろから邪魔だとばかりに体当たりしてくる秋葉ルックのむさい方たちもおったし...　にしてもあの人ごみの中で知り合いに会うとは思わんかったなぁ．まあ，人が多いから確率があがるといえばそうだけど．最後に，本日は6人のメイドさんを発見しました．

書くとこうなる

perm [] = []
perm [a] = [[a]]
perm (x:xs) = [ take i y ++ (x:drop i y) | y <- perm xs, i <- [1..length xs]]

ちなみに，y と i の生成順を逆にすると遅くなる．内側が先に確定して外側に行くので．

とうとう椅子の溶接部が壊れてしまったので安い椅子を探すついでに秋葉のヨドバシカメラへ行ってみた．各階をぶらぶらと歩き回りつつ，そろそろＤＶＤＲドライブ買い換えようかなと値段を見てみるが...　あまり安くないわな，普通に．Panasonic の-Rメディアが20枚1000円だったけど．それにしてもこう，私は人を見たいわけではないのですけど，と言いたいくらいに人人人...　明日あたりすごいことになるのかなぁ？行ってみるか，ドライブ買うついでに．

花映塚は今日委託販売開始なのでタワー積みになっていた．そして本日秋葉で見かけたメイドさんは5人でしたとさ．

仙台土産に笹かまと萩の月をば．萩の月は箱に入ってると高いので簡易包装版を買ってと．ちなみに箱代は萩のつきひとつあたり30円．値段の２０％を箱が占めるって...

さて，帰りの深夜バスはちゃんと寝れるかなぁ？

懇親会の後にホテルで作成中の論文のミーティングを行った．論文を修正案を出して論文の構成を良くするのが目的で，その修正案を印刷した論文に赤ペンで書き込むのがいつものスタイルである．しかしながら今は研究室でなくホテルの一室，そこにプリンタなどあるはずもなく...　でも印刷した論文がやっぱほしいよねとキンコーズでも探そうかという話になったが，その前に駄目もとでホテルのフロントで印刷してもらえるかためしに聞いてみた．そしたらなんと印刷してもらえるとの返事が．キンコーズ探す手間が省けたし非常にありがたい．いまだかつてこんなお願いをフロントにした客はいなかったと思われるが，それをこころよく引き受けてくれたこのホテル 第一インパーク はなかなかに良いホテルである．今度また仙台に行く用事があるときは是非また利用したいと思う．LANも使えるし．

ところで誰がフロントに頼んでみようと言い出したのだろう？

入ったときに店員に「お帰りなさいませ」と言われるのはメイド喫茶だけだと思ってたらホテルのフロントも「お帰りなさいませ」だった．さすがに「ご主人様」はつかんけど．

やめればいいものを今日も東北大へと山登り．毎日これやったらやせるかも知れん，いや死ぬか？　とりあえず水分補給は大事です．

深夜バスに揺られ朝五時に仙台入り．その後，朝飯のためにファミレス求めて練り歩き，しまっているファミレス何軒か．最終的にガストに入って朝飯くらい，あとは東北大の工学部まで「歩き」．非常に暑い中むちゃくちゃ汗かいて寝不足もあって疲れ果てた．まあ，ホテルがかなりきれいで便利なので良いとしよう．

外に出たとたんに雨が降った．たいした雨じゃないけど傘を取りにもどる．傘をさして暫く歩いた．駅に着く前に雨が土砂降りになって傘がひっくり返った．えー，今夜から仙台に旅立つのにずぶぬれ．靴とか乾ききるんか？

展開できたついでに酒の勢いで再構築（圧縮）できるようにしてみた．んで，中にデモ用のリプレイファイルがあるからそれを自分のリプレイに置き換えてみたところ...　デモはステージが固定なのかわけのわからない動きをして被弾しまくる結果に．ま，こんなもんだわな．

技術的には LZ の圧縮部分(最長一致の検索部分)を高速化したいところではある．いまのところ再構築に３５秒程度かかっているのでまったり感が微妙に...　やっぱ binary tree ではなくハッシュを使う方式にしたほうが速いのだろうか？　もしくはアセンブラを考慮して最適化したコードを書かねばならんのか？　どうでもいいけどアドレス値が 0 になったのを符号列の終端の印にするってのは一般的なのだろうか？　これの分だけちょこっと圧縮率損するんだよなぁ...

なにやら不合格にならず通過となったようだ．めでたいので酒酒酒．ただ，CHOYAの「黒糖梅酒」は梅酒なのかわからん味ではずれだったか...　やっぱこの前飲んだ日本酒の梅酒がおいしかったなぁ．是非また飲みたい．

最近見かけるようになったので食べてみた．最初に食べたのはフジパンのやつで，パッケージ通りのおいしさだった(160円@生協)．外はカリカリで中はメープルシロップがしみこんでしっとりと．んで，セブンにも売ってたので買って食べてみた(150円)．うーん，値段の違いなのかフジパンのよりぱっとしないメープルの香りつきメロンパンのような...　はずれだったのか？

昨日ＦＧしたにもかかわらず眠気に負けて読んでなかったのを本日読了．今回はＶと同様に過去の話で燃え燃え～．いろいろと伏線回収されてるし．棺の織手とか一巻に名前だけ出たやつだし．とりあえず一番驚いたのは小夜啼鳥であったことはいうまでもない．

二つの和を求めるプログラムがある．

#include<iostream>
using namespace std;
int main(int argc, char *argv[]){
	double d = 1e300;
	double sum = 0;
	for(int i = 0; i < 10000000; i++){ sum+=d; }
	cout << sum << endl;
}

#include<iostream>
using namespace std;
int main(int argc, char *argv[]){
	double d = 1e308;
	double sum = 0;
	for(int i = 0; i < 10000000; i++){ sum+=d; }
	cout << sum << endl;
}

上は 1e300 を 100000000 回足した和を求める．下は 1e308 を 100000000 回足した和を求める．これらのプログラムを実行した場合，普通は速度の違いなどないように思えるが...　実際に動かすと上が 0.148s で下が 0m3.692s と劇的に違う．これは double が 1.7e308 程度までしか値を保持できず，これ以上ではオーバーフローして Inf になってしまうことによる．で，Inf に値を足し続けるので遅くなると．何で Inf で遅くなるのかしらんけど．

最近椅子がギシギシ言っているのでどこがうるさいのだろうとよく見てみたら...　　傾いてる orz　何かジョイントの溶接部が割れてきたようなないような状況で4年半使ってきた椅子も引退か？　コントのように椅子が壊れて滑り落ちるまでは使うことにしよう．

数直線上に一定周期で一定幅を持つ区間が並んでいると．そんなのを二つ持ってきたときに何処かに重なる部分がありますかという問題を解きたい．当初あほな私は for 文を繰り返し幅の lcm 文にいたるまでぶん回していたのだが...　よく考えたら gcd の分だけできるだけ近づけて考えれば一発でいいじゃんと．いやぁ，あほだった．

ある期間内に存在する指定した曜日と日にちをもつ日の数を数えたり，グラフ上を巡回するアリ全部に対して情報伝達可能かどうかをしらべたり．そんな問題を解いたわけだが...　コーディングが遅くなっているような...　最近この手のプログラムかいとらんかったからなぁ．いや，むしろ日付問題が苦手なだけだだろうか？　まあ，そんなことはどうでもよいのでさっさといやらしい入力を作るか．

友人がリプレイファイルの解析をやっていたのでデータファイルの解析をやってみた．結論としてはブロックに切ってスクランブルしてマスクでXORして，LZで圧縮かけて（アドレス13bit, 長さ4bit, 絶対アドレス（開始オフセット１）），全部をがしゃんとくっつけて最後にファイル名とアドレスと展開後のサイズの情報をまとめてLZかけてスクランブルしてくっつけてあると．んで，先頭には識別文字4つとファイル情報のエントリ数，アドレス，展開後のサイズがスクランブルされて格納されていると．

いやぁ，結構手間がかかってるもんだなぁと関心しつつ，ここまでやらなきゃだめなのかと思ったり．あと，ＬＺのパラメータが何でこの数字になっているのかよくわからない．バイト境界になるようにアドレスと長さのビットを割り振って，さらにフラグを８つまとめて置いておくほうが展開が速いと思うのだが...　そこまで速度はいらないのかな．むしろビットストリームのほうがぱっと見で元データがわからないからいいのかも．

どうでもいいけど，何でこの永夜抄のアーカイブに妖々夢のPhantasm出現時に表示される画像データが入っているのだろう？

パソコンで作業中にふと聞こえてきたので．

問題．パソコンのキーで
 'o' と一緒に押すとオープン
 's' と一緒に押すと保存
 'p' と一緒に押すと印刷
なのは？

これの答えは「コントロールキー」らしいのだが...

シフトイン（漢字変換開始）
インクリメンタルサーチ
カーソルを一行上に動かす

じゃないのかと言ってみたり．

昨日から前輪の空気が抜け続けとうとうぺしゃんこになってしまったので，ついでだからとタイヤ・チューブ・ブレーキシューを全とっかえ．前輪がスリックで後輪がブロックな状態に．にしてもブレーキの効きが異様に良くなってしまって危険だ...

なんとなく思いついたのでやってみた．C 言語で書いたプログラムの（ブートストラップ後の）エントリポイントは main 関数なわけだけど，アセンブラレベルでは結局のところ call main して main というラベルにとんでいるだけ．ということは，main は別にC言語の関数ではなく変数でもよい（main というラベルが作られる）．これを実証するコードは以下のとおり．

こいつは HelloWorld を表示するが，main は関数でなく変数である．

#include <stdio.h>
 
int f()
{
	printf("HelloWorld!\n");
	return 0;
}
 
int main[] = {0xB8909090, (int)f, 0x9090E0FF};
 
/*
int main  = 0xB8909090;
int main2 = (int)f;
int main3 = 0x9090E0FF;
 */
/*
struct main {
	int m1;	int m2;	int m3;
} main = {0xB8909090, (int)f, 0x9090E0FF};
 */

main の定義をコメントアウトしている形（構造体，複数個の連続した変数）にしても動く．原理としては main というラベルに飛ばされてくるので，そこに関数本体である f へのジャンプを行うマシン語を埋め込んで f へジャンプさせる．ジャンプのコードはi386で

90             NOP
90             NOP
90             NOP
B8 XXXXXXXX    MOVE EAX, f
FF E0          JMP EAX
90             NOP
90             NOP

とかけるので，これらのマシン後が実行されるように main 変数に値を入れている．

ついでに C++ 版も．

#include <cstdio>
struct main {
	int ins[5];
	static int f() {
		puts("HelloWorld!");
		return 0;
	}
} main = {0xB8909090, (int)(main::f), 0xE0FF};