{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : ToySolver.FileFormat.CNF
-- Copyright : (c) Masahiro Sakai 2016-2018
-- License : BSD-style
--
-- Maintainer : masahiro.sakai@gmail.com
-- Stability : provisional
-- Portability : non-portable
--
-- Reader and Writer for DIMACS CNF and family of similar formats.
--
-----------------------------------------------------------------------------
module ToySolver.FileFormat.CNF
(
-- * FileFormat class
module ToySolver.FileFormat.Base
-- * CNF format
, CNF (..)
-- * WCNF formats
-- ** (Old) WCNF format
, WCNF (..)
, WeightedClause
, Weight
-- ** New WCNF format
, NewWCNF (..)
-- ** Old or new WCNF
, SomeWCNF (..)
-- * GCNF format
, GCNF (..)
, GroupIndex
, GClause
-- * QDIMACS format
, QDimacs (..)
, Quantifier (..)
, QuantSet
, Atom
-- * Re-exports
, Lit
, Clause
, PackedClause
, packClause
, unpackClause
) where
import Prelude hiding (readFile, writeFile)
import Control.DeepSeq
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Builder
import Data.Char
import Data.Maybe
import ToySolver.FileFormat.Base
import qualified ToySolver.SAT.Types as SAT
import ToySolver.SAT.Types (Lit, Clause, PackedClause, packClause, unpackClause)
-- -------------------------------------------------------------------
-- | DIMACS CNF format
data CNF
= CNF
{ cnfNumVars :: !Int
-- ^ Number of variables
, cnfNumClauses :: !Int
-- ^ Number of clauses
, cnfClauses :: [SAT.PackedClause]
-- ^ Clauses
}
deriving (Eq, Ord, Show, Read)
instance FileFormat CNF where
parse s =
case BS.words l of
(["p","cnf", nvar, nclause]) ->
Right $
CNF
{ cnfNumVars = read $ BS.unpack nvar
, cnfNumClauses = read $ BS.unpack nclause
, cnfClauses = map parseClauseBS ls
}
_ ->
Left "cannot find cnf header"
where
l :: BS.ByteString
ls :: [BS.ByteString]
(l:ls) = filter (not . isCommentBS) (BS.lines s)
render cnf = header <> mconcat (map f (cnfClauses cnf))
where
header = mconcat
[ byteString "p cnf "
, intDec (cnfNumVars cnf), char7 ' '
, intDec (cnfNumClauses cnf), char7 '\n'
]
f c = mconcat [intDec lit <> char7 ' '| lit <- SAT.unpackClause c] <> byteString "0\n"
readInts :: BS.ByteString -> [Int]
readInts s =
case BS.readInt (BS.dropWhile isSpace s) of
Just (0,_) -> []
Just (z,s') -> z : readInts s'
Nothing -> error "ToySolver.FileFormat.CNF.readInts: 0 is missing"
parseClauseBS :: BS.ByteString -> SAT.PackedClause
parseClauseBS = SAT.packClause . readInts
isCommentBS :: BS.ByteString -> Bool
isCommentBS s =
case BS.uncons s of
Just ('c',_) -> True
_ -> False
-- -------------------------------------------------------------------
-- | WCNF format for representing partial weighted Max-SAT problems.
--
-- This format is used for for MAX-SAT evaluations.
--
-- References:
--
-- *
data WCNF
= WCNF
{ wcnfNumVars :: !Int
-- ^ Number of variables
, wcnfNumClauses :: !Int
-- ^ Number of (weighted) clauses
, wcnfTopCost :: !Weight
-- ^ Hard clauses have weight equal or greater than "top".
-- We assure that "top" is a weight always greater than the sum of the weights of violated soft clauses in the solution.
, wcnfClauses :: [WeightedClause]
-- ^ Weighted clauses
}
deriving (Eq, Ord, Show, Read)
-- | Weighted clauses
type WeightedClause = (Weight, SAT.PackedClause)
-- | Weigths must be greater than or equal to 1, and smaller than 2^63.
type Weight = Integer
-- | Note that 'parse' also accepts new WCNF files and (unweighted) CNF files and converts them into 'WCNF'.
instance FileFormat WCNF where
parse = liftM f . parse
where
f (SomeWCNFNew x) = toOldWCNF x
f (SomeWCNFOld x) = x
render wcnf = header <> mconcat (map f (wcnfClauses wcnf))
where
header = mconcat
[ byteString "p wcnf "
, intDec (wcnfNumVars wcnf), char7 ' '
, intDec (wcnfNumClauses wcnf), char7 ' '
, integerDec (wcnfTopCost wcnf), char7 '\n'
]
f (w,c) = integerDec w <> mconcat [char7 ' ' <> intDec lit | lit <- SAT.unpackClause c] <> byteString " 0\n"
parseWCNFLineBS :: BS.ByteString -> WeightedClause
parseWCNFLineBS s =
case BS.readInteger (BS.dropWhile isSpace s) of
Nothing -> error "ToySolver.FileFormat.CNF: no weight"
Just (w, s') -> seq w $ seq xs $ (w, xs)
where
xs = parseClauseBS s'
-- -------------------------------------------------------------------
-- | New WCNF file format
--
-- This format is used for for MAX-SAT evaluations >=2020.
--
-- References:
--
-- *
newtype NewWCNF
= NewWCNF
{ nwcnfClauses :: [NewWeightedClause]
-- ^ Weighted clauses
}
deriving (Eq, Ord, Show, Read)
type NewWeightedClause = (Maybe Weight, SAT.PackedClause)
-- | Note that 'parse' also accepts (old) WCNF files and (unweighted) CNF files and converts them into 'NewWCNF'.
instance FileFormat NewWCNF where
parse = liftM f . parse
where
f (SomeWCNFNew x) = x
f (SomeWCNFOld x) = toNewWCNF x
render nwcnf = mconcat (map f (nwcnfClauses nwcnf))
where
f (Nothing, c) = char7 'h' <> mconcat [char7 ' ' <> intDec lit | lit <- SAT.unpackClause c] <> byteString " 0\n"
f (Just w, c) = integerDec w <> mconcat [char7 ' ' <> intDec lit | lit <- SAT.unpackClause c] <> byteString " 0\n"
parseNewWCNFLineBS :: BS.ByteString -> NewWeightedClause
parseNewWCNFLineBS s =
case BS.uncons s' of
Nothing -> error "ToySolver.FileFormat.CNF: no weight"
Just ('h', s'') ->
let xs = parseClauseBS s''
in seq xs $ (Nothing, xs)
Just _ ->
case BS.readInteger s' of
Nothing -> error "ToySolver.FileFormat.CNF: no weight"
Just (w, s'') ->
let xs = parseClauseBS s''
in seq w $ seq xs $ (Just w, xs)
where
s' = BS.dropWhile isSpace s
-- -------------------------------------------------------------------
data SomeWCNF
= SomeWCNFOld WCNF
| SomeWCNFNew NewWCNF
deriving (Eq, Ord, Show, Read)
toOldWCNF :: NewWCNF -> WCNF
toOldWCNF (NewWCNF cs)
= WCNF
{ wcnfNumVars = maximum (0 : [abs l | (_, c) <- cs, l <- unpackClause c])
, wcnfNumClauses = length cs
, wcnfTopCost = top
, wcnfClauses = [(fromMaybe top w, c) | (w, c) <- cs]
}
where
top = sum [w | (Just w, c) <- cs] + 1
toNewWCNF :: WCNF -> NewWCNF
toNewWCNF wcnf = NewWCNF [(if w >= wcnfTopCost wcnf then Nothing else Just w, c) | (w, c) <- wcnfClauses wcnf]
instance FileFormat SomeWCNF where
parse s =
case filter (not . isCommentBS) (BS.lines s) of
[] -> Right $ SomeWCNFNew $ NewWCNF []
lls@(l : ls) ->
case BS.words l of
(["p","wcnf", nvar, nclause, top]) ->
Right $ SomeWCNFOld $
WCNF
{ wcnfNumVars = read $ BS.unpack nvar
, wcnfNumClauses = read $ BS.unpack nclause
, wcnfTopCost = read $ BS.unpack top
, wcnfClauses = map parseWCNFLineBS ls
}
(["p","wcnf", nvar, nclause]) ->
Right $ SomeWCNFOld $
WCNF
{ wcnfNumVars = read $ BS.unpack nvar
, wcnfNumClauses = read $ BS.unpack nclause
-- top must be greater than the sum of the weights of violated soft clauses.
, wcnfTopCost = fromInteger $ 2^(63::Int) - 1
, wcnfClauses = map parseWCNFLineBS ls
}
(["p","cnf", nvar, nclause]) ->
Right $ SomeWCNFOld $
WCNF
{ wcnfNumVars = read $ BS.unpack nvar
, wcnfNumClauses = read $ BS.unpack nclause
-- top must be greater than the sum of the weights of violated soft clauses.
, wcnfTopCost = fromInteger $ 2^(63::Int) - 1
, wcnfClauses = map ((\c -> seq c (1,c)) . parseClauseBS) ls
}
("h" : _) ->
Right $ SomeWCNFNew $ NewWCNF $ map parseNewWCNFLineBS lls
(s : _) | Just _ <- BS.readInteger s ->
Right $ SomeWCNFNew $ NewWCNF $ map parseNewWCNFLineBS lls
_ ->
Left "cannot find wcnf/cnf header"
render (SomeWCNFOld wcnf) = render wcnf
render (SomeWCNFNew nwcnf) = render nwcnf
-- -------------------------------------------------------------------
-- | Group oriented CNF Input Format
--
-- This format is used in Group oriented MUS track of the SAT Competition 2011.
--
-- References:
--
-- *
data GCNF
= GCNF
{ gcnfNumVars :: !Int
-- ^ Nubmer of variables
, gcnfNumClauses :: !Int
-- ^ Number of clauses
, gcnfLastGroupIndex :: !GroupIndex
-- ^ The last index of a group in the file number of components contained in the file.
, gcnfClauses :: [GClause]
}
deriving (Eq, Ord, Show, Read)
-- | Component number between 0 and `gcnfLastGroupIndex`
type GroupIndex = Int
-- | Clause together with component number
type GClause = (GroupIndex, SAT.PackedClause)
instance FileFormat GCNF where
parse s =
case BS.words l of
(["p","gcnf", nbvar', nbclauses', lastGroupIndex']) ->
Right $
GCNF
{ gcnfNumVars = read $ BS.unpack nbvar'
, gcnfNumClauses = read $ BS.unpack nbclauses'
, gcnfLastGroupIndex = read $ BS.unpack lastGroupIndex'
, gcnfClauses = map parseGCNFLineBS ls
}
(["p","cnf", nbvar', nbclause']) ->
Right $
GCNF
{ gcnfNumVars = read $ BS.unpack nbvar'
, gcnfNumClauses = read $ BS.unpack nbclause'
, gcnfLastGroupIndex = read $ BS.unpack nbclause'
, gcnfClauses = zip [1..] $ map parseClauseBS ls
}
_ ->
Left "cannot find gcnf header"
where
l :: BS.ByteString
ls :: [BS.ByteString]
(l:ls) = filter (not . isCommentBS) (BS.lines s)
render gcnf = header <> mconcat (map f (gcnfClauses gcnf))
where
header = mconcat
[ byteString "p gcnf "
, intDec (gcnfNumVars gcnf), char7 ' '
, intDec (gcnfNumClauses gcnf), char7 ' '
, intDec (gcnfLastGroupIndex gcnf), char7 '\n'
]
f (idx,c) = char7 '{' <> intDec idx <> char7 '}' <>
mconcat [char7 ' ' <> intDec lit | lit <- SAT.unpackClause c] <>
byteString " 0\n"
parseGCNFLineBS :: BS.ByteString -> GClause
parseGCNFLineBS s
| Just ('{', s1) <- BS.uncons (BS.dropWhile isSpace s)
, Just (!idx,s2) <- BS.readInt s1
, Just ('}', s3) <- BS.uncons s2 =
let ys = parseClauseBS s3
in seq ys $ (idx, ys)
| otherwise = error "ToySolver.FileFormat.CNF: parse error"
-- -------------------------------------------------------------------
{-
http://www.qbflib.org/qdimacs.html
::= EOF
::= []
::= |
::= c EOL
::= p cnf EOL
::= []
::= |
::= 0 EOL
::= e | a
::= |
::=
::= |
::= | 0 EOL
::=
::= {A sequence of non-special ASCII characters}
::= {A 32-bit signed integer different from 0}
::= {A 32-bit signed integer greater than 0}
-}
-- | QDIMACS format
--
-- Quantified boolean expression in prenex normal form,
-- consisting of a sequence of quantifiers ('qdimacsPrefix') and
-- a quantifier-free CNF part ('qdimacsMatrix').
--
-- References:
--
-- * QDIMACS standard Ver. 1.1
--
data QDimacs
= QDimacs
{ qdimacsNumVars :: !Int
-- ^ Number of variables
, qdimacsNumClauses :: !Int
-- ^ Number of clauses
, qdimacsPrefix :: [QuantSet]
-- ^ Sequence of quantifiers
, qdimacsMatrix :: [SAT.PackedClause]
-- ^ Clauses
}
deriving (Eq, Ord, Show, Read)
-- | Quantifier
data Quantifier
= E -- ^ existential quantifier (∃)
| A -- ^ universal quantifier (∀)
deriving (Eq, Ord, Show, Read, Enum, Bounded)
-- | Quantified set of variables
type QuantSet = (Quantifier, [Atom])
-- | Synonym of 'SAT.Var'
type Atom = SAT.Var
instance FileFormat QDimacs where
parse = f . BS.lines
where
f [] = Left "ToySolver.FileFormat.CNF.parse: premature end of file"
f (l : ls) =
case BS.uncons l of
Nothing -> Left "ToySolver.FileFormat.CNF.parse: no problem line"
Just ('c', _) -> f ls
Just ('p', s) ->
case BS.words s of
["cnf", numVars', numClauses'] ->
case parsePrefix ls of
(prefix', ls') -> Right $
QDimacs
{ qdimacsNumVars = read $ BS.unpack numVars'
, qdimacsNumClauses = read $ BS.unpack numClauses'
, qdimacsPrefix = prefix'
, qdimacsMatrix = map parseClauseBS ls'
}
_ -> Left "ToySolver.FileFormat.CNF.parse: invalid problem line"
Just (c, _) -> Left ("ToySolver.FileFormat.CNF.parse: invalid prefix " ++ show c)
render qdimacs = problem_line <> prefix' <> mconcat (map f (qdimacsMatrix qdimacs))
where
problem_line = mconcat
[ byteString "p cnf "
, intDec (qdimacsNumVars qdimacs), char7 ' '
, intDec (qdimacsNumClauses qdimacs), char7 '\n'
]
prefix' = mconcat
[ char7 (if q == E then 'e' else 'a') <> mconcat [char7 ' ' <> intDec atom | atom <- atoms] <> byteString " 0\n"
| (q, atoms) <- qdimacsPrefix qdimacs
]
f c = mconcat [intDec lit <> char7 ' '| lit <- SAT.unpackClause c] <> byteString "0\n"
parsePrefix :: [BS.ByteString] -> ([QuantSet], [BS.ByteString])
parsePrefix = go []
where
go result [] = (reverse result, [])
go result lls@(l : ls) =
case BS.uncons l of
Just (c,s)
| c=='a' || c=='e' ->
let atoms = readInts s
q = if c=='a' then A else E
in seq q $ deepseq atoms $ go ((q, atoms) : result) ls
| otherwise ->
(reverse result, lls)
_ -> error "ToySolver.FileFormat.CNF.parseProblem: invalid line"
-- -------------------------------------------------------------------