module Data.PseudoBoolean.ByteStringBuilder
(
opbBuilder
, wboBuilder
, toOPBByteString
, toWBOByteString
, writeOPBFile
, writeWBOFile
, hPutOPB
, hPutWBO
) where
import qualified Prelude
import Prelude hiding (sum)
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import Data.List (sortBy)
import Data.Monoid hiding (Sum (..))
import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Builder (Builder, intDec, integerDec, char7, string7, hPutBuilder, toLazyByteString)
import Data.Ord
import System.IO
import Data.PseudoBoolean.Types
opbBuilder :: Formula -> Builder
opbBuilder opb = (size <> part1 <> part2)
where
nv = pbNumVars opb
nc = pbNumConstraints opb
p = pbProducts opb
np = Set.size p
sp = Prelude.sum [IntSet.size tm | tm <- Set.toList p]
size = string7 "* #variable= " <> intDec nv <> string7 " #constraint= " <> intDec nc
<> (if np >= 1 then string7 " #product= " <> intDec np <> string7 " sizeproduct= " <> intDec sp else mempty)
<> char7 '\n'
part1 =
case pbObjectiveFunction opb of
Nothing -> mempty
Just o -> string7 "min: " <> showSum o <> string7 ";\n"
part2 = mconcat $ map showConstraint (pbConstraints opb)
wboBuilder :: SoftFormula -> Builder
wboBuilder wbo = size <> part1 <> part2
where
nv = wboNumVars wbo
nc = wboNumConstraints wbo
p = wboProducts wbo
np = Set.size p
sp = Prelude.sum [IntSet.size tm | tm <- Set.toList p]
size = string7 "* #variable= " <> intDec nv <> string7 " #constraint= " <> intDec nc
<> (if np >= 1 then string7 " #product= " <> intDec np <> string7 " sizeproduct= " <> intDec sp else mempty)
<> string7 " #soft= " <> intDec (wboNumSoft wbo)
<> char7 '\n'
part1 =
case wboTopCost wbo of
Nothing -> string7 "soft: ;\n"
Just t -> string7 "soft: " <> integerDec t <> string7 ";\n"
part2 = mconcat $ map showSoftConstraint (wboConstraints wbo)
showSum :: Sum -> Builder
showSum = mconcat . map showWeightedTerm
showWeightedTerm :: WeightedTerm -> Builder
showWeightedTerm (c, lits) = foldr (\f g -> f <> char7 ' ' <> g) mempty (x:xs)
where
x = if c >= 0 then char7 '+' <> integerDec c else integerDec c
xs = map showLit $ sortBy (comparing abs) lits
showLit :: Lit -> Builder
showLit lit = if lit > 0 then v else char7 '~' <> v
where
v = char7 'x' <> intDec (abs lit)
showConstraint :: Constraint -> Builder
showConstraint (lhs, op, rhs) =
showSum lhs <> f op <> char7 ' ' <> integerDec rhs <> string7 ";\n"
where
f Eq = char7 '='
f Ge = string7 ">="
showSoftConstraint :: SoftConstraint -> Builder
showSoftConstraint (cost, constr) =
case cost of
Nothing -> showConstraint constr
Just c -> char7 '[' <> integerDec c <> string7 "] " <> showConstraint constr
toOPBByteString :: Formula -> BS.ByteString
toOPBByteString opb = toLazyByteString (opbBuilder opb)
toWBOByteString :: SoftFormula -> BS.ByteString
toWBOByteString wbo = toLazyByteString (wboBuilder wbo)
writeOPBFile :: FilePath -> Formula -> IO ()
writeOPBFile filepath opb = withBinaryFile filepath WriteMode $ \h -> do
hSetBuffering h (BlockBuffering Nothing)
hPutOPB h opb
writeWBOFile :: FilePath -> SoftFormula -> IO ()
writeWBOFile filepath wbo = withBinaryFile filepath WriteMode $ \h -> do
hSetBuffering h (BlockBuffering Nothing)
hPutWBO h wbo
hPutOPB :: Handle -> Formula -> IO ()
hPutOPB h opb = hPutBuilder h (opbBuilder opb)
hPutWBO :: Handle -> SoftFormula -> IO ()
hPutWBO h wbo = hPutBuilder h (wboBuilder wbo)