Edited at

最短経路問題をCofree+Nexus構成で解く

※ この記事には根本的な謝りがあります.(本人記)


最短経路問題

タイムラインにでてきたやつです.

よくある問題ですね.

ダイクストラで解くのが定番だと思いますが,最近CofreeでNexus構成するのがマイブームなのと問題のネットワークもたまたま二分木で表現できる範囲だし,今回はその方向で解いてみました.


実装

直近で書いた累積百ます計算,パスカルの三角形,関・ベルヌーイ数を計算するとあんまり変わりません.

ここでTreeの枝に重みを持たせるように双関手TreeFを台関手として定義します.


ShortestPathSearch.hs

-- | Tree

data TreeF a x = Tip a | Bin (a, x) (a, x) deriving Show
type Tree a = Fix (TreeF a)

tip :: a -> Tree a
tip = In . Tip

bin :: (a, Tree a) -> (a, Tree a) -> Tree a
bin (x, l) (y, r) = In (Bin (x, l) (y, r))

tip' :: a -> Cofree (TreeF a) a
tip' n = Cf (In (Hisx (n, Tip n)))

bin' :: (Ord a, Num a) => ((a, Cofree (TreeF a) a), (a, Cofree (TreeF a) a)) -> Cofree (TreeF a) a
bin' ((x, l), (y, r)) = Cf (In (Hisx (min (extract l + x) (extract r + y), Bin (x, unCf l) (y, unCf r))))


今回の二分木型もやはりTreeFの不動点として定義されます.

ポイントはbin'の実装でアノテーションしている部分です.

ここで各枝にアノテーションされている値に枝の重み(経路のコスト)を足したもののうち小さい方をアノテーションしています.

あとはShow,Bifunctor,Functor,ApplicativeBifunctorのインスタンスにしておきます.


ShortestPathSearch.hs

instance Show a => Show (Tree a) where

show (In (Tip x)) = "Tip " ++ show x
show (In (Bin (x, l) (y, r))) = "Bin ((" ++ show x ++ "," ++ show l ++ "),(" ++ show y ++ "," ++ show r ++ "))"

instance Bifunctor TreeF where
bimap (f, g) (Tip x) = Tip (f x)
bimap (f, g) (Bin (x, l) (y, r)) = Bin (f x, g l) (f y, g r)

instance Functor (TreeF a) where
fmap f = bimap (id, f)

instance ApplicativeBifunctor TreeF where
biap (Tip f) (Tip x) = Tip (f x)
biap (Bin (f, g) (j, k)) (Bin (x, l) (y, r)) = Bin (f x, g l) (j y, k r)


これでグラフを構成すればOK.

Aをスタート地点Iをゴール地点として構成しています.

構成するとアノテーションも同時に1おこなわれるのでnodeIを構成しおえたら,extractで取り出すことで最短路のコストが得られます.

ちょっとnode0やnodeInfで端のところをケアしています.


ShortestPathSearch.hs

node0 = tip' 0

nodeInf = tip' (1/0)

nodeA = bin' ((0, node0), (0, node0))
nodeB = bin' ((0, nodeInf), (2, nodeA))
nodeC = bin' ((7, nodeA), (0, nodeInf))
nodeD = bin' ((0, nodeInf), (8, nodeB))
nodeE = bin' ((1, nodeB), (2, nodeC))
nodeF = bin' ((3, nodeC), (0, nodeInf))
nodeG = bin' ((15, nodeD), (9, nodeE))
nodeH = bin' ((12, nodeE), (3, nodeF))
nodeI = bin' ((4, nodeG), (2, nodeH))

main = print $ extract nodeI


もはやアルゴリズムとかどっかに消し飛んでしまってて面白いんじゃないかなーと思いました.

もちろんこれ累積百ます計算,パスカルの三角形,関・ベルヌーイ数を計算すると同様に高速だと思います.

結果は15になりました.

λ> main

15.0
λ>

おしまい.


追記. これ今頃気付いたけど全く最短路を計算することにはなってないな...ガッカリ.(2019/06/27)





  1. 実際にはLazyなので構成と共にアノテーションされるというのはウソでextractした瞬間に計算が進むんだと思いますがそういうことは気にしない.