-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Graph.MaxCut
-- Copyright   :  (c) Masahiro Sakai 2018
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
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' :: (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
    (Int
lb,Int
ub) = EdgeLabeledGraph a -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds EdgeLabeledGraph a
prob
    m :: Int
m = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [IntMap a -> Int
forall a. IntMap a -> Int
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 = Int -> Builder
intDec (Int
ubInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
<> Int -> Builder
intDec Int
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
      (Int
a,Int
b,a
w) <- EdgeLabeledGraph a -> [(Int, Int, a)]
forall a. EdgeLabeledGraph a -> [(Int, Int, a)]
graphToUnorderedEdges EdgeLabeledGraph a
prob
      Builder -> [Builder]
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> [Builder]) -> Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ Int -> Builder
intDec (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
<> Int -> Builder
intDec (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 :: Solution -> Problem a -> a
eval Solution
sol Problem a
prob = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
w | (Int
a,Int
b,a
w) <- Problem a -> [(Int, Int, a)]
forall a. EdgeLabeledGraph a -> [(Int, Int, a)]
graphToUnorderedEdges Problem a
prob, Solution
sol Solution -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Solution
sol Solution -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
b]

evalEdge :: Num a => Solution -> (Int,Int,a) -> a
evalEdge :: Solution -> (Int, Int, a) -> a
evalEdge Solution
sol (Int
a,Int
b,a
w)
  | Solution
sol Solution -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Solution
sol Solution -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
b = a
w
  | Bool
otherwise = a
0