2014-07-22

KleisliでもArrowしたい。

Control.Arrow
というライブラリがあるのだが、自分に取っては
first, second, (***),(&&&)くらいを使うくらいのユーティリティライブラリでしかなかった。

class Category cat where
    id :: cat a a
    (.) :: cat b c -> cat a b -> cat a c

(>>>) :: Category cat => cat a b -> cat b c -> cat a c
a >>> b = b . a

class Category a => Arrow a where
    arr :: (b -> c) -> a b c
    first :: a b c -> a (b,d) (c,d)
    second :: a b c -> a (d,b) (d,c)
    (***) :: a b c -> a b' c' -> a (b,b') (c,c')
    (&&&) :: a b c -> a b c' -> a b (c,c')

(>>>)は射の合成、first,secondはそれぞれペアの第１要素、第２要素のみを変更する射、
(***)は射の積、(&&&)は一つのソースを二つに分割する射となっている。

最近モナドでfirst, secondを使いたくなるときがあったのでメモ。
具体的には次のようなコードだ

splitBy :: [a] -> Int -> [[a]]
splitBy [] _ = []
splitBy l  n = hd:splitBy tl n where
    (hd,tl) = splitAt n l

これはリーダーモナドを使って次のように書ける。

splitBy :: [a] -> Int -> [[a]]
splitBy [] = return []
splitBy l = do
    (hd,tl) <- flip splitAt l
    tl' <- splitBy tl
    return (hd:tl')

気持ち的には

splitBy l = fmap (uncurry (:)) $ flip splitBy l >>= second splitBy

のような感じで書きたいのだがsecondの型が合わない。
調べてみると

newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
instance Monad m => Arrow (Kleisli m)

というinstanceを見つけたのでこれが使えそう。

splitBy :: [a] -> Int -> [[a]]
splitBy [] = return []
splitBy l = fmap (uncurry (:)) $ flip splitAt l >>= runKleisli (second (Kleisli splitBy))

これで型もあうのだが、>>=の右側がどうにも格好悪い。
他の例も考えてみてよい補助関数を見つけたいところだ。

2014-06-19

ちょまどパズルの下界が8である証明

Intro

問題の発端はこのツイートから

四択の問題が全部で10問あるやつ、解答のパターンは40通りあるって、例のあの顔のカッコいい先輩に教えてもらったし、同期の男の子も40だって言ってたけど、やっぱり納得できないヽ(；▽；)ノ数学苦手ヽ(；▽；)ノどうしても4の10乗じゃないかって思っちゃう
— ちょまど@新卒文系SE見習い (@chomado) 2014, 6月 18

何回で満点とれる？【ちょまど問題に挑む人々】 - Togetterまとめ

問題を形式化すると、

入力として四択問題が10問与えられる。
解答を提出すると正解数がフィードバッグされる。
任意の入力に対して全問正解するまでに必要な最大質問数を最小化せよ。

決定木について

任意の入力パターン全問正解アルゴリズムは次のような決定木だと考えることができる。

各節には提出する解答がラベルされている。
各葉には正解がラベルされている。
各節からのびる枝は解答に対するフィードバッグに応じてどの節に移るかが記されている。
異なる入力が同じ葉にたどり着くことはない。
葉に移る最後の質問は必ず全問正解しなければならない。

２択問題３問に対する決定木の例がこの図である。
f:id:autotaker:20140619125609p:plain
必要な最大質問数はこの決定木の高さに対応している。（この例では４回）

決定木の高さの見積もり

この木の高さを下から抑えることを考える。四択問題10問の場合、入力パターンは全部で ${ 4^{10} = 1048576 }$ 通りあり、葉の数も同数あり、各節から出る枝の数は高々11本なので、
高さ ${h}$ の木に含まれる葉の数は高々 ${11^h}$ で、 ${11^h \geq 4^{10}}$ となる最小の
${h}$ は6なので少なくとも高さは6以上である。また最後の質問は全問正解しなければならないという制約があるので高さが7以上であることもすぐに分かる。

高さが8以上であることを示すにはもう少し踏み込んだ解析が必要である。
いままでの議論は各質問から11通りのフィードバッグがほぼ均等に分布するということを仮定している。しかし、例えば質問をして正解数が10となるのは一通りしかないので、各分岐には大きな偏りがあるはずだ。

まず最初の質問に対してどういう分布をするのかを考えよう。
最初の質問に対してのフィードバッグが ${k}$ であるような入力のパターン数を ${a_k}$ で表すことにすると、
$a_k = {}_{10}C_k 3^{10 - k}$
である。具体的に計算すると
${\displaystyle a_0 = 59049, \\ a_1 = 196830\\ a_2 = 295245\\ a_3 = 262440\\ a_4 = 153090\\ a_5 = 61236\\ a_6 = 17010\\ a_7 = 3240\\ a_8 = 405\\ a_9 = 30\\ a_{10} = 1}$
従って、2問正解する分岐が一番多いことが分かる。
2問正解する分岐に対してその高さを見積もることを考えよう。
今 ${x}$ パターンの入力がその節に分岐すると仮定しよう。
11通りの分岐すべてに均等に分かれるとするとその節の子供のうち分岐するパターンが最も多いものは ${\frac{x}{11}}$ 通りである。しかし、先ほど見たように正解数10に分岐するパターンは高々一つなのでのこり10通りに均等に分かれると考えると ${\frac{x-1}{10}}$ 通りとなる。
同様に考えると分岐するパターンが最も多いものは少なくとも
${\max\{ \frac{x-a_{10} - \dots - a_{10-k+1} }{11-k} | 1 \leq k \leq 10 \}}$
より大きいことが分かる。

この考えで解析していくと
深さiでのノードに分岐するパターン数の最大値は
1048576 -> 295245 -> 45760 -> 6012 -> 698 -> 75 -> 8 -> 1
というような下界を持つ。また、最後パターン数が１になったあとも全問正解するためにもう一回質問が必要になるので少なくとも8回の質問が必要である。

今回の議論もだいぶ粗い解析なのでもうちょっと深く解析すれば下界は改善できるのではないかとおもう。

2014-03-15

10パズルを解いてみた。

数式の列挙問題を考えていてよくある例題として四つの数字と四則演算で１０を作るパズルを考えていた。

Wikipediaによるとこの問題のことを10パズルというらしい。
wikipedia:10パズル

本来やりたかったのは抽象構文木の列挙だったのだが、この問題は逆ポーランド記法を使うと簡単に書けるようだ。
【Ruby】【アルゴリズム】10パズルを解く。全ての数式を逆ポーランドで作る編 - せかいや

この10パズルの問題は大きく分けて３パターンある。一つは自然数の範囲内で解が存在するもの、二つ目は計算過程で有理数が出現してもよいという条件で解が存在するもの、もう一つは有理数を許しても解が存在しないものだ。

HaskellのListモナドを使えばきれいにこれらの制限をパラメータ化できそうなので実際に書いて解析してみた。

gist9562047

ideoneでの実行結果は以下の通り
http://ideone.com/Z9fOnO

1158,1199,1337,3478は自然数の範囲内では解が存在しないが、有理数の範囲では解が存在するという結果だった。それぞれの解は以下の通り
$10 = \frac{8} {1 - \frac{1}{5}}$
$10 = 9 \times (\frac{1}{9} + 1)$
$10 = 3 \times (\frac{7}{3} + 1)$
$10 = 8 \times (3 - \frac{7}{4})$
ちなみに自然数を整数に緩めた（引き算のときに負の数が現れてもよいとする）場合でも結果は変わらない。

電車の広告に難問として載っている物はどうせこれらのうちのいずれかなので覚えておくといいかも。

2014-03-08

■

先日UTPC2013に参加した。
東京大学プログラミングコンテスト2013

問題CでTLEにはまったのでメモ。

問題C概要

２つの連結グラフG_1, G_2が与えられる。
一つの辺を使ってその２つのグラフを連結するときに、連結したグラフの直径の最大値、最小値を求めよ。

制約

それぞれのグラフの頂点数<= 10^3, 辺数<= 10^4

解法

G_1に対して各頂点vから最も遠い頂点までの距離をd_1[v]とする。G_2に対しても同様にd_2[v]とする。
min(d_1) = r1　min(d_2) = r2
max(d_1) = R1　max(d_2) = R2
とする。
連結したグラフの直径の最大値はR1+R2+1、
最小値はmax(R1,R2,r1+r2+1)となる。

実装

d_1,d_2を求めるのには幅優先探索をすればいいのだが
次のようなコードを書いたらTLEした。
http://utpc2013.contest.atcoder.jp/submissions/137893

dist :: Int -> [(Int,Int)] -> UArray Int Int
dist n es = listArray (0,n-1) [ f v | v <- [0..n-1] ]
    where
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (0,n-1) $ es ++ map swap es
    f v = runST $ do
        r <- newArray (0,n-1) False
        go r [v] [] 0 0
    go :: STUArray s Int Bool -> [Int] ->  [Int] -> Int -> Int -> ST s Int
    go _ [] [] d !acc = return acc
    go vis [] ns d !acc = go vis ns [] (d+1) acc
    go vis (v:l) !ns !d !acc = do
        b <- readArray vis v
        if b then
            go vis l ns d acc
        else do
            writeArray vis v True
            let acc' = max acc d
                ns' = g ! v ++ ns
            go vis l ns' d acc'

キューから一つ頂点を取り出し、
その頂点をそれまでに訪れたことがあるかどうかを調べ、
それまでに訪れていなければその頂点に隣接している頂点をキューに追加する。

このコードはすべての辺に対して両方の頂点を一回ずつキューに追加するので
効率が悪い。（高々２倍程度なので通常のコンテストならこのコードでも通るはずだが）

キューから取り出した頂点vに隣接した各頂点uに対して
uをまだ訪れていないならばuをキューに追加する。
というアルゴリズムにすると、キューに追加される頂点数が
グラフの頂点数と等しくなり高速する。
http://utpc2013.contest.atcoder.jp/submissions/140760

dist :: Int -> [(Int,Int)] -> [Int]
dist n es = do
    v <- [0..n-1]
    return $ runST $ do
        r <- newArray (0,n-1) True :: ST s (STUArray s Int Bool)
        unsafeWrite r v False
        go r 1 [v] []
    where
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (0,n-1) $ es ++ map swap es
    go r d [] [] = return (d-1)
    go r d [] !ns = go r (d+1) ns []
    go r d (v:vs) !ns = gosub (unsafeAt g v) ns
        where
        gosub [] !ns = go r d vs ns
        gosub (u:us) !ns = do
            b <- unsafeRead r u
            if b then do
                unsafeWrite r u False
                gosub us (u:ns)
            else
                gosub us ns

同様のアルゴリズムをjavaで実装したところ同程度の実行時間になった。
http://utpc2013.contest.atcoder.jp/submissions/140770

余談

他の人のHaskellコードを見ていたらmkotha氏とcojna氏が400msで動く
非常に速いコードを書いていた。
mkotha氏: http://utpc2013.contest.atcoder.jp/submissions/140275
cojna氏: http://utpc2013.contest.atcoder.jp/submissions/140394
見た感じキューを自作していたり、Unboxed Tuple を使っていたりしていて怖い。