msakai / pseudo-boolean / 130

Committed 05 Apr 2025 01:53AM UTC coverage: 91.833% (-0.8%) from 92.655%

Build # 130

Build Type

push

github

Committed by

web-flow

Commit Message

Merge 0fcff3bfe into 81e38085d

Run Details

18 of 24 new or added lines in 2 files covered. (75.0%)

2 existing lines in 2 files now uncovered.

506 of 551 relevant lines covered (91.83%)

0.92 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

85.48

/src/Data/PseudoBoolean/Builder.hs

{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.PseudoBoolean.Builder
-- Copyright   :  (c) Masahiro Sakai 2011-2015
-- License     :  BSD-style
-- 
-- Maintainer  :  masahiro.sakai@gmail.com
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Data.PseudoBoolean.Builder
  (
  -- * Builder for String-like Monoid
    opbBuilder
  , wboBuilder

  -- * String generation
  , toOPBString
  , toWBOString
  ) where

import qualified Prelude
import Prelude hiding (sum)
import qualified Data.DList as DList
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import Data.List (sortBy)
import Data.Maybe (maybeToList)
import Data.Monoid hiding (Sum (..))
import Data.Ord
import Data.String
import Math.NumberTheory.Logarithms (integerLog2)
import Text.Printf
import Data.PseudoBoolean.Types

-- | A builder which renders a OPB format in any String-like 'Monoid'.
opbBuilder :: (Monoid a, IsString a) => Formula -> a
opbBuilder opb = (size <> part1 <> part2)
  where
    nv = pbNumVars opb
    nc = pbNumConstraints opb
    neq = length [() | (_lhs, Eq, _rhs) <- pbConstraints opb]
    intsize = maximum $ 0 :
      [ if tmp == 0 then 0 else 1 + integerLog2 tmp
      | (ts, d) <- [(ts, 0) | ts <- maybeToList (pbObjectiveFunction opb)] ++ [(lhs,rhs) | (lhs,_op,rhs) <- pbConstraints opb]
      , let tmp = abs d + Prelude.sum [abs c | (c,_) <- ts]
      ]
    p = pbProducts opb
    np = Set.size p
    sp = Prelude.sum [IntSet.size tm | tm <- Set.toList p]
    size = fromString (printf "* #variable= %d #constraint= %d #equal= %d intsize= %d" nv nc neq intsize)
         <> (if np >= 1 then fromString (printf " #product= %d sizeproduct= %d" np sp) else mempty)
         <> fromString "\n"
    part1 = 
      case pbObjectiveFunction opb of
        Nothing -> mempty
        Just o -> fromString "min: " <> showSum o <> fromString ";\n"
    part2 = mconcat $ map showConstraint (pbConstraints opb)

-- | A builder which renders a WBO format in any String-like 'Monoid'.
wboBuilder :: (Monoid a, IsString a) => SoftFormula -> a
wboBuilder wbo = size <> part1 <> part2
  where
    nv = wboNumVars wbo
    nc = wboNumConstraints wbo
    neq = length [() | (_, (_lhs, Eq, _rhs)) <- wboConstraints wbo]
    p = wboProducts wbo
    np = Set.size p
    sp = Prelude.sum [IntSet.size tm | tm <- Set.toList p]
    mincost =
      case [c | (Just c, _) <- wboConstraints wbo] of
        [] -> 1 -- this should not happen
        cs -> minimum cs
    maxcost = maximum $ 0 : [c | (Just c, _) <- wboConstraints wbo]
    sumcost = Prelude.sum [c | (Just c, _) <- wboConstraints wbo]
    intsize = maximum $ 0 :
      [ if tmp == 0 then 0 else 1 + integerLog2 tmp
      | (cs, d) <- ([sumcost], 0) : [(map fst lhs, rhs) | (_,(lhs,_op,rhs)) <- wboConstraints wbo]
      , let tmp = abs d + Prelude.sum [abs c | c <- cs]
      ]
    size = fromString (printf "* #variable= %d #constraint= %d #equal= %d intsize= %d" nv nc neq intsize)
         <> (if np >= 1 then fromString (printf " #product= %d sizeproduct= %d" np sp) else mempty)
         <> fromString (printf " #soft= %d" (wboNumSoft wbo))
         <> fromString (printf " mincost= %d maxcost= %d sumcost= %d" mincost maxcost sumcost)
         <> fromString "\n"
    part1 = 
      case wboTopCost wbo of
        Nothing -> fromString "soft: ;\n"
        Just t -> fromString "soft: " <> fromString (show t) <> fromString ";\n"
    part2 = mconcat $ map showSoftConstraint (wboConstraints wbo)

showSum :: (Monoid a, IsString a) => Sum -> a
showSum = mconcat . map showWeightedTerm

showWeightedTerm :: (Monoid a, IsString a) => WeightedTerm -> a
showWeightedTerm (c, lits) = foldr (\f g -> f <> fromString " " <> g) mempty (x:xs)
  where
    x = if c >= 0 then fromString "+" <> fromString (show c) else fromString (show c)
    xs = map showLit $ sortBy (comparing abs) lits

showLit :: (Monoid a, IsString a) => Lit -> a
showLit lit = if lit > 0 then v else fromString "~" <> v
  where
    v = fromString "x" <> fromString (show (abs lit))

showConstraint :: (Monoid a, IsString a) => Constraint -> a
showConstraint (lhs, op, rhs) =
  showSum lhs <> f op <>  fromString " " <> fromString (show rhs) <> fromString ";\n"
  where
    f Eq = fromString "="
    f Ge = fromString ">="

showSoftConstraint :: (Monoid a, IsString a) => SoftConstraint -> a
showSoftConstraint (cost, constr) =
  case cost of
    Nothing -> showConstraint constr
    Just c -> fromString "[" <> fromString (show c) <> fromString "] " <> showConstraint constr


-- | Generate a OPB format string containing pseudo boolean problem.
toOPBString :: Formula -> String
toOPBString opb = DList.apply (opbBuilder opb) ""

-- | Generate a WBO format string containing weighted boolean optimization problem.
toWBOString :: SoftFormula -> String
toWBOString wbo = DList.apply (wboBuilder wbo) ""

1	{-# OPTIONS_GHC -Wall #-}
2	-----------------------------------------------------------------------------
3	-- \|
4	-- Module : Data.PseudoBoolean.Builder
5	-- Copyright : (c) Masahiro Sakai 2011-2015
6	-- License : BSD-style
7	--
8	-- Maintainer : masahiro.sakai@gmail.com
9	-- Portability : portable
10	--
11	-----------------------------------------------------------------------------
12
13	module Data.PseudoBoolean.Builder
14	(
15	-- * Builder for String-like Monoid
16	opbBuilder
17	, wboBuilder
18
19	-- * String generation
20	, toOPBString
21	, toWBOString
22	) where
23
24	import qualified Prelude
25	import Prelude hiding (sum)
26	import qualified Data.DList as DList
27	import qualified Data.IntSet as IntSet
28	import qualified Data.Set as Set
29	import Data.List (sortBy)
30	import Data.Maybe (maybeToList)
31	import Data.Monoid hiding (Sum (..))
32	import Data.Ord
33	import Data.String
34	import Math.NumberTheory.Logarithms (integerLog2)
35	import Text.Printf
36	import Data.PseudoBoolean.Types
37
38	-- \| A builder which renders a OPB format in any String-like 'Monoid'.
39	opbBuilder :: (Monoid a, IsString a) => Formula -> a
40	opbBuilder opb = (size <> part1 <> part2)	1✔
41	where
42	nv = pbNumVars opb	1✔
43	nc = pbNumConstraints opb	1✔
NEW 44	neq = length [() \| (_lhs, Eq, _rhs) <- pbConstraints opb]	×
45	intsize = maximum $ 0 :	1✔
NEW 46	[ if tmp == 0 then 0 else 1 + integerLog2 tmp	×
47	\| (ts, d) <- [(ts, 0) \| ts <- maybeToList (pbObjectiveFunction opb)] ++ [(lhs,rhs) \| (lhs,_op,rhs) <- pbConstraints opb]	1✔
48	, let tmp = abs d + Prelude.sum [abs c \| (c,_) <- ts]	1✔
49	]
50	p = pbProducts opb	1✔
51	np = Set.size p	1✔
52	sp = Prelude.sum [IntSet.size tm \| tm <- Set.toList p]	1✔
53	size = fromString (printf "* #variable= %d #constraint= %d #equal= %d intsize= %d" nv nc neq intsize)	1✔
54	<> (if np >= 1 then fromString (printf " #product= %d sizeproduct= %d" np sp) else mempty)	1✔
55	<> fromString "\n"	1✔
56	part1 =	1✔
57	case pbObjectiveFunction opb of	1✔
58	Nothing -> mempty	×
59	Just o -> fromString "min: " <> showSum o <> fromString ";\n"	1✔
60	part2 = mconcat $ map showConstraint (pbConstraints opb)	1✔
61
62	-- \| A builder which renders a WBO format in any String-like 'Monoid'.
63	wboBuilder :: (Monoid a, IsString a) => SoftFormula -> a
64	wboBuilder wbo = size <> part1 <> part2	1✔
65	where
66	nv = wboNumVars wbo	1✔
67	nc = wboNumConstraints wbo	1✔
NEW 68	neq = length [() \| (_, (_lhs, Eq, _rhs)) <- wboConstraints wbo]	×
69	p = wboProducts wbo	1✔
70	np = Set.size p	1✔
71	sp = Prelude.sum [IntSet.size tm \| tm <- Set.toList p]	×
72	mincost =	1✔
73	case [c \| (Just c, _) <- wboConstraints wbo] of	1✔
74	[] -> 1 -- this should not happen	×
75	cs -> minimum cs	1✔
76	maxcost = maximum $ 0 : [c \| (Just c, _) <- wboConstraints wbo]	1✔
77	sumcost = Prelude.sum [c \| (Just c, _) <- wboConstraints wbo]	1✔
78	intsize = maximum $ 0 :	1✔
NEW 79	[ if tmp == 0 then 0 else 1 + integerLog2 tmp	×
80	\| (cs, d) <- ([sumcost], 0) : [(map fst lhs, rhs) \| (_,(lhs,_op,rhs)) <- wboConstraints wbo]	1✔
81	, let tmp = abs d + Prelude.sum [abs c \| c <- cs]	1✔
82	]
83	size = fromString (printf "* #variable= %d #constraint= %d #equal= %d intsize= %d" nv nc neq intsize)	1✔
UNCOV 84	<> (if np >= 1 then fromString (printf " #product= %d sizeproduct= %d" np sp) else mempty)	×
85	<> fromString (printf " #soft= %d" (wboNumSoft wbo))	1✔
86	<> fromString (printf " mincost= %d maxcost= %d sumcost= %d" mincost maxcost sumcost)	1✔
87	<> fromString "\n"	1✔
88	part1 =	1✔
89	case wboTopCost wbo of	1✔
90	Nothing -> fromString "soft: ;\n"	×
91	Just t -> fromString "soft: " <> fromString (show t) <> fromString ";\n"	1✔
92	part2 = mconcat $ map showSoftConstraint (wboConstraints wbo)	1✔
93
94	showSum :: (Monoid a, IsString a) => Sum -> a
95	showSum = mconcat . map showWeightedTerm	1✔
96
97	showWeightedTerm :: (Monoid a, IsString a) => WeightedTerm -> a
98	showWeightedTerm (c, lits) = foldr (\f g -> f <> fromString " " <> g) mempty (x:xs)	1✔
99	where
100	x = if c >= 0 then fromString "+" <> fromString (show c) else fromString (show c)	1✔
101	xs = map showLit $ sortBy (comparing abs) lits	1✔
102
103	showLit :: (Monoid a, IsString a) => Lit -> a
104	showLit lit = if lit > 0 then v else fromString "~" <> v	1✔
105	where
106	v = fromString "x" <> fromString (show (abs lit))	1✔
107
108	showConstraint :: (Monoid a, IsString a) => Constraint -> a
109	showConstraint (lhs, op, rhs) =	1✔
110	showSum lhs <> f op <> fromString " " <> fromString (show rhs) <> fromString ";\n"	1✔
111	where
112	f Eq = fromString "="	1✔
113	f Ge = fromString ">="	1✔
114
115	showSoftConstraint :: (Monoid a, IsString a) => SoftConstraint -> a
116	showSoftConstraint (cost, constr) =	1✔
117	case cost of	1✔
118	Nothing -> showConstraint constr	1✔
119	Just c -> fromString "[" <> fromString (show c) <> fromString "] " <> showConstraint constr	1✔
120
121
122	-- \| Generate a OPB format string containing pseudo boolean problem.
123	toOPBString :: Formula -> String
124	toOPBString opb = DList.apply (opbBuilder opb) ""	1✔
125
126	-- \| Generate a WBO format string containing weighted boolean optimization problem.
127	toWBOString :: SoftFormula -> String
128	toWBOString wbo = DList.apply (wboBuilder wbo) ""	1✔

msakai / pseudo-boolean / 130

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous