2005年11月

正式リリース版が出たので試してみる．1.0.7 の profile をそのまま使うのは危険そうなので新たに profile 作って移行作業．とりあえず前と変わらぬ使い心地になった．何が新しく変わったのかは実感できてなかったりするけど．今のところエラー時にポップアップウィンドウでなくエラーページ表示になったのくらいか？　これはエラーからの復帰がしやすくなって結構ありがたい．

http://acm.uva.es/problemset/">UVa Online Judge で C++ 使ってて C の read 関数を使おうとしたら

#include <unistd.h>

が抜けててコンパイルエラーを食らった．fread は stdio.h にあるのに read は unistd.h なのね．手元の g++ では unistd.h を明示的に読まずにコンパイルできてしまう点が痛い...

BulletMLでそれなりに多くの弾幕がかけるわけだけど，ループ（リピート）のカウンタ値が取れなかったり if がなかったりとややこしいことをしようと思うと少々困る．ループカウンタがないのは再帰を使えば何とかなるが，この場合終了条件での分岐が出来ない．n 回再帰したら終了みたいなコードをかけないと，フラクタル的な弾幕がうまくかけないので困る．ということで，少々アホな知恵を絞り，ある弾の生存期間を再帰関数の再帰期間とするようにする．具体的には，ある弾の action で action を再帰させ，再帰を終了したいときには changeSpeed の speed 設定で弾の速度をとても大きくし，フレームアウトさせて弾の処理をとめてやる．カウンタパラメータ $1 が 0 のときに再帰をとめるには，speed に 0.001/($1+0.0000001) とでも書いておけばいいと．

とりあえず，この仕組みを使ってパーフェクトフリーズもどきを再帰で書いてみた．アホだ...

scan の実装を縦横順番にやらずブロックで同時に通信・計算するようにしたらだいぶ速くなった．予想通りの出来でよいかもしれない．

風でふらふらしつつ，テレビ朝日のテスト・ザ・ネイションの問題を解いてみた．どうやら苦手な問題は順番の記憶らしく，文字の順番記憶も顔の順番記憶もダメダメ．記憶力無いかも...　あと，文節を並べ替えて質問文を作って答えるのと一文字抜けてる共通のひらがなを見つけるのもよろしくない．空間認識とか計算とか右手か左手かとかは簡単なのだが...

結果として，11/10/15/12/8/10 という得点で，合計 66 点．右右の物志向でiQ121と．適職：画家、作曲家、陶芸家、写真家、スポーツ選手、イラストレーター、ダンサー．私研究者というかエンジニアになりたいんすけど...　自分の理論にのっとって物を作るという点で同じだからいいか．とりあえず年賀状の絵でも描こうかしら？

いい加減まともな本棚を買ってこないと本の塔が倒れて大変なことになりそう．ただいま３４冊のたわー．どっかに安いけど頑丈な本棚は無いものだろうか？　ま，いいや．MD5破りでも勉強しよう．

殆どのビットが０だけど展開式を満たす disturbance vector を用意して衝突しやすい状況を用意して探索空間を小さくすると．うーむ，やってることはわからないでもないけどここまでがんばらないとだめなのか．SHA-0 や MD5 から調べたほうがわかりやすそうだ．

ようやくADSLの回線切り替えが行われたらしい．少々基地局から離れているためSUQは使えないらしく G.dmt Annex I でリンク中．下りが二倍になって19Mbps弱になっただけで，のぼりは相変わらず 1Mbps のまま．ま，こんなもんでしょう．もう少し早くなってくれるとうれしかったのだが...

昨日の輪講でしゃべったせいでのどがまたやられたらしい．今日もおとなしく寝ていないとやばそうな気配．いい加減実装をしないとなぁ．

回線自体はまだ切り替わっていないが，モデムのほうは新しいのがきた．とりあえずモデム変えただけで１割ほど下りが速くなったり．VoIP もうまく動いているようで何より（あんまり使わんような...）．後は木曜日の回線切り替えでどれだけ速度が出るようになるかが気になるところ．１０Mぐらいは出てくれるかなぁと期待してみよう．

のどの粘膜は１日寝てれば治るもんだなぁと感心．その代わり右目が変にいたいのだけど...　とりあえず明日の発表資料を作りましょう．気が向いたら英語で書くか...　その前に式をつめて実装しないとならんけど．

どうでもいいけど YU-NO の原版どこやったっけ？

完全にのどがやられたようで腫れとる...　自転車での全力疾走が悪かったのだろうか？　とりあえず今日はおとなしく寝続けるとしよう．それにしてもラヂヲはあの短さで終わるのだろうか？

