GTAでTSPをば

ぼくのぬまち 出張版のGTALib で TSP にインスパイアされて既存の generator で片付けるにはどうするかを考えた結果。

辺をn本並べるのを全通り生成して、パスとしてつながっているものだけ残して、更に全ての頂点に訪れているものだけ残して、最後に大小関係を逆転して最大和解を求める。一応、愚直に O(n^n) なものを O(n^4 2^n) に落とせてはいる。

TSPCons.hs

import GTA.Core;
import GTA.Data.ConsList;
import qualified Data.IntSet as IntSet
import System.Environment

-- checks whether a given list of edges is a path or not
isPath = ok <.> foldr' f e where
    ok = maybe False (\_ -> True)
    e = Just Nothing
    f _ Nothing = Nothing
    f ((v,_),_) (Just Nothing) = Just $ Just v
    f ((v,u),_) (Just (Just w)) | u == w = Just $ Just v
                                | True   =  Nothing
-- checks whether a given list of edges is a simple cycle of length n or not
spans n = ok <.> foldr' f e where
    e = IntSet.empty
    f ((v,_), _) x = IntSet.insert v x
    ok x = IntSet.size x == n

-- generates a list of edges from 1 to 1 including non-simple cycles.
genEdgeList n = assignsBy (edges n) [1..n]
edges n m | m == 1 = [(1, k) | k <- [2..n]]
          | m == n = [(k, 1) | k <- [2..n]]
          | True   = [(k, l) | k <- [2..n], l <- [2..n], not (k==l)]

-- TSP solver
tsp dist n = genEdgeList n
             `filterBy` isPath
             `filterBy` spans n
             `aggregateBy` maxsumsolutionWith (revOrd . dist . fst)

-- The answer is 1 -> 2 -> ... -> n -> 1 (and its reverse)
lineardist (m, n) | m == n - 1 = 1
                  | n == m - 1 = 1
                  | m < n = n - m + 1
                  | True  = m - n + 1

main = do a <- getArgs
          let n | length a > 0 = read $ head a
                | True         = 11
          putStrLn $ "n = " ++ show n
          print $ tsp lineardist n

{-
ghc TSPCons.hs -o TSPCons -O2 -rtsopts

time ./TSPCons 11

-}

{- 
-----------
Discussion
-----------

The size of the range of foldr of isPath is n+2.
The size of the range of foldr of spans n is 2^n

Therefore, the size of a table is O(n2^n) .

The number of signs assigned to an element by assignsBy is O(n^2).

The assignsBy updates the table O(n) times.

In total, O(n^4 2^n) algorithm.

This is worse than the well-known DP of TSP by a factor of O(n^2) (perhaps). The reason is that we generate a list of edges so that we can compute the minimum sum by the given aggregator. We might be able to define a new aggregator to avoid this factor. 

-}

ついでに JoinList 版。テーブルマージの計算がテーブルサイズの２乗で効いてくるので O(n^5 4^n) とか。

TSP.hs

-- GTALib >= 0.0.6

import GTA.Core;
import GTA.Data.JoinList;
import qualified Data.IntSet as IntSet
import System.Environment


-- checks whether a given list of edges is a path or not
isPath = ok <.> homJ' times single nil where
    ok = maybe False (\_ -> True)
    nil = Just Nothing
    single (x, _) = Just $ Just x
    times Nothing _ = Nothing
    times _ Nothing = Nothing
    times (Just Nothing) x = x
    times x (Just Nothing) = x
    times (Just (Just (u, v))) (Just ( Just (w, z))) 
        = if v == w then Just $ Just (u, z) 
          else Nothing 

-- checks whether a given list of edges is a simple cycle of length n or not
spans n = ok <.> homJ' times single nil where
    ok x = IntSet.size x == n
    nil = IntSet.empty
    single ((v,_), _) = IntSet.singleton v
    times = IntSet.union

-- generates a list of edges from 1 to 1 including non-simple cycles.
genEdgeList n = assignsBy (edges n) [1..n]
edges n m | m == 1 = [(1, k) | k <- [2..n]]
          | m == n = [(k, 1) | k <- [2..n]]
          | True   = [(k, l) | k <- [2..n], l <- [2..n], not (k==l)]

-- TSP solver
tsp dist n = genEdgeList n
             `filterBy` isPath
             `filterBy` spans n
             `aggregateBy` maxsumsolutionWith (revOrd . dist . fst)

-- The answer is 1 -> 2 -> ... -> n -> 1 (and its reverse)
lineardist (m, n) | m == n - 1 = 1
                  | n == m - 1 = 1
                  | m < n = n - m + 1
                  | True  = m - n + 1


-- TSP solver (parallel version)
tspP dist n = assignsByP (edges n) [1..n]
             `filterBy` isPath
             `filterBy` spans n
             `aggregateBy` maxsumsolutionWith (revOrd . dist . fst)

main = do a <- getArgs
          let n | length a > 0 = read $ head a
                | True         = 11
          putStrLn $ "n = " ++ show n
          print $ tsp lineardist n

{-
ghc -threaded -rtsopts TSP.hs -o TSP -O2

time ./TSP 11 +RTS -N1
time ./TSP 11 +RTS -N2

-}

{- 
-----------
Discussion
-----------

The size of the range of foldr of isPath is n^2+2.
The size of the range of foldr of spans n is 2^n

Therefore, the size of a table is O(n^2 2^n) .

In total, O(n^5 4^n) algorithm?

-}

TSP でやったことを少し抽象化すると、permutation を全生成する generator が手に入る。見た目が O(n!) (=O(n^n)) のものを O(n^2 2^n) に落とす程度の能力。mapMap f はバッグに入っているリストに map f する変換操作。

perms :: [a] -> ConsSemiring a s -> s
perms x = assigns (zip [1..n] x) [1..n] `transformBy` mapMap fst `filterBy` spans n `transformBy` mapMap snd
  where n = length x

spans n = ok <.> foldr' f e where
    e = IntSet.empty
    f (v,_) x = IntSet.insert v x
    ok x = IntSet.size x == n