Question

我想解析描述命题公式的String，然后使用SAT求解器找到命题公式的所有模型。

现在我可以使用hatt包解析一个命题公式;请参阅下面的testParse功能。

我也可以用SBV库运行SAT求解器调用;请参阅下面的testParse功能。

问题： 我如何在运行时在SBV库中生成类似Predicate的{{1}}类型的值，表示我刚刚从String解析的命题公式？我只知道如何手动键入myPredicate表达式，而不知道如何将转换器函数从forSome_ $ \x y z -> ...值写入类型为Expr的值。

Predicate

可能有用的信息：

以下是BitVectors.Data的链接： http://hackage.haskell.org/package/sbv-3.0/docs/src/Data-SBV-BitVectors-Data.html

以下是示例代码表单Examples.Puzzles.PowerSet：

-- cabal install sbv hatt
import Data.Logic.Propositional
import Data.SBV


-- Random test formula:
-- (x or ~z) and (y or ~z)

-- graphical depiction, see: https://www.wolframalpha.com/input/?i=%28x+or+~z%29+and+%28y+or+~z%29

testParse = parseExpr "test source" "((X | ~Z) & (Y | ~Z))"

myPredicate :: Predicate
myPredicate = forSome_ $ \x y z -> ((x :: SBool) ||| (bnot z)) &&& (y ||| (bnot z))

testSat = do 
         x <- allSat $ myPredicate
         putStrLn $ show x     