毒を食らわば皿まで...　6th & 7th City を通販にてゲット．ちぃと高いよ？　ま，SHA-1 の Collision search attack を理解したら見るとしよう．

受信できるデバイスが身の回りに皆無だなぁと初めて認識した．コンポやらラジカセがあれば受信できそうなものだがMP3プレーヤとスピーカで置換されてるし，MP3プレーヤもノイズとかの問題かＦＭしか受信できないし．明日の夜は需要があるので非常時にも役に立つと信じてラジオを購入．意外と高し．１００円ショップとか行けば安く手に入ったのだろうか...？

ながながとICPC2005 Regional, Tokyo の問題Fを Haskell で．O(n^2) の DP で, 基本的に foldl の２重ネストと．Cで書いた場合と比べて for 文の代わりに foldl になっているだけの違いしかない...

 -- Problem F in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04  O(n^2) DP
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.show.solve)
 
getProblems = 
    do
    [n] <- getNums
    if n==0 then return []
       else do
            xs <- getNums
            b <- liftM (head.map read.words) getLine :: IO(Double)
            [sr,sv,se,sf] <- liftM words getLine
            liftM ((xs, b, read sr, read sv::Double, read se::Double, read sf::Double):) getProblems
    where 
    getNums = liftM (map read.words) getLine :: IO([Int])
 
solve :: ([Int], Double, Int, Double, Double, Double) -> Double
solve (ys,b,r,v,e,f) = sl ys [(0.0,0)] 
    where
    -- xs:rest of checkpoints, cs:best cost for already passed checkpoints 
    sl [] cs = fst $ head cs
    sl (x:xs) cs = sl xs (best x cs:cs)
    -- (best cost, current cost, current point)
    best x cs = (\(bc,c,p) -> (min bc (c + cost (x-p) x),x)) $ foldl op (100000000, 0, x) cs
      where 
      op (cbc, c, p) (bc, pos) = let
                                 c' = c + cost (x-p) (x-pos)
                                 in (min cbc (c'+b+bc), c', pos)
    cost p q = ct p 0.0
      where 
      ct p c = if p == q then c
               else ct (p+1) (c+step p)
      step p = if p < r then 1.0 / (v-f*fromIntegral(r-p))
               else  1.0 / (v-e*fromIntegral(p-r))

Aspell の英語辞書から単語を抜き出して全探索してみた．登録されている単語数は 141891 らしい．んで，１文字の単語を抜いてさかさまにしても単語があったのは 381 個．うち palindrome になっているものが 112 個．自身にもどらずほかの単語になるのが 269 個．さらに長さが４以上であるものは 137 個（これらの結果は複数形の s や動詞の変化をはじいていない）

よく知った単語の例:

emit ⇔ time

evil ⇔ live

flow ⇔ wolf

keep ⇔ peek

loop ⇔ pool

part ⇔ trap

プログラムと結果

なぜか D を飛ばしてICPC2005 Regional, Tokyo の問題Eを Haskell で．全生成して条件で filter して max とるという非常に美しい形に...

 -- Problem E in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04   Brute Force (42 * 2^5)
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.(\r -> if r < 0 then "-1" else show r).solve)
 
getProblems = 
    do
    n <- liftM (head.map read.words) getLine
    replicateM n getProblem
 
getProblem =
    do
    r <- getNum
    s <- liftM (head.map read.words) getLine
    ws <- replicateM s getNum
    return (r, ws)
    where 
    getNum = liftM (head.map read.words) getLine :: IO(Double)
 
solve :: (Double, [Double])->Double
solve (r, ws) = foldl max (-1.0).filter (<r).map(\(lw, rw)->lw+rw).concat.map genWidth.concat.map genTree.perm $ ws
 
data BTree a = Node a (BTree a) (BTree a)
             | Leaf a
genTree ] = [Leaf
genTree xs = [ Node (weight t + weight u) t u | i <- [1..length xs-1], t<-genTree (take i xs), u<-genTree (drop i xs)]
weight (Leaf x) = x
weight (Node x _ _) = x
genWidth (Leaf x) = [(0.0,0.0)]
genWidth (Node _ l r) = let
                        ls = genWidth l
                        rs = genWidth r
                        lw = weight l
                        rw = weight r
                        la = lw/(lw + rw)
                        ra = 1-la
                        in [x | (ll,lr)<-ls, (rl,rr)<-rs, x<-gen ll lr rl rr la ra]
gen ll lr rl rr la ra = dupFlip (max (la + ll) (rl-ra), max (ra + rr) (lr-la))
dupFlip (x,y) = [(x,y), (y,x)]
perm [] = []
perm ] = [[]
perm (x:xs) = [ take i y ++ (x:drop i y) | y <- perm xs, i <- [1..length xs]]

引き続きICPC2005 Regional, Tokyo の問題Cを Haskell で．サイコロの全パタン生成が一番面倒かも．全盛生後の比較の高速化のために色名を数字に置き換える部分は少々手抜きかも．

 -- Problem C in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04   Brute Force (24^3)
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.show.solve)
 
