Skip to content

Instantly share code, notes, and snippets.

@dmalikov
Created June 29, 2012 08:53
Show Gist options
  • Save dmalikov/3016738 to your computer and use it in GitHub Desktop.
Save dmalikov/3016738 to your computer and use it in GitHub Desktop.
Karger's MinCut realization
{-# LANGUAGE UnicodeSyntax #-}
module Graph where
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import System.Random (randomRIO)
import qualified Data.IntMap as IntMap
type Graph = IntMap.IntMap [Int]
toGraph ∷ [(Int,[Int])] → Graph
toGraph = IntMap.fromList
edgesNumber ∷ Graph → Int
edgesNumber = (`div` 2) . sum . map length . IntMap.elems
size ∷ Graph → Int
size = length . IntMap.keys
randomEdge ∷ Graph → IO (Int, Int)
randomEdge adjacencyMap = do
v1 ← rndFrom . IntMap.keys $ adjacencyMap
v2 ← rndFrom $ adjacencyMap IntMap.! v1
return (v1,v2)
where rndFrom λ = (λ !!) . subtract 1 <$> randomRIO (1, length λ)
move ∷ Int → Int → Graph → Graph
move v1 v2 α = IntMap.delete v2 . IntMap.adjust (++ (α IntMap.! v2)) v1 $ α
-- | Remove loops and rename v1 to v2
correct ∷ Int → Int → Graph → Graph
correct v1 v2 = IntMap.mapWithKey (\ε → filter (/= ε) . rename)
where rename = map (\x -> if x == v2 then v1 else x)
mergeVertices ∷ Graph → IO Graph
mergeVertices graph = do
(v1,v2) ← randomEdge graph
return . correct v1 v2 $ move v1 v2 graph
untilToM ∷ Monad μ ⇒ (a → Bool) → (a → μ a) → a → μ a
untilToM predicate function value = do
result ← mresult
if predicate result
then mresult
else untilToM predicate function result
where mresult = function value
minCut ∷ Graph → IO Int
minCut γ = minimum <$> replicateM times minCut_
where times = round . (* fromIntegral n) . log $ fromIntegral n
n = size γ
minCut_ = edgesNumber <$> untilToM ((<= 2) . size) mergeVertices γ
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment