WHY SO FAST

RandomizedContraction.hs

{-# LANGUAGE UnicodeSyntax #-}
module Main where

import Control.Monad (replicateM)
import Data.Functor ((<$>))
import Data.IntMap (IntMap, (!))
import Data.Maybe (fromJust)
import System.Environment (getArgs)
import System.Random (randomRIO)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as BS

type Graph = IntMap [Int]

main ∷ IO ()
main = getArgs >>= mapM_ processFile

processFile ∷ FilePath → IO ()
processFile fp =
  do ns ← parseFile fp
     let n = fromIntegral $ IM.size ns
         tries = round $ logBase 10 n * n
     m ← minimum <$> replicateM tries (minCut ns)
     print m

parseFile ∷ FilePath → IO Graph
parseFile fp = IM.fromList . zip [1..] . map parseLine . BS.lines <$> BS.readFile fp
 where
  parseLine = map (fst . fromJust . BS.readInt) . BS.words

minCut ∷ Graph → IO Int
minCut xs =
  case take 3 $ IM.elems xs of
    [x,_] → return $ length x
    _     → randomEdge xs >>= minCut . shrink xs

randomEdge ∷ Graph → IO (Int, Int)
randomEdge g =
  do a ← (IM.keys g !!) <$> randomRIO (0, IM.size g - 1)
     b ← ((g ! a) !!) <$> randomRIO (0, length (g ! a) - 1)
     return (a, b)

shrink ∷ Graph → (Int, Int) → Graph
shrink xs (m,n) = IM.map replace $ IM.insert n ns $ IM.delete m xs
 where
  ns = filter (/= m) . filter (/= n) $ (xs ! n) ++ (xs ! m)
  replace = map (\x → if x == m then n else x)

% time ./Main kargerAdj.txt
3
./Main kargerAdj.txt 0.05s user 0.01s system 93% cpu 0.060 total