我有一个符号枚举,如下所示:
data State = Start | Dot
mkSymbolicEnumeration ''State
评估一个状态在序列中是否有效的函数,相对于前一个状态,被定义为sDot
只能在我们的序列:sStart
sStart
sDot
sStart
sDot
validSequence :: SList State -> SInteger -> SBool
validSequence seq i = case seq .!! i of
sStart -> p1 .== sDot -- sStart can only be preceded by sDot
sDot -> p1 .== sStart -- sDot can only be preceded by sStart
where p1 = seq .!! (i-1)
然后,声明了两组约束。第一个状态seq
应该是 length n
,第二组状态比每个seq !! i
withi /= 0
都应该满足validSequence
:
-- sequence should be of length n
constrain $ L.length seq .== fromIntegral n
-- apply a validSequence constraint for every i in [1..n]
mapM_ (constrain . (validSequence seq) . fromIntegral) [1..n]
当我将此模块加载到ghci
中时,我得到的结果与我期望的不同:
runSMT $ answer 10
-- expecting this: [Dot, Start, Dot, Start, Dot, Start, Dot, Start, Dot, Start]
-- or this: [Start, Dot, Start, Dot, Start, Dot, Start, Dot, Start, Dot]
-- actual result: [Dot, Dot, Dot, Dot, Dot, Dot, Dot, Dot, Dot, Dot]
我不明白的是:
- 为什么实际结果不满足
Dot
只应遵循的约束Start
- 特别是,我做错了
validSequence
什么吗? - 或者,我是否
mapM_
以错误的方式使用呼叫?
完整的可重现代码如下(需要SBV 库):
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Sandbox where
import Data.SBV
import Data.SBV.Control
import Data.SBV.List ((.!!))
import qualified Data.SBV.List as L
data State = Start | Dot
mkSymbolicEnumeration ''State
validSequence :: SList State -> SInteger -> SBool
validSequence seq i = case seq .!! i of
sStart -> p1 .== sDot -- sStart can only be preceded by sDot
sDot -> p1 .== sStart -- sDot can only be preceded by sStart
where p1 = seq .!! (i-1)
answer :: Int -> Symbolic [State]
answer n = do
seq <- sList "seq"
-- sequence should be of length n
constrain $ L.length seq .== fromIntegral n
-- apply a validSequence constraint for every i in [1..n]
mapM_ (constrain . (validSequence seq) . fromIntegral) [1..n]
query $ do cs <- checkSat
case cs of
Unk -> error "Solver returned unknown!"
DSat{} -> error "Unexpected dsat result!"
Unsat -> error "Solver couldn't find a satisfiable solution"
Sat -> getValue seq