Function call expression 参戦記
公私ともにバタバタしていて、blog も twitter も放置していますが、どうにか生きてます。
anarchy golf - Function call expression に関して、youzさんが解説を書けと言ってるので、２位という立場で僭越ながら書いてみる。
２週間前に問題を見て、なんて好みの問題だろうと思い、誰も参加してないけど submit。
こういう処理系ちっくな問題のときはだいたい、Parsec で考えを整理してから実装してる。今回もまずParsec で下書き。
import Text.ParserCombinators.Parsec m @ main = getLine >>= putStrLn . either show id . parse expr "" >> m expr = do f <- char 'f' xs <- many $ do char '(' e <- expr char ')' return e return $ foldl apply [f] xs apply f x = '(' : f ++ ' ' : x ++ ")"
これを Parsec 使わずに書きなおす。Programming in Haskell にもある通り、パーサーは文字列を受け取って、パースした結果と残りの文字列を返せばいい。いろいろ小細工して 98B。
m@main=getLine>>=putStrLn.(!1)>>m (_:'(':a)?b=a!0?('(':b++' ':a!1++")") (_:a)?b=[a,b] a!i=a?"f"!!i
もう少し縮みそうな気がするも、競争相手がいないので放置していたところ、１週間前に notogawaさんが以下のツィート。
「@Lost_dog_ さんが嘆いていたのでFunction call expressionを処理」
そうですか。こちらが身を削って書いたコードを易々と“処理”されたのですね。しかも 91B。7B 差。
悔しさに歯噛みしつつ、アイデアも時間もなくそのまま deadline 当日を迎える。
前夜に GCJ Round1B があり、寝不足の頭と残念な結果をお供に、子供と鉄道博物館へ。
半分諦めていたけど、運転シミュレータに並びながらあれこれ考える。
今の方針で縮めるとしたら getLine と putStrLn で１行ずつ処理してるところくらいだけど、局所最適化してるので、このまま縮めるのは無理だろう。スタックマシンの処理系実装みたいなことをやればもう少しシンプルに書けるのでは？
そんなアイデアをベースに、プラレールに興じる子供の横で、鉄道手帳にメモしながら検討する。文字 'f' が来たらスタックに積む。'(' はたぶん無視しても大丈夫。')' が来たらスタックのトップの２要素を関数適用して "(f x)" みたいな文字列にすればよさそう。さらに '\n' も '(' と同じように無視して、入力をまとめて処理すれば、入力１行に対して解析結果がスタックに１行積み上がるから、反転して出力すれば求める結果が得られるんじゃないか？！
"f(f)(f)" とか "f(f(f))" みたいな入力を当てはめて上手くいきそうだったので、コーディングにとりかかる。といってもＰＣなど持ってないので、携帯からあなごるのサイトにアクセスして、フォームで入力。記号の入力が激しく面倒でした。でもやればできるもんです。コンパイルエラーもなく一発で success ！92B！惜しい。
main=interact$unlines.reverse.foldl(&)[] s&'f'="f":s -- 'f'が来たらスタックに積む (b:a:s)&')'=('(':a++' ':b++")"):s -- ')'が来たらスタックの先頭２要素を関数適用 s&_=s -- 残り（'(', '\n'）は無視
あと 1B をどうすればいいか、残り30分でつらつら考えましたが、時間切れ。
notogawaさんの解を見て納得。'\n' もスタックに積んじゃえば、そのままスタックの文字を結合して答えが出るんだ。
あと、改めて考えると、')' は後置（逆ポーランド）記法の関数適用演算子と捉えられるんですよね。面白いなぁ。
負けたことは悔しいですが、とても楽しい問題でした。infix to postfix も同じように縮まないだろうかと考えたり。
ポケットキューブ（2×2×2キューブ）の最短手数
ルービックキューブを揃えるための最短手数は最大でも20手だそうです。3×3×3を解くには相当なリソースが必要ですが、2×2×2なら何とかなるんじゃないかと思い、プログラムを組んでみました。
結果は↓の通りで最大で11手でした。これくらい誰か既に計算してそうですが、見つかりません。我こそはという方は追試をお願いします。
| 距離 | 数 |
|---|---|
| 0 | 1 |
| 1 | 9 |
| 2 | 54 |
| 3 | 321 |
| 4 | 1847 |
| 5 | 9992 |
| 6 | 50136 |
| 7 | 227536 |
| 8 | 870072 |
| 9 | 1887748 |
| 10 | 623800 |
| 11 | 2644 |
プログラムはこんな感じです。
キューブの状態を表すのに、最初は展開図っぽいデータ構造にしていたのですが、けっこうメモリを食うので、8個のコーナーキューブ（a〜h）がどの場所にあってどっちを向いているかを保持するようにしました。
キューブの向きは厳密には各々24通りありますが、キューブの場所で向きが3通りに限定されるので、0〜2の整数で表現しています。
また左下奥のキューブ（h）を位置、向きとも固定することで、重複を排除しています。鏡像とかは特に考慮していません。
import Data.List (foldl') import Data.Set (Set, singleton, member, insert) data Axis = F | R | U type Move = (Axis, Int) type Cube = [Int] rotate :: Move -> Cube -> Cube rotate move [a,b,c,d,e,f,g,h] = case move of (F,1) -> [c%1,b,g%2,d,a%2,f,e%1,h] (F,2) -> [g,b,e,d,c,f,a,h] (F,3) -> [e%1,b,a%2,d,g%2,f,c%1,h] (R,1) -> [e%2,a%1,c,d,f%1,b%2,g,h] (R,2) -> [f,e,c,d,b,a,g,h] (R,3) -> [b%2,f%1,c,d,a%1,e%2,g,h] (U,1) -> [b,d,a,c,e,f,g,h] (U,2) -> [d,c,b,a,e,f,g,h] (U,3) -> [c,a,d,b,e,f,g,h] where x % i = let d=rem x 3 in x - d + rem(d+i)3 next :: (Set Cube, [Cube]) -> (Set Cube, [Cube]) next (vs0,xs) = foldl' add (vs0,[]) [rotate (a,r) x | x<-xs, a<-[F,R,U], r<-[1..3]] where add (vs,ys) y | member y vs = (vs, ys) | otherwise = (insert y vs, y:ys) ini :: Cube ini = [0,3..21] countAll :: [Int] countAll = takeWhile (/=0) $ map (length.snd) $ iterate next (singleton ini, [ini]) main :: IO () main = print $ countAll
Haskellと確率と限定継続
会社の勉強会で、Haskell による確率プログラミングについて話しました。
元ネタは Oleg さんの論文（Probabilistic Programming）です。OCaml で書かれていたプログラムを Haskell に翻訳しながら解説しました。
もともとの論文の主張は、木探索として定義したモデルを継続渡し方式（Continuation-Passing Style / CPS）にすることで効率化できる、さらに限定継続を利用することで、継続を意識せず直接方式（Direct Style）で書けるようになるというものでした。
木探索から CPS にすることで効率化という流れは Haskell でも同じなのですが、限定継続を利用しても直接方式では書けないため、あまり嬉しくありません。でも Haskell には do 記法があるので、モナドとして定義すれば擬似的に直接方式で書けてハッピーというのが、今回の発表の主旨です。
なにぶん継続初心者が書いていますので、誤りなどあれば指摘いただけると助かります。
ソースコード
ソースコードは github に上げました。まだ使い方がよく分かっていません。
GitHub - rst76/probability: Probability Programming in Haskell
限定継続について
限定継続を学ぶにあたっては、以下の資料がとても分かりやすく参考になりました。また私の発表資料中で、面識もない浅井先生のお名前を勝手に拝借しています。すみません。
継続を使った Printf の型付け
Google Code Jam 2010 - Qualification Round
今年も参加してます。予選だしあまり言うこともないのですが、せっかくなのでコードを晒しときます。
去年のコードと比べると、ゴルフの影響を受けすぎ（悪い意味で）。もうちょっと可読性を大事にする人間だったはずなのですが・・・。
ともあれ Haskell で解けるというのはウレシイ限りです。
A
最初、問題の意味がぜんぜん分かりませんでした（snapper って何だよ！）。分かれば簡単。2 進表記で指定された桁以下が全部 1 かどうか答える。
main=interact$unlines.zipWith(++)["Case #"++shows i": "|i<-[1..]].map(f.map read.words).tail.lines f[n,k]=["OFF","ON"]!!(0^mod(k+1)(2^n))
B
与えられた数列の周期を求めて、0 以上の最小値を答える。これもまぁ簡単。
main=interact$unlines.zipWith(++)["Case #"++shows i": "|i<-[1..]].map(f.map read.words).tail.lines f(_:x:ys)=show$mod(-x)$foldl1 gcd[abs$x-y|y<-ys,y/=x]
C
グループ単位でジェットコースターに乗るのを繰り返すとき、何人乗れるか答える。Small はともかく Large で 10^8*1000 ってフツウにやったら終わらないよなぁ、面倒だなぁとか思いながら書いてみたら、やっぱりものすごく面倒でした。なぜこの問題だけ？
人数のリストが途中から循環するので、循環が始まる点を適当に求めて、それ以前／以後で場合分けして求めてます（6 〜 7 行目の a というやつがそれです）。さすがにこれはもっと簡単に書けるのでは。他の人のコードを読みたい。
import Data.List main = interact $ unlines.zipWith(++)["Case #"++shows i": "|i<-[1..]].f.map(map read.words).tail.lines f([r,k,n]:g:x) = show a : f x where -- 求める人数は循環前の部分の人数＋循環部の人数（完全に一周する分）＋循環部の人数（途中まで辿る分） a | r>d0 = sum g0 + sum g1*((r-d0)`div`d1) + sum(genericTake((r-d0)`mod`d1)g1) | otherwise = sum $ genericTake r g0 -- d0, d1 は g0, g1 の長さ [d0,d1] = map genericLength[g0,g1] -- g0, g1 は人数のリストの、循環前の部分と循環部 [g0,g1] = map(snd.unzip)[g0'',g1''] g1'' = b : takeWhile(/=b)g2'' (g0'',_:g2'') = span(/=b)g'' -- b は循環部に含まれる点。ここから循環部が始まるとする。 b = g''?tail g'' -- リストの循環部に含まれる点を見つける。ウサギとカメのロジック (x:xs)?(y:_:ys) | x==y = x | otherwise = xs?ys -- g'' の要素は一度にコースターに乗れる人数（ID つき） g'' = (0!0)g' -- 一度にコースターに乗れる人数を求めてリストにする。 (s!m)((i,x):y) | s+x>k||m+1>n = (i,s) : (0!0)((i,x):y) | otherwise = (s+x)!(m+1) $ y -- グループのリスト g に ID を振る g' = cycle $ zip[0..]g f _ = []
Haskell(GHC)でのプロファイルのとりかた
いつも忘れて、その度にぐぐってるので、メモ。
コンパイル時に -prof -auto-all オプションをつける
ghc --make -prof -auto-all hoge.hs
実行時に、+RTS -p オプションをつけて、出力される 〜.prof ファイルを読む
./hoge.exe +RTS -p -RTS
特定の式のコストを見たいときは、ソースコード中でコスト集約点を指定（Set Cost Center）する
hoge = {-# SCC "hoge" #-} <expression>
詳しくは、第5章 プロファイルを取る を参照
SPOJ の時間制限が厳しい件について
Lost Dog さんの記事が面白そうだったのと、あなごるのサーバが落ちてて何もできなかったのとで、SPOJ に初挑戦。
https://www.spoj.pl/problems/TRT/
問題は Problem 67 - Project Euler に近いと思います。O(n2) の DP（？）で解きました。
ただ、何も工夫しないと 1s で終わらず TLE になってしまうので、
- インデックスアクセスしてるところはリストから配列に
- 正格評価を使う
- foldl' とか zipWith とか使ってたのをやめてベタに再帰
などで高速化を図りました。
なんとか accept されましたが、もうちょいスマートな解き方がないもんでしょうか？
以下にソースコードを載せておきます。可読性は著しく低いので、ネタバレにはならないかと。
