Question

使用SBV库，我试图满足符号状态列表中的条件：

data State = Intro | Start | Content | Comma | Dot
mkSymbolicEnumeration ''State

-- examples of such lists
[Intro, Start, Content, Comma, Start, Comma, Content, Dot]
[Intro, Comma, Start, Content, Comma, Content, Start, Dot]

一切正常，除了我需要最终列表完全包含n中的[Intro, Start, Content]个元素。目前，我使用有界滤镜进行此操作：

answer :: Int -> Symbolic [State]
answer n = do
    seq <- sList "seq"

    let maxl = n+6
    let minl = n+2
    constrain $ L.length seq .<= fromIntegral maxl
    constrain $ L.length seq .>= fromIntegral minl

    -- some additional constraints hidden for brevity purposes

    let etypes e = e `sElem` [sIntro, sStart, sContent]
    constrain $ L.length (L.bfilter maxl etypes seq) .== fromIntegral n

如您所见，列表的长度可以在n+2和n+6之间，重要的一点是列表中包含[sIntro, sStart, sContent]个元素的数量正确。

除了非常慢缓慢之外，一切正常。就像，n=4会花费几秒钟，而n>=6会花费永久（超过30分钟，并且还在计算）。如果我删除了有界过滤器约束，则结果是n即时达到25左右。

最后，我并不特别在意使用L.bfilter。我需要的是一种声明最终符号列表应包含某些特定类型的恰好 n元素的方法。

-> 是否有更快的方法可以满足count(sIntro || sStart || sContent)？

-评论讨论后进行编辑：

下面的代码应确保所有有效元素在elts列表中位于最前面。例如，如果我们从valids计算8个elts元素，则我们take 8 elts并且在此子列表中计算validTaken个有效元素。如果结果为8，则意味着所有8个valids元素都位于elts的前面。可悲的是，即使除去所有其他约束，这也会导致系统的Unsat结果。但是，在针对某些虚拟元素列表进行测试时，该功能效果很好。

-- | test that all valid elements are upfront in the list of elements
validUpFront :: SInteger -> [Elem] -> SBool
validUpFront valids elts =
    let takeValids = flip take elts <$> (fromInteger <$> unliteral valids)
        validTaken = sum $ map (oneIf . included) $ fromMaybe [] takeValids
    in valids .== validTaken

-- ...

answer n = runSMT $ do

    -- ...

    let valids = sum $ map (oneIf . included) elts :: SInteger
    constrain $ validUpFront valids elts

Answer 1

序列逻辑的求解器虽然用途广泛，但众所周知它速度很慢。对于此特定问题，我建议使用常规布尔逻辑，它将表现得更好。这是我如何编码您的问题：

{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE StandaloneDeriving #-}

import Data.SBV
import Data.SBV.Control
import Data.Maybe
import Control.Monad

data State = Intro | Start | Content | Comma | Dot
mkSymbolicEnumeration ''State

data Elem = Elem { included :: SBool
                 , element  :: SState
                 }

new :: Symbolic Elem
new = do i <- free_
         e <- free_
         pure Elem {included = i, element = e}

get :: Elem -> Query (Maybe State)
get e = do isIn <- getValue (included e)
           if isIn
               then Just <$> getValue (element e)
               else pure Nothing

answer :: Int -> IO [State]
answer n = runSMT $ do
    let maxl = n+6
    let minl = n+2

    -- allocate upto maxl elements
    elts <- replicateM maxl new

    -- ask for at least minl of them to be valid
    let valids :: SInteger
        valids = sum $ map (oneIf . included) elts
    constrain $ valids .>= fromIntegral minl

    -- count the interesting ones
    let isEtype e  = included e .&& element e `sElem` [sIntro, sStart, sContent]
        eTypeCount :: SInteger
        eTypeCount = sum $ map (oneIf . isEtype) elts

    constrain $ eTypeCount .== fromIntegral n

    query $ do cs <- checkSat
               case cs of
                 Sat -> catMaybes <$> mapM get elts
                 _   -> error $ "Query is " ++ show cs

示例运行：

*Main> answer 5
[Intro,Comma,Comma,Intro,Intro,Intro,Start]

我已经能够运行到answer 500，并且在相对较旧的计算机上运行了大约5秒。

确保所有有效值都在开头

使所有有效元素位于列表开头的最简单方法是计算包含值中的交替值，并确保仅允许这样一个过渡：

-- make sure there's at most one-flip in the sequence.
-- This'll ensure all the selected elements are up-front.
let atMostOneFlip []     = sTrue
    atMostOneFlip (x:xs) = ite x (atMostOneFlip xs) (sAll sNot xs)

constrain $ atMostOneFlip (map included elts)

这将确保所有有效值都在包含无效条目的列表后缀之前。编写其他属性时，必须检查当前元素和下一个元素均有效。模板形式：

foo (x:y:rest) = ((included x .&& included y) .=> (element y .== sStart .=> element x .== sDot))
                .&& foo (y:rest)

通过象征性地查看included x和included y的值，您可以确定它们是否都包括在内，或者x是否是最后一个元素，或者它们都没有;并写出相应的约束作为每种情况的含义。上面的示例显示了您处于序列中间的某个位置，同时包含x和y的情况。

将符号列表约束为SBV中某种类型的元素数

1 个答案:

确保所有有效值都在开头