getProblems = 
    do
    [n] <- getNums
    if n==0 then return []
       else do
            xs <- replicateM n getEntry
            liftM (xs:) getProblems
    where 
    getEntry = liftM words getLine
    getNums = liftM (map read.words) getLine
 
solve::[[String]]->Int
solve [d] = 0
solve ds = let 
           tab = zip (nub.sort.concat $ ds) [1..]
           rep x = case (lookup x tab) of Just i -> i
           ds' = map (map rep) ds
           in foldl1 min.map cost.map (head ds':).prod.map genAll.tail $ ds'
cost = sum . map cost'. trans
cost' xs = length xs - longest (sort xs)
longest (h:ts) = foldl1 max.map snd $ scanl (\(x, c) y -> if y == x then (x, c+1) else (y, 1)) (h,1) ts
trans s] = map (\x -> [) xs
trans (xs:xss) = zipWith (:) xs $ trans xss
prod s] = map (\x->[) xs
prod (xs:xss) = concat.map (\x -> map (x:) (prod xss)) $ xs
 -- generate all dice equivalent to the die by rotation
genAll = concat . map rots2 . rots1
 -- rotations around an axis (the front surface is fixed)
rots2 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
                             [x1,x3,x5,x2,x4,x6],
                             [x1,x5,x4,x3,x2,x6],
                             [x1,x4,x2,x5,x3,x6]]
 -- rotations to move each surface to the front
rots1 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
                             [x2,x6,x3,x4,x1,x5],
                             [x3,x2,x6,x1,x5,x4],
                             [x4,x2,x1,x6,x5,x3],
                             [x5,x1,x3,x4,x6,x2],
                             [x6,x5,x3,x4,x2,x1]]

Haskell で forall A. A -> A 系の型を作ってみる．まずもっとも単純に．

let x = x

t を型変数として x :: t で，undef 以外の何者でもない気がする．

んで，次．

let f x = x

これで f :: t->t . id 関数なような．

続いて

let y f = f (y f)

これで y :: (t->t)->t . fixpoint 関数とうか Y コンビネータなような．

ついでに，

let g y z = if True then y else z

とすると g :: t->t->t になる．意味のある関数ではないが...　さて，これ以降はどうなるのだろうか？

ついでなので，forall a,b,... . a -> b -> ... も作ろうとすると

let f x y = f x y

とかで引数の数を増やせばいくらでもいける．意味はないけど．意味のあるものってどれくらいあるんだろう？ undef, id, fixpoint 以外に意味のあるのがあるか？

live を逆さまにすると evil だなぁ．逆さまになる英単語って意識したことなかったので新鮮な感じだ．

ICPC2005 Regional, Tokyo の問題Ｂを Haskell で．queue を使ったシミュレーションだけど面倒だから一ターンごとにリスト生成...

 -- Problem B in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04     Brute Force
import Control.Monad
import Debug.Trace
main = getProblems >>= mapM_ (putStrLn.show.solve)
  
getProblems = 
    do
    [m, c, n] <- getNums
    if (n==0 && m==0 && c==0) then return []
       else do
            xs <- replicateM n getEntry
            liftM ((m,c,n,xs):) getProblems
    where 
    getEntry = getNums >> getNums
    getNums = liftM (map read.words) getLine
  
 -- it's better to make each entry of ds the pair of it and its length 
