Решение SAT с библиотекой SBK haskell: как сгенерировать предикат из разобранной строки?

Ответ 1

Работа с SBV

Работа с SBV требует, чтобы вы следовали за типами и понимаете, что Predicate - это всего лишь Symbolic SBool. После этого шага важно, чтобы вы исследовали и обнаружили Symbolic - монада - yay, monad!

Теперь, когда вы знаете, что у вас есть монада, тогда все, что есть в пикше, которая 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. Функция интерпретации использует среду и просто применяет функцию SBV, которая соответствует намерению каждого конструктора из типа hatt Expr.

  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

Ответ 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 - это функция, которая "количественно оценивает" данную переменную, связывая ее со всеми возможными значениями.

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