packages feed

concorde (empty) → 0.1

raw patch · 6 files changed

+308/−0 lines, 6 filesdep +basedep +containersdep +processsetup-changed

Dependencies added: base, containers, process, safe, temporary

Files

+ Algorithms/Concorde/LinKern.hs view
@@ -0,0 +1,116 @@+-- | Approximate a solution to 2D Euclidean TSP using the Lin-Kernighan+-- heuristic.+module Algorithms.Concorde.LinKern+    ( -- * The heuristic+      tsp, R2+      -- * Configuration+    , Config(..), defConfig+    ) where++import Control.Monad+import Control.Exception+import Data.Maybe+import System.Exit+import System.IO+import System.IO.Temp+import Text.Printf+import Safe++import qualified Data.IntMap    as IM+import qualified System.Process as P++errStr :: String -> String+errStr = ("Algorithms.Concorde.LinKern: " ++)++-- | Configuration for @'tsp'@.+data Config = Config+    {  -- | Path to the @linkern@ executable.  Searches @$PATH@ by default.+      executable :: FilePath+      -- | If set, write progress information to standard output.+    , verbose    :: Bool+      -- | Stop looking for better solutions after this many seconds.+    , timeBound  :: Maybe Double+      -- | Run this many optimization steps.  Default is the number of points.+    , steps      :: Maybe Int+      -- | Run this many separate optimizations.  Default is 1.+    , runs       :: Int+      -- | Other command-line arguments to the @linkern@ executable.+    , otherArgs  :: [String]+    } deriving (Eq, Ord, Read, Show)++-- | Default configuration.+defConfig :: Config+defConfig = Config+    { executable = "linkern"+    , verbose    = False+    , timeBound  = Nothing+    , steps      = Nothing+    , runs       = 1+    , otherArgs  = [] }++-- | A point in Euclidean two-dimensional space.+type R2 = (Double, Double)++-- | Approximate a solution to the two-dimensional Euclidean Traveling+-- Salesperson Problem, using the Lin-Kernighan heuristic.+--+-- Invokes Concorde's @linkern@ executable as an external process.+--+-- Note: @linkern@ uses Euclidean distance rounded to the nearest integer.+-- You may need to scale up coordinates in the function passed to @'tsp'@.+tsp+    :: Config     -- ^ Configuration.+    -> (a -> R2)  -- ^ Gives the rectangular coordinates of each point; see below.+    -> [a]        -- ^ List of points to visit.+    -> IO [a]     -- ^ Produces points permuted in tour order.+tsp cfg getCoord xs =+    -- Log to a temp file if not verbose.+    -- On Unix we could open /dev/null, but this is not portable.+    withSystemTempFile "log"    $ \_          logHdl    ->+    withSystemTempFile "coords" $ \coordsPath coordsHdl ->+    withSystemTempFile "tour"   $ \tourPath   tourHdl   -> do++        -- Output coordinates in TSPLIB format+        let pts = IM.fromList $ zip [0..] xs+        mapM_ (hPutStrLn coordsHdl)+            [ "TYPE:TSP"+            , "DIMENSION:" ++ show (IM.size pts)+            , "EDGE_WEIGHT_TYPE:EUC_2D"+            , "NODE_COORD_SECTION" ]+        forM_ (IM.toList pts) $ \(i,p) -> do+            let (x,y) = getCoord p+            hPrintf coordsHdl "%d %f %f\n" i x y+        hPutStrLn coordsHdl "EOF"+        hClose coordsHdl++        -- Invoke linkern+        let optArg flag fmt proj = case proj cfg of+                Nothing -> []+                Just x  -> [flag, printf fmt x]++            allArgs = concat [ ["-o", tourPath]+                             , ["-r", show (runs cfg)]+                             , optArg "-t" "%f" timeBound+                             , optArg "-R" "%d" steps+                             , otherArgs cfg+                             , [coordsPath] ]++            subOut  = if verbose cfg then P.Inherit else P.UseHandle logHdl+            procCfg = (P.proc (executable cfg) allArgs) { P.std_out = subOut }++        (Nothing, Nothing, Nothing, procHdl) <- P.createProcess procCfg+        ec <- P.waitForProcess procHdl+        case ec of+            ExitSuccess   -> return ()+            ExitFailure n -> throwIO . ErrorCall . errStr $+                ("process exited with code " ++ show n ++ extra) where+                    extra | n == 127  = "; program not installed or not in path?"+                          | otherwise = ""++        -- Skip the first line, then read the first int of each remaining+        -- line as an index into the original list of points.+        lns <- lines `fmap` hGetContents tourHdl+        _   <- evaluate (length lns)+        let get = headMay >=> readMay >=> flip IM.lookup pts+            fj  = fromMaybe (error (errStr "internal error in lookup"))+        return $ map (fj . get . words) (drop 1 lns)
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) Keegan McAllister 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,15 @@+This package provides a simple interface to Concorde, a solver for the+Traveling Salesperson Problem.  Concorde is available from:++    http://www.tsp.gatech.edu/concorde/index.html+++Documentation for this package is hosted at:++    http://hackage.haskell.org/package/concorde++To build the documentation yourself, run++    $ cabal configure && cabal haddock --hyperlink-source++This will produce HTML documentation under dist/doc/html/concorde
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/runhaskell++import Distribution.Simple+main = defaultMain
+ concorde.cabal view
@@ -0,0 +1,44 @@+name:                concorde+version:             0.1+license:             BSD3+license-file:        LICENSE+synopsis:            Simple interface to the Concorde solver for the Traveling Salesperson Problem+category:            Algorithms+author:              Keegan McAllister <mcallister.keegan@gmail.com>+maintainer:          Keegan McAllister <mcallister.keegan@gmail.com>+build-type:          Simple+cabal-version:       >=1.6+description:+    This package provides a simple interface to Concorde, a solver for the+    Traveling Salesperson Problem (TSP).  Concorde is available from+    <http://www.tsp.gatech.edu/concorde/index.html>.+    .+    This library uses the Lin–Kernighan heuristic via Concorde's @linkern@+    program.  It quickly produces good tours, which may not be optimal.  You+    can directly control the tradeoff between run time and solution quality.+    .+    An example program is included.+    .+    Currently, only problems in two-dimensional Euclidean space are supported.+    .+    More features of Concorde can be added on request.  Feature requests and+    patches are always welcome.++extra-source-files:+    README+  , examples/visualize.hs++library+  exposed-modules:+      Algorithms.Concorde.LinKern+  ghc-options:      -Wall+  build-depends:+      base       >= 3 && < 5+    , containers >= 0.4+    , temporary  >= 1.1+    , process    >= 1.0+    , safe       >= 0.3++source-repository head+    type:     git+    location: git://github.com/kmcallister/concorde
+ examples/visualize.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE+    DeriveDataTypeable+  , RecordWildCards #-}+module Main(main) where++-- Visualize results of Lin-Kernighan on random points+--+-- deps :  cabal install diagrams cmdargs+-- build:  ghc -O --make visualize.hs+-- usage:  ./visualize -?+++import qualified Algorithms.Concorde.LinKern as T++-- package 'diagrams' and dependencies+import qualified Diagrams.Prelude         as D+import qualified Diagrams.Backend.Cairo   as D+import qualified Data.Colour.SRGB         as D+import qualified Data.Colour.RGBSpace     as D+import qualified Data.Colour.RGBSpace.HSV as D++-- package 'cmdargs'+import qualified System.Console.CmdArgs as Arg+import           System.Console.CmdArgs ( (&=), Typeable, Data )++import Control.Monad+import Data.List+import Data.Monoid+import System.IO+import System.Random+import System.Exit+++data Visualize = Visualize+    { out       :: String+    , numPoints :: Int+    , linkern   :: FilePath+    , verbose   :: Bool+    , timeBound :: Maybe Double+    , steps     :: Maybe Int+    , runs      :: Int }+    deriving (Show, Typeable, Data)++argSpec :: Visualize+argSpec = Visualize+    { out       = "out.pdf" &= Arg.help "Name of output PDF file [out.pdf]"+    , numPoints = 1000      &= Arg.help "Number of points [1000]"+    , linkern   = "linkern" &= Arg.help "Path to linkern executable [search $PATH]"+    , verbose   = False     &= Arg.help "Write progress information to standard output [no]"+    , timeBound = Nothing   &= Arg.help "Stop looking for better solutions after this many seconds [no]"+    , steps     = Nothing   &= Arg.help "Run this many optimization steps [# points]"+    , runs      = 1         &= Arg.help "Run this many separate optimizations [1]" }++    &= Arg.summary "Visualize results of Lin-Kernighan on random points"+++type Diagram = D.Diagram D.Cairo D.R2++diaPoints :: Int -> [T.R2] -> Diagram+diaPoints n = mconcat . map circ . zip [0..] where+    nn = fromIntegral n+    circ (i,p) = D.translate p . D.fc color $ D.circle 40 where+        color = D.uncurryRGB D.sRGB (D.hsv (360*i/nn) 1 1)++diaTour :: [T.R2] -> Diagram+diaTour [] = mempty+diaTour xs@(x:_) = sty . D.fromVertices $ map D.P (xs ++ [x]) where+    sty = D.fc D.lightgrey . D.lw 10++writePDF :: FilePath -> Diagram -> IO ()+writePDF pdfName dia = fst $ D.renderDia D.Cairo opts dia where+    opts = D.CairoOptions pdfName (D.PDF (400,400))+++main :: IO ()+main = do+    Visualize{..} <- Arg.cmdArgs argSpec+    let cfg = T.Config+            { T.executable = linkern+            , T.verbose    = verbose+            , T.timeBound  = timeBound+            , T.steps      = steps+            , T.runs       = runs+            , T.otherArgs  = [] }+        vOut = if verbose then putStrLn else const (return ())++    vOut "[*] Generating points"+    let rnd = randomRIO (0,10000)+    points <- replicateM numPoints (liftM2 (,) rnd rnd)++    vOut "[*] Computing tour"+    tour <- T.tsp cfg id points++    vOut "[*] Checking output"+    when (sort tour /= sort points) $ do+        hPrint    stderr (sort tour, sort points)+        hPutStrLn stderr "ERROR: tour is not a permutation"+        exitFailure++    vOut "[*] Writing PDF"+    writePDF out (diaPoints numPoints tour D.<> diaTour tour)++    vOut "Done!"