Question

假设一个节点可能存在或不存在的树，我想生成一个公式，其中：

每个节点都有一个布尔变量（表示它是否存在），
如果免费（可能存在或可能不存在），
如果节点的父节点存在，则只能存在节点（子节点表示父节点）。

我的目标是使用allSat生成给定形状的所有可能子树。例如，考虑数据类型和示例tree：

data Tree
    = Leaf
    | Tree [ Tree ]
    deriving Show

tree :: Tree
tree
    = Tree            -- T1
        [ Leaf        -- L1
        , Tree        -- T2
            [ Leaf    -- L2
            , Leaf    -- L3
            ]
        ]

翻译该树应该为每个节点T1, T2, L1, L2, L3和一组约束引入布尔值：

L1 => T1
T2 => T1
L2 => T2
L3 => T2

以下代码生成正确的解决方案（11）：

main :: IO ()
main = do
    res <- allSat . forSome ["T1", "T2", "L1", "L2", "L3"] $
        \ (t1::SBool) t2 l1 l2 l3 ->
            (   (l1 ==> t1)
            &&& (t2 ==> t1)
            &&& (l2 ==> t2)
            &&& (l3 ==> t2)
            )
    putStrLn $ show res

那么，如果给出一些具体的allSat，我怎样才能生成给tree的公式？

另一种解决方案是构建这样的动作：

main :: IO ()
main = do
    res <- allSat $ makePredicate tree
    putStrLn $ show res

makePredicate :: Tree -> Predicate
makePredicate    _     = do
        t1 <- exists "T1"
        l1 <- exists "L1"
        constrain $ l1 ==> t1
        t2 <- exists "T2"
        constrain $ t2 ==> t1
        l2 <- exists "L2"
        constrain $ l2 ==> t2
        l3 <- exists "L3"
        constrain $ l3 ==> t2
        return true

answer to another SO question

Answer 1

为了弄清递归应该如何工作，从问题中重写替代解决方案以匹配树的形状是有益的：

makePredicate :: Tree -> Predicate
makePredicate    _     = do
        -- SBool for root
        t1 <- exists "T1"
        -- predicates for children
        c1 <- do
                -- SBool for child
                l1 <- exists "L1"
                -- child implies the parent
                constrain $ l1 ==> t1
                return true
        c2 <- do
                t2 <- exists "T2"
                constrain $ t2 ==> t1
                -- predicates for children
                c3 <- do
                        l2 <- exists "L2"
                        constrain $ l2 ==> t2
                        return true                    
                c4 <- do
                        l3 <- exists "L3"
                        constrain $ l3 ==> t2
                        return true
                return $ c3 &&& c4 &&& true 
        return $ c1 &&& c2 &&& true

我们可以看到，我们首先为节点创建一个SBool变量，然后处理它的子节点，然后返回一个连接。这意味着我们可以首先映射孩子以生成他们的Predicate，然后将Predicate的列表折叠为true作为初始值。

以下代码遍历树并生成公式。首先，我们简化树类型

{-# LANGUAGE ScopedTypeVariables #-}
import Data.SBV

data Tree
    = Node String [ Tree ]
    deriving Show

tree :: Tree
tree
    = Node "T1"
        [ Node "L1" []
        , Node "T2"
            [ Node "L2" []
            , Node "L3" []
            ]
        ]

然后我们递归遍历树并为每个节点生成Predicate。根是特殊的：因为它没有父母，所以没有什么可暗示的。

main :: IO ()
main = do
    res <- allSat $ makeRootPredicate tree
    putStrLn $ show res

makeRootPredicate :: Tree       -> Predicate
makeRootPredicate    (Node i cs) = do
    x <- exists i
    cps <- mapM (makeNodePredicate x) cs
    return $ bAnd cps

makeNodePredicate :: SBool -> Tree       -> Predicate
makeNodePredicate    parent   (Node i cs) = do
    x <- exists i
    constrain $ x ==> parent
    cps <- mapM (makeNodePredicate x) cs
    return $ bAnd cps

最后，我使用bAnd创建谓词的连接（如注释中所指出的）。

由于bAnd内部使用foldr，我们会得到一个公式

(c1 &&& (c2 &&& true))

替换c1和c2，我们得到

(((l1 ==> t1) &&& true) &&& (((t2 ==> t1) &&& c3 &&& c4 &&& true) &&& true))

替换c3和c4，我们得到

(((l1 ==> t1) &&& true) &&& (((t2 ==> t1) &&& ((l2 ==> t2) &&& true) &&& ((l3 ==> t2) &&& true) &&& true) &&& true))

如评论所示，SBV将在可能的情况下通过部分评估来内部简化公式。因此，true将被淘汰。

使用Haskell给出一些数据生成SBV公式的简单方法是什么？

1 个答案: