Merge 8ab4799 into d4f85bf

.github/workflows/build.yaml

@@ -50,7 +50,7 @@ jobs:
 
       - name: Build
         run: |
-          echo "resolver: ${{ matrix.resolver }}" > stack.yaml
+          sed -i "s/resolver: .*/resolver: ${{ matrix.resolver }}/" stack.yaml
           echo "system-ghc: true" >> stack.yaml
           stack build --test --no-run-tests --bench --no-run-benchmarks ${{ matrix.flags }}
 

CHANGELOG.markdown

@@ -1,3 +1,8 @@
+0.2.0.0
+-------
+* allow parsing maximization problem as specified in
+  https://www.cril.univ-artois.fr/PB24/OPBgeneral.pdf
+
 0.1.11.0
 -------
 * some minor clean-up

pseudo-boolean.cabal

@@ -66,7 +66,8 @@ library
      attoparsec >=0.13.2.2,
      deepseq >=1.4.4.0,
      hashable >=1.2.7.0 && <1.5.0.0,
-     void
+     void,
+     OptDir >= 0.1.0
   hs-source-dirs:      src
   default-language:    Haskell2010
 

src/Data/PseudoBoolean/Attoparsec.hs

@@ -63,7 +63,7 @@ formula = do
     Formula
     { pbObjectiveFunction = obj
     , pbConstraints = cs
-    , pbNumVars = fromMaybe (pbComputeNumVars obj cs) (fmap fst h)
+    , pbNumVars = fromMaybe (pbComputeNumVars (fmap snd obj) cs) (fmap fst h)
     , pbNumConstraints = fromMaybe (length cs) (fmap snd h)
     }
 
@@ -104,14 +104,14 @@ comment_or_constraint :: Parser (Maybe Constraint)
 comment_or_constraint =
   (comment >> return Nothing) <|> (liftM Just constraint)
 
--- <objective>::= "min:" <zeroOrMoreSpace> <sum> ";"
-objective :: Parser Sum
+-- <objective>::= <objective_type> <zeroOrMoreSpace> <sum> ";"
+objective :: Parser Objective
 objective = do
-  _ <- string "min:"
+  dir <- objective_type
   zeroOrMoreSpace
   obj <- sum
   semi
-  return obj
+  return (dir, obj)
 
 -- <constraint>::= <sum> <relational_operator> <zeroOrMoreSpace> <integer> <zeroOrMoreSpace> ";"
 constraint :: Parser Constraint
@@ -151,6 +151,10 @@ unsigned_integer = do
   ds <- takeWhile1 isDigit
   return $! readUnsignedInteger $ BS.unpack ds
 
+-- <objective_type>::= "min:" | "max:"
+objective_type :: Parser OptDir
+objective_type = (string "min:" >> return OptMin) <|> (string "max:" >> return OptMax)
+
 -- <relational_operator>::= ">=" | "="
 relational_operator :: Parser Op
 relational_operator = (string ">=" >> return Ge) <|> (string "=" >> return Eq)

src/Data/PseudoBoolean/Builder.hs

@@ -47,7 +47,11 @@ opbBuilder opb = (size <> part1 <> part2)
     part1 = 
       case pbObjectiveFunction opb of
         Nothing -> mempty
-        Just o -> fromString "min: " <> showSum o <> fromString ";\n"
+        Just (dir, o) ->
+          (case dir of
+            OptMin -> fromString "min"
+            OptMax -> fromString "max")
+          <> fromString ": " <> showSum o <> fromString ";\n"
     part2 = mconcat $ map showConstraint (pbConstraints opb)
 
 -- | A builder which renders a WBO format in any String-like 'Monoid'.

src/Data/PseudoBoolean/ByteStringBuilder.hs

@@ -53,7 +53,11 @@ opbBuilder opb = (size <> part1 <> part2)
     part1 = 
       case pbObjectiveFunction opb of
         Nothing -> mempty
-        Just o -> string7 "min: " <> showSum o <> string7 ";\n"
+        Just (dir, o) ->
+          (case dir of
+            OptMin -> string7 "min"
+            OptMax -> string7 "max")
+          <> string7 ": " <> showSum o <> string7 ";\n"
     part2 = mconcat $ map showConstraint (pbConstraints opb)
 
 -- | A ByteString Builder which renders a WBO format byte-string containing weighted boolean optimization problem.

src/Data/PseudoBoolean/Megaparsec.hs

@@ -80,7 +80,7 @@ formula = do
     Formula
     { pbObjectiveFunction = obj
     , pbConstraints = cs
-    , pbNumVars = fromMaybe (pbComputeNumVars obj cs) (fmap fst h)
+    , pbNumVars = fromMaybe (pbComputeNumVars (fmap snd obj) cs) (fmap fst h)
     , pbNumConstraints = fromMaybe (length cs) (fmap snd h)
     }
 
@@ -121,14 +121,14 @@ comment_or_constraint :: C e s m => m (Maybe Constraint)
 comment_or_constraint =
   (comment >> return Nothing) <|> (liftM Just constraint)
 
--- <objective>::= "min:" <zeroOrMoreSpace> <sum> ";"
-objective :: C e s m => m Sum
+--  <objective>::= <objective_type> <zeroOrMoreSpace> <sum> ";"
+objective :: C e s m => m Objective
 objective = do
-  _ <- string "min:"
+  dir <- objective_type
   zeroOrMoreSpace
   obj <- sum
   semi
-  return obj
+  return (dir, obj)
 
 -- <constraint>::= <sum> <relational_operator> <zeroOrMoreSpace> <integer> <zeroOrMoreSpace> ";"
 constraint :: C e s m => m Constraint
@@ -168,6 +168,10 @@ unsigned_integer = do
   ds <- some digitChar
   return $! readUnsignedInteger (map (toEnum . fromIntegral) ds)
 
+-- <objective_type>::= "min:" | "max:"
+objective_type :: C e s m => m OptDir
+objective_type = (try (string "min:") >> return OptMin) <|> (string "max:" >> return OptMax)
+
 -- <relational_operator>::= ">=" | "="
 relational_operator :: C e s m => m Op
 relational_operator = (string ">=" >> return Ge) <|> (string "=" >> return Eq)

src/Data/PseudoBoolean/Parsec.hs

@@ -62,7 +62,7 @@ formula = do
     Formula
     { pbObjectiveFunction = obj
     , pbConstraints = cs
-    , pbNumVars = fromMaybe (pbComputeNumVars obj cs) (fmap fst h)
+    , pbNumVars = fromMaybe (pbComputeNumVars (fmap snd obj) cs) (fmap fst h)
     , pbNumConstraints = fromMaybe (length cs) (fmap snd h)
     }
 
@@ -103,14 +103,14 @@ comment_or_constraint :: Stream s m Char => ParsecT s u m (Maybe Constraint)
 comment_or_constraint =
   (comment >> return Nothing) <|> (liftM Just constraint)
 
--- <objective>::= "min:" <zeroOrMoreSpace> <sum> ";"
-objective :: Stream s m Char => ParsecT s u m Sum
+-- <objective>::= <objective_type> <zeroOrMoreSpace> <sum> ";"
+objective :: Stream s m Char => ParsecT s u m Objective
 objective = do
-  _ <- string "min:"
+  dir <- objective_type
   zeroOrMoreSpace
   obj <- sum
   semi
-  return obj
+  return (dir, obj)
 
 -- <constraint>::= <sum> <relational_operator> <zeroOrMoreSpace> <integer> <zeroOrMoreSpace> ";"
 constraint :: Stream s m Char => ParsecT s u m Constraint
@@ -150,6 +150,10 @@ unsigned_integer = do
   ds <- many1 digit
   return $! readUnsignedInteger ds
 
