module ToySolver.Graph.MaxCut
( Problem (..)
, buildDSDPMaxCutGraph
, buildDSDPMaxCutGraph'
, Solution
, eval
, evalEdge
) where
import Data.Array.IArray
import Data.Array.Unboxed
import Data.ByteString.Builder
import Data.ByteString.Builder.Scientific
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Foldable as F
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Monoid
import Data.Scientific (Scientific)
import ToySolver.Graph.Base
type Problem a = EdgeLabeledGraph a
buildDSDPMaxCutGraph :: EdgeLabeledGraph Scientific -> Builder
buildDSDPMaxCutGraph :: EdgeLabeledGraph Scientific -> Builder
buildDSDPMaxCutGraph = (Scientific -> Builder) -> EdgeLabeledGraph Scientific -> Builder
forall a. (a -> Builder) -> EdgeLabeledGraph a -> Builder
buildDSDPMaxCutGraph' Scientific -> Builder
scientificBuilder
buildDSDPMaxCutGraph' :: (a -> Builder) -> EdgeLabeledGraph a -> Builder
buildDSDPMaxCutGraph' :: forall a. (a -> Builder) -> EdgeLabeledGraph a -> Builder
buildDSDPMaxCutGraph' a -> Builder
weightBuilder EdgeLabeledGraph a
prob = Builder
header Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
body
where
(Vertex
lb,Vertex
ub) = EdgeLabeledGraph a -> (Vertex, Vertex)
forall i. Ix i => Array i (IntMap a) -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds EdgeLabeledGraph a
prob
m :: Vertex
m = [Vertex] -> Vertex
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [IntMap a -> Vertex
forall a. IntMap a -> Vertex
IntMap.size IntMap a
m | IntMap a
m <- EdgeLabeledGraph a -> [IntMap a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems EdgeLabeledGraph a
prob]
header :: Builder
header = Vertex -> Builder
intDec (Vertex
ubVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
lbVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Vertex -> Builder
intDec Vertex
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n'
body :: Builder
body = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ do
(Vertex
a,Vertex
b,a
w) <- EdgeLabeledGraph a -> [(Vertex, Vertex, a)]
forall a. EdgeLabeledGraph a -> [Edge a]
graphToUnorderedEdges EdgeLabeledGraph a
prob
Builder -> [Builder]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> [Builder]) -> Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ Vertex -> Builder
intDec (Vertex
aVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
lbVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Vertex -> Builder
intDec (Vertex
bVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
lbVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
weightBuilder a
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n'
type Solution = UArray Int Bool
eval :: Num a => Solution -> Problem a -> a
eval :: forall a. Num a => Solution -> Problem a -> a
eval Solution
sol Problem a
prob = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
w | (Vertex
a,Vertex
b,a
w) <- Problem a -> [(Vertex, Vertex, a)]
forall a. EdgeLabeledGraph a -> [Edge a]
graphToUnorderedEdges Problem a
prob, Solution
sol Solution -> Vertex -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Vertex
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Solution
sol Solution -> Vertex -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Vertex
b]
evalEdge :: Num a => Solution -> (Int,Int,a) -> a
evalEdge :: forall a. Num a => Solution -> (Vertex, Vertex, a) -> a
evalEdge Solution
sol (Vertex
a,Vertex
b,a
w)
| Solution
sol Solution -> Vertex -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Vertex
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Solution
sol Solution -> Vertex -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Vertex
b = a
w
| Bool
otherwise = a
0