solve (m,c,n,xs) = sl xs 0 (take m $ repeat [])
    where
    sl [] t _ = t
    sl ys t ds = let
                 (hs, ys') = unzip $ map (\x->(head x, tail x)) ys
                 (t', ds') = sl' ds hs
                 in sl (filter (not.(==[])) ys') (t'+t) ds'
    sl' ds = foldl searchOne (0,ds)
    searchOne (t, ds) x = let 
                          p = length $ takeWhile (not.or.map (==x)) ds 
                          ds' =if p<m then take p ds++[filter (not.(==x)) (ds!!p)]++drop (p+1) ds
                               else ds  
                          in insertOne (t+p+1) ds' x
    insertOne t ds x =
        if length (head ds) < c then (t+1, (x:head ds):tail ds)
        else let
             p = length $ takeWhile ((==c).length) ds 
             ds' = if p<m then take p ds++[x:(ds!!p)]++drop (p+1) ds
                   else ds
             p' = length $ takeWhile ((==c).length) ds'
             hds = head ds
             tds = tail ds
             q = p'-1
             tds' =if p'<m then take q tds++[last hds:(tds!!q)]++drop (q+1) tds
                   else tds
             in (t+p+p'+p+5, (x:init hds):tds')

Microsoft から来たメールによると，どうやら theSpokeアカウント を使わずに「Visual Studio 2005 Professional」を手に入れられるようになるらしい．いろいろと文句や問い合わせが行った結果なのかどうかしらんけどありがたいかも．

ASCII24の記事によると『Visual Studio .NET the Spoke Premium 2003』を購入、登録した学生を対象に『Visual Studio 2005 Professional Edition』を追加費用なしでダウンロード提供してくれるらしい．詳しい情報を得ようとだいぶ前に登録したきりの"the Spoke”のサイトへ行ってみるが...　３ヶ月間ログインしないと登録が抹消されますって言われて登録消えているらしい orz．　もう一回登録しなおしてもいいものなのかどうか...

終クロ６上巻６００ページ弱，下巻６００ページ超え．なんだかもう記録に挑戦？　同時に買ったシャナの５冊分って...　とりあえず７巻の１２５０円が何ページになるか楽しみだ，と．(つーか，文庫本のカバーがかかるのだろうか？)

Pitts の論文でも読むか．

ICPCをHaskellでやろうとすると入出力はこんな感じだろうか？　とりあえずメインルーチンはデータセットのリストを getProblems で生成し，mapM_ で各データセットに対して solve で解いた結果を putStrLn.show で出力と．

main = getProblems >>= mapM_ (putStrLn.show.solve)

getProblems に関して．各入力セットの先頭の数字が終了フラグになるタイプは，終了なら [] をリターン，そうでなければデータをタプルにして cons をリフトする．

main = getProblems >>= mapM_ (putStrLn.show.solve)
getProblems = 
    do
    [n] <- getNums
    if n==0 then return []
       else do
            xs <- replicateM n getEntry
            liftM (xs:) getProblems
    where 
    getEntry = liftM words getLine
    getNums = liftM (map read.words) getLine
 

入力の最初にデータセットの数がある場合は replicateM でリストにすると．

main = getProblems >>= mapM_ (putStrLn.show.solve)
getProblems = 
    do
    n <- liftM (head.map read.words) getLine
    replicateM n getProblem
getProblem =
    do
    r <- getNum
    s <- liftM (head.map read.words) getLine
    ws <- replicateM s getNum
    return (r, ws)
    where 
    getNum = liftM (head.map read.words) getLine :: IO(Double)

あとは EOF で終了という不親切な場合もあるが...　面倒なのでやめとこう．各データセット内の値の取得は，replicateM と liftM (map read.words) getLine と叫べば大体は入力できそう．面倒なのは read の型を明示しとかないとこける可能性があることだろう．

売れているのか売れていない（少ない）のかよくわからない上にいろいろと酷評を受けているみたいで．なぜかアマゾンで予約してあって今日届いてたりするのだが，今更なぜ注文したのか疑問に思ったり．ま，いいか．

一人でやるとしたら簡単なほうから５問は確実に行くだろうけど...　残りの問題はコーディングが面倒な感じかと思われる．間違っても Haskell では書きたくない．ProblemA でさえHaskell だと面倒だ（インデックス使えんので）．

import Control.Monad
main = getProblems >>= mapM_ (putStrLn.show.cnt)
getProblems = do
              n <- liftM read getLine
              if n==0 then return [] else liftM (n:) getProblems
 
primes = let p (x:xs) = x:p (filter (\y -> not (mod y x ==0)) xs) in p [2..]
cnt n = cn primes primes 0 0
 where
 cn ps qs sum c = 
     if sum >= n then cn (tail ps) qs (sum-head ps) (c+if sum==n then 1 else 0)
     else (if n < head qs then c
           else cn ps (tail qs) (sum+head qs) c)

素数の生成はエレガントに書けるけど入出力がうざい．ところで Y コンビネータのラムダ式ってどうだっけ？　olymorphic lambda calculus もよくわからん...　free theorem の根拠が...

同じ東京都内だけど移動がめんどうだ...　横浜線の本数が少ないなぁとか感じた今日この頃．とりあえずJavaチャレンジが面白くない競技になっているような...　会津のヘビのほうが見てて楽しかったのになぁ．

頭痛し．明日からお出かけできるのだろうか...

いつの間にやら１１月になっている．そして shortcut fusion の正当性が良くわからなかったり．