+-- <objective_type>::= "min:" | "max:"
+objective_type :: Stream s m Char => ParsecT s u m OptDir
+objective_type = (try (string "min:") >> return OptMin) <|> (string "max:" >> return OptMax)
+
 -- <relational_operator>::= ">=" | "="
 relational_operator :: Stream s m Char => ParsecT s u m Op
 relational_operator = (string ">=" >> return Ge) <|> (string "=" >> return Eq)

src/Data/PseudoBoolean/Types.hs

@@ -21,7 +21,9 @@ module Data.PseudoBoolean.Types
   (
   -- * Abstract Syntax
     Formula (..)
+  , Objective
   , Constraint
+  , OptDir (..)
   , Op (..)
   , SoftFormula (..)
   , SoftConstraint
@@ -43,6 +45,7 @@ import GHC.Generics (Generic)
 import Control.Monad
 import Control.DeepSeq
 import Data.Data
+import Data.OptDir
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.IntSet (IntSet)
@@ -53,7 +56,7 @@ import Data.Maybe
 -- | Pair of /objective function/ and a list of constraints.
 data Formula
   = Formula
-  { pbObjectiveFunction :: Maybe Sum
+  { pbObjectiveFunction :: Maybe Objective
   , pbConstraints :: [Constraint]
   , pbNumVars :: !Int
   , pbNumConstraints :: !Int
@@ -63,6 +66,9 @@ data Formula
 instance NFData Formula
 instance Hashable Formula
 
+-- | Objective type and sum of weighted terms.
+type Objective = (OptDir, Sum)
+
 -- | Lhs, relational operator and rhs.
 type Constraint = (Sum, Op, Integer)
 
@@ -128,7 +134,7 @@ wboComputeNumVars cs = maximum (0 : vs)
 
 pbProducts :: Formula -> Set IntSet
 pbProducts formula = Set.fromList $ do  
-  s <- maybeToList (pbObjectiveFunction formula) ++ [s | (s,_,_) <- pbConstraints formula]
+  s <- maybeToList (fmap snd (pbObjectiveFunction formula)) ++ [s | (s,_,_) <- pbConstraints formula]
   (_, tm)  <- s
   let tm2 = IntSet.fromList tm
   guard $ IntSet.size tm2 > 1

stack.yaml

@@ -39,7 +39,8 @@ packages:
 - '.'
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps:
+- OptDir-0.1.0
 
 # Override default flag values for local packages and extra-deps
 flags: {}

test/TestPBFile.hs

@@ -47,6 +47,8 @@ case_invalid_obj_empty_sum = checkOPBFile "test/samples/invalid-obj-empty-sum.op
 case_invalid_lhs_empty_sum = checkOPBFile "test/samples/invalid-lhs-empty-sum.opb"
 case_invalid_lhs_empty_sum_wbo = checkWBOFile "test/samples/invalid-lhs-empty-sum.wbo"
 
+case_general_testlin_max_file  = checkOPBFile "test/samples/general/testlin-max.pb"
+
 case_trailing_junk = do
   isError (parseOPBString "" trailingJunk) @?= True
   isError (M.parseOPBString "" trailingJunk) @?= True
@@ -305,6 +307,10 @@ checkOPBFile fname = do
   case r of
     Left err -> assertFailure $ show err
     Right opb -> do
+      let s = toOPBString opb
+          bs = toOPBByteString opb
+      BSChar8.unpack bs @?= s
+
       r2 <- M.parseOPBFile fname
       case r2 of
         Left err2 -> assertFailure $ show err2

test/samples/general/testlin-max.pb

@@ -0,0 +1,12 @@
+* #variable= 5 #constraint= 4
+*
+* comments
+*
+* 
+max: 1 x2 -1 x3 ;
+1 x1 +4 x2 -2 x5 >=2;
+-1 x1 +4 x2 -2 x5 >= 3;
+* a big number
+12345678901234567890 x4 +4 x3 >= 10;
+2 x2 +3 x4 +2 x1 +3 x5 = 5 ;
+* the end