Haskellで組合せ最適化(メモ)

SQLで作成したコードに対応するHaskellコードを作成した
あまり、カッコ良く書けていないですが。。。

■巡回セールスマン全探索

import Data.List (maximumBy,minimumBy,permutations)
import Data.Function (on)

-- エッジのデータ型
data Edge = Edge { path :: [Int], name :: String, cost :: Integer } deriving (Show)  

-- 入力データ
nodes = zip [1..] ["Zurich", "London",  "Berlin", "Roma", "Madrid"]
edges = [(Edge [1, 2] "Zurich,London"  476)
        ,(Edge [2, 3] "London,Berlin"  569)
        ,(Edge [3, 1] "Berlin,Zurich"  408)
        ,(Edge [4, 3] "Roma,Berlin"    736)
        ,(Edge [4, 1] "Roma,Zurich"    434)
        ,(Edge [4, 2] "Roma,London"    894)
        ,(Edge [5, 4] "Madrid,Roma"    852)
        ,(Edge [5, 1] "Madrid,Zurich"  774)
        ,(Edge [5, 2] "Madrid,London"  786)
        ,(Edge [5, 3] "Madrid,Berlin"  1154)]

-- 最大・最小
-- minRoot len or maxRoot len
-- minRoot (length nodes) => ([1,3,2,5,4,1],3049)
-- maxRoot (length nodes) => ([1,5,3,4,2,1],4034)
minRoot n = minimumBy (compare `on` snd) (costRoots (enumRoots [1..n])) 
maxRoot n = maximumBy (compare `on` snd) (costRoots (enumRoots [1..n])) 

-- ルート列挙
-- enumRoots [1,2,3] => [[1,2,3,1],[1,3,2,1]]
-- enumRoots [1,2,3,4] => [[1,2,3,4,1],[1,3,2,4,1],[1,3,4,2,1],[1,2,4,3,1],[1,4,2,3,1],[1,4,3,2,1]]
enumRoots (x:xs) = map (\ys -> x:ys ++ [x]) (permutations xs)

-- ラベル付きコスト算出を展開
-- costRoots [[1,2,3,4,1],[1,2,4,3,1]] => [([1,2,3,4,1],2215),([1,2,4,3,1],2514)]
costRoots roots = map costRoot roots

-- ルート(例:[1,2,3,4,1])のラベル付きコスト算出
-- costRoot [1,2,3,4,1] => ([1,2,3,4,1],2215)
costRoot rt = (rt, sumRoot rt)

-- アトム化したルート(例:[[1,2],[2,3][3,4][4,1]])のコスト算出
-- sumRoot [1,2,3,4,1] => 2215
sumRoot rt = foldl (\acc pt -> acc + (atomCost pt)) 0 (atomRoot rt)

--パス(例:[2,3])のコスト算出
-- atomCost [2,3] => 569
atomCost pt = cost (findEdge pt)

-- パスからエッジを取得
-- formalPath [3, 2] => [2, 3]
-- formalPath [2, 3] => [2, 3]
-- findEdge [2,3] => Edge {path = [2,3], name = "London,Berlin", cost = 569}
formalPath [a, b] = if a < b then [a, b] else [b, a]
findEdge pt = head (filter (\e -> formalPath (path e) == formalPath pt) edges)

-- ルート(例:[1,2,3,1])をパス(例:[1,2])に分解
-- atomRoot [1,2,3,1] => [[1,2],[2,3],[3,1]]
atomRoot (a:b:as) = [a,b] : atomRoot (b:as)
atomRoot as = []