main = do
       putStrLn $ show $ testParse
       testSat


    {-
       Need a function that dynamically creates a Predicate 
(as I did with the function (like "\x y z -> ..") for an arbitrary expression of type "Expr" that is parsed from String. 
    -}

这是Expr数据类型（来自hatt库）：

import Data.SBV

genPowerSet :: [SBool] -> SBool
genPowerSet = bAll isBool
  where isBool x = x .== true ||| x .== false

powerSet :: [Word8] -> IO ()
powerSet xs = do putStrLn $ "Finding all subsets of " ++ show xs
                 res <- allSat $ genPowerSet `fmap` mkExistVars n

Answer 1

使用SBV

使用SBV要求您遵循类型并认识到Predicate只是Symbolic SBool。在那一步之后，重要的是你要调查并发现Symbolic是一个monad - yay，a monad！

既然你知道你有一个monad，那么thedock中Symbolic的任何东西应该是微不足道的，可以组合起来构建你想要的任何SAT。对于您的问题，您只需要一个简单的AST解释器来构建Predicate。

代码演练

代码全部包含在下面的一个连续表格中，但我将逐步介绍有趣的部分。入口点是solveExpr，它接受表达式并产生SAT结果：

solveExpr :: Expr -> IO AllSatResult
solveExpr e0 = allSat prd

SBV的allSat在谓词中的应用是显而易见的。要构建该谓词，我们需要为表达式中的每个变量声明一个存在SBool。现在假设我们有vs :: [String]，其中每个字符串对应于表达式中的Var之一。

  prd :: Predicate
  prd = do
      syms <- mapM exists vs
      let env = M.fromList (zip vs syms)
      interpret env e0

注意编程语言基础知识是如何潜入这里的。我们现在需要一个环境，将表达式变量名称映射到SBV使用的符号布尔值。

接下来，我们解释表达式以生成我们的Predicate。 explain函数使用环境，只应用与hatt的Expr类型中每个构造函数的意图相匹配的SBV函数。

  interpret :: Env -> Expr -> Predicate
  interpret env expr = do
   let interp = interpret env
   case expr of
    Variable v -> return (envLookup v env)
    Negation e -> bnot `fmap` interp e
    Conjunction e1 e2   ->
     do r1 <- interp e1
        r2 <- interp e2
        return (r1 &&& r2)
    Disjunction e1 e2   ->
     do r1 <- interp e1
        r2 <- interp e2
        return (r1 ||| r2)
    Conditional e1 e2   -> error "And so on"
    Biconditional e1 e2 -> error "And so on"

就是这样！其余的只是锅炉板。

完整代码

import Data.Logic.Propositional hiding (interpret)
import Data.SBV
import Text.Parsec.Error (ParseError)
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Foldable (foldMap)
import Control.Monad ((<=<))

testParse :: Either ParseError Expr
testParse = parseExpr "test source" "((X | ~Z) & (Y | ~Z))"

type Env = M.Map String SBool

envLookup :: Var -> Env -> SBool
envLookup (Var v) e = maybe (error $ "Var not found: " ++ show v) id
                            (M.lookup [v] e)

solveExpr :: Expr -> IO AllSatResult
solveExpr e0 = allSat go
 where
  vs :: [String]
  vs = map (\(Var c) -> [c]) (variables e0)

  go :: Predicate
  go = do
      syms <- mapM exists vs
      let env = M.fromList (zip vs syms)
      interpret env e0
  interpret :: Env -> Expr -> Predicate
  interpret env expr = do
   let interp = interpret env
   case expr of
    Variable v -> return (envLookup v env)
    Negation e -> bnot `fmap` interp e
    Conjunction e1 e2   ->
     do r1 <- interp e1
        r2 <- interp e2
        return (r1 &&& r2)
    Disjunction e1 e2   ->
     do r1 <- interp e1
        r2 <- interp e2
        return (r1 ||| r2)
    Conditional e1 e2   -> error "And so on"
    Biconditional e1 e2 -> error "And so on"

main :: IO ()
main = do
       let expr = testParse
       putStrLn $ "Solving expr: " ++ show expr
       either (error . show) (print <=< solveExpr) expr

Answer 2

forSome_是Provable类的成员，因此似乎只需定义实例Provable Expr即可。 SVB中的几乎所有函数都使用Provable，因此这样您就可以使用所有这些函数Expr。首先，我们将Expr转换为在Vector中查找变量值的函数。您也可以使用Data.Map.Map或类似的东西，但创建后环境不会更改，Vector会提供持续时间查找：

import Data.Logic.Propositional
import Data.SBV.Bridge.CVC4
import qualified Data.Vector as V
import Control.Monad

toFunc :: Boolean a => Expr -> V.Vector a -> a
toFunc (Variable (Var x)) = \env -> env V.! (fromEnum x)
toFunc (Negation x) = \env -> bnot (toFunc x env)
toFunc (Conjunction a b) = \env -> toFunc a env &&& toFunc b env
toFunc (Disjunction a b) = \env -> toFunc a env ||| toFunc b env
toFunc (Conditional a b) = \env -> toFunc a env ==> toFunc b env
toFunc (Biconditional a b) = \env -> toFunc a env <=> toFunc b env

Provable基本上定义了两个功能：forAll_，forAll，forSome_，forSome。我们必须生成所有可能的变量映射到值并将该函数应用于映射。选择如何精确处理结果将由Symbolic monad：

完成

forAllExp_ :: Expr -> Symbolic SBool
forAllExp_ e = (m0 >>= f . V.accum (const id) (V.replicate (fromEnum maxV + 1) false)
  where f = return . toFunc e 
        maxV = maximum $ map (\(Var x) -> x) (variables e)
        m0 = mapM fresh (variables e)

fresh是一个＆＃34;量化＆＃34;的函数。给定变量通过将其与所有可能的值相关联。

fresh :: Var -> Symbolic (Int, SBool)
fresh (Var var) = forall >>= \a -> return (fromEnum var, a)

如果为四个函数中的每个函数定义其中一个函数，那么将会有很多非常重复的代码。所以你可以概括如下：

quantExp :: (String -> Symbolic SBool) -> Symbolic SBool -> [String] -> Expr -> Symbolic SBool
quantExp q q_ s e = m0 >>= f . V.accum (const id) (V.replicate (fromEnum maxV + 1) false)
  where f = return . toFunc e 
        maxV = maximum $ map (\(Var x) -> x) (variables e)
        (v0, v1) = splitAt (length s) (variables e)
        m0 = zipWithM fresh (map q s) v0 >>= \r0 -> mapM (fresh q_) v1 >>= \r1 -> return (r0++r1)

fresh :: Symbolic SBool -> Var -> Symbolic (Int, SBool)
fresh q (Var var) = q >>= \a -> return (fromEnum var, a)

如果确切地混淆了正在发生的事情，Provable实例可能足以解释：

instance Provable Expr where 
  forAll_  = quantExp forall forall_ [] 
  forAll   = quantExp forall forall_ 
  forSome_ = quantExp exists exists_ []
  forSome  = quantExp exists exists_

然后你的测试用例：

myPredicate :: Predicate
myPredicate = forSome_ $ \x y z -> ((x :: SBool) ||| (bnot z)) &&& (y ||| (bnot z))

myPredicate' :: Predicate
myPredicate' = forSome_ $ let Right a = parseExpr "test source" "((X | ~Z) & (Y | ~Z))" in a

testSat = allSat myPredicate >>= print
testSat' = allSat myPredicate >>= print

使用haskell SBV库解决SAT：如何从解析后的字符串生成谓词？

2 个答案: