Question

Set，与[]类似，具有完美定义的monadic操作。问题是它们要求值满足Ord约束，因此在没有任何约束的情况下定义return和>>=是不可能的。同样的问题适用于需要对可能值进行某种约束的许多其他数据结构。

标准技巧（在haskell-cafe post中向我建议）是将Set包装到continuation monad中。 ContT并不关心底层类型仿函数是否有任何约束。只有在将Set包装/展开到延续中时才需要约束：

import Control.Monad.Cont
import Data.Foldable (foldrM)
import Data.Set

setReturn :: a -> Set a
setReturn = singleton

setBind :: (Ord b) => Set a -> (a -> Set b) -> Set b
setBind set f = foldl' (\s -> union s . f) empty set

type SetM r a = ContT r Set a

fromSet :: (Ord r) => Set a -> SetM r a
fromSet = ContT . setBind

toSet :: SetM r r -> Set r
toSet c = runContT c setReturn

这可以根据需要使用。例如，我们可以模拟一个非确定性函数，该函数将其参数增加1或保持原样：

step :: (Ord r) => Int -> SetM r Int
step i = fromSet $ fromList [i, i + 1]

-- repeated application of step:
stepN :: Int -> Int -> Set Int
stepN times start = toSet $ foldrM ($) start (replicate times step)

确实，stepN 5 0会产生fromList [0,1,2,3,4,5]。如果我们使用[] monad，我们会得到

[0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5]

代替。

问题是效率。如果我们调用stepN 20 0，则输出需要几秒钟，stepN 30 0无法在合理的时间内完成。事实证明，所有Set.union操作都在最后执行，而不是在每次monadic计算后执行它们。结果是，指数化的Set被构造并且union仅在最后被编译，这对于大多数任务来说是不可接受的。

有什么方法可以使这种结构高效吗？我试过但没有成功。

（我甚至怀疑库里 - 霍华德同构和Glivenko's theorem之后可能存在某种理论上的限制。格利文科定理说，对于任何命题重言式φ公式 ¬¬φ可以用直觉逻辑来证明。但是，我怀疑证明的长度（正常形式）可能是指数长的。所以，也许，可能存在将计算包装到延续monad中的情况会使它成倍增长吗？）

Answer 1

Monads是结构化和排序计算的一种特殊方式。 monad的绑定不能神奇地重构你的计算，以便以更有效的方式发生。您计算结构的方式存在两个问题。

评估stepN 20 0时，step 0的结果将被计算20次。这是因为计算的每一步都产生0作为一种替代方案，然后将其输入下一步，这也产生0作为替代，依此类推......

也许这里的一些记忆可以提供帮助。
更大的问题是ContT对计算结构的影响。通过一些等式推理，扩展replicate 20 step的结果，foldrM的定义并根据需要简化多次，我们可以看到stepN 20 0相当于：
```
(...(return 0 >>= step) >>= step) >>= step) >>= ...)
```
此表达式的所有括号都与左侧相关联。这很好，因为它意味着(>>=)每次出现的RHS是一个基本计算，即step，而不是一个组合的。但是，放大(>>=)的{{1}}定义，
```
ContT
```
我们看到，在评估与左侧相关联的m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c)链时，每个绑定都会将新计算推送到当前延续(>>=)。为了说明正在发生的事情，我们可以再次使用一些等式推理，扩展c的定义和(>>=)的定义，并简化，屈服：
```
runContT
```
现在，对于setReturn 0 `setBind` (\x1 -> step x1 `setBind` (\x2 -> step x2 `setBind` (\x3 -> ...)...)的每次出现，让我们问自己RHS的论点是什么。对于最左边的事件，RHS参数是setBind之后的整个计算的其余部分。对于第二次出现，它是setReturn 0之后的所有内容，等等。让我们放大step x1的定义：
```
setBind
```
此处setBind set f = foldl' (\s -> union s . f) empty set表示计算的其余部分，所有位于f出现的右侧。这意味着在每一步中，我们将剩余的计算捕获为setBind，并将f应用于f中的元素的次数。计算不像以前那样基本，而是组成，这些计算将重复多次。

问题的症结在于set monad变换器正在将计算的初始结构（您将其作为ContT的左关联链）转换为具有不同的计算结构，即右联想链。这毕竟是完全正常的，因为其中一个monad法律规定，对于setBind，m和f，我们有

然而，monad定律并未强调每个定律的方程式的每一侧的复杂性都是相同的。实际上，在这种情况下，构造此计算的左关联方式更有效。 (m >>= f) >>= g = m >>= (\x -> f x >>= g)的左关联链很快就会计算出来，因为只有基本的子计算是重复的。

事实证明，使setBind成为monad的其他解决方案也会遇到同样的问题。特别是，set-monad包产生类似的运行时。原因是，它也将左关联表达式重写为右关联表达式。

我认为你坚持Set遵守Set界面，已经指出非常重要而又相当微妙的问题。我不认为它可以解决。问题是monad的绑定类型需要

Monad

即，(>>=) :: m a -> (a -> m b) -> m b或a都不允许类约束。这意味着我们不能在左边嵌套绑定，而不首先调用monad定律来重写为正确的关联链。原因如下：给定b，计算类型(m >>= f) >>= g的格式为(m >>= f)。计算m b的值为(m >>= f)类型。但是因为我们不能将任何类约束挂起到类型变量b上，我们无法知道我们得到的值满足b约束，因此不能将此值用作a的元素设置我们希望能够计算Ord的。

Answer 2

最近在Haskell Cafe Oleg gave an example上如何有效地实施Set monad。引用：

......然而，有效的真正的Set monad是可能的。

... 附上有效的正版Set monad。我是以直接的方式写的（无论如何它似乎更快）。关键是我们可以使用优化的选择功能。

  {-# LANGUAGE GADTs, TypeSynonymInstances, FlexibleInstances #-}

  module SetMonadOpt where

  import qualified Data.Set as S
  import Control.Monad

  data SetMonad a where
      SMOrd :: Ord a => S.Set a -> SetMonad a
      SMAny :: [a] -> SetMonad a

  instance Monad SetMonad where
      return x = SMAny [x]

      m >>= f = collect . map f $ toList m

  toList :: SetMonad a -> [a]
  toList (SMOrd x) = S.toList x
  toList (SMAny x) = x

  collect :: [SetMonad a] -> SetMonad a
  collect []  = SMAny []
  collect [x] = x
  collect ((SMOrd x):t) = case collect t of
                           SMOrd y -> SMOrd (S.union x y)
                           SMAny y -> SMOrd (S.union x (S.fromList y))
  collect ((SMAny x):t) = case collect t of
                           SMOrd y -> SMOrd (S.union y (S.fromList x))
                           SMAny y -> SMAny (x ++ y)

  runSet :: Ord a => SetMonad a -> S.Set a
  runSet (SMOrd x) = x
  runSet (SMAny x) = S.fromList x

  instance MonadPlus SetMonad where
      mzero = SMAny []
      mplus (SMAny x) (SMAny y) = SMAny (x ++ y)
      mplus (SMAny x) (SMOrd y) = SMOrd (S.union y (S.fromList x))
      mplus (SMOrd x) (SMAny y) = SMOrd (S.union x (S.fromList y))
      mplus (SMOrd x) (SMOrd y) = SMOrd (S.union x y)

  choose :: MonadPlus m => [a] -> m a
  choose = msum . map return


  test1 = runSet (do
    n1 <- choose [1..5]
    n2 <- choose [1..5]
    let n = n1 + n2
    guard $ n < 7
    return n)
  -- fromList [2,3,4,5,6]

  -- Values to choose from might be higher-order or actions
  test1' = runSet (do
    n1 <- choose . map return $ [1..5]
    n2 <- choose . map return $ [1..5]
    n  <- liftM2 (+) n1 n2
    guard $ n < 7
    return n)
  -- fromList [2,3,4,5,6]

  test2 = runSet (do
    i <- choose [1..10]
    j <- choose [1..10]
    k <- choose [1..10]
    guard $ i*i + j*j == k * k
    return (i,j,k))
  -- fromList [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]

  test3 = runSet (do
    i <- choose [1..10]
    j <- choose [1..10]
    k <- choose [1..10]
    guard $ i*i + j*j == k * k
    return k)
  -- fromList [5,10]

  -- Test by Petr Pudlak

  -- First, general, unoptimal case
  step :: (MonadPlus m) => Int -> m Int
  step i = choose [i, i + 1]

  -- repeated application of step on 0:
  stepN :: Int -> S.Set Int
  stepN = runSet . f
    where
    f 0 = return 0
    f n = f (n-1) >>= step

  -- it works, but clearly exponential
  {-
  *SetMonad> stepN 14
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14]
  (0.09 secs, 31465384 bytes)
  *SetMonad> stepN 15
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
  (0.18 secs, 62421208 bytes)
  *SetMonad> stepN 16
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
  (0.35 secs, 124876704 bytes)
  -}

  -- And now the optimization
  chooseOrd :: Ord a => [a] -> SetMonad a
  chooseOrd x = SMOrd (S.fromList x)

  stepOpt :: Int -> SetMonad Int
  stepOpt i = chooseOrd [i, i + 1]

  -- repeated application of step on 0:
  stepNOpt :: Int -> S.Set Int
  stepNOpt = runSet . f
    where
    f 0 = return 0
    f n = f (n-1) >>= stepOpt

  {-
  stepNOpt 14
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14]
  (0.00 secs, 515792 bytes)
  stepNOpt 15
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
  (0.00 secs, 515680 bytes)
  stepNOpt 16
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
  (0.00 secs, 515656 bytes)

  stepNOpt 30
  fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30]
  (0.00 secs, 1068856 bytes)
  -}

Answer 3

我不认为您在这种情况下的性能问题是由于使用了Cont

step' :: Int -> Set Int
step' i = fromList [i,i + 1]

foldrM' f z0 xs = Prelude.foldl f' setReturn xs z0
  where f' k x z = f x z `setBind` k

stepN' :: Int -> Int -> Set Int
stepN' times start = foldrM' ($) start (replicate times step')

与基于Cont的实现具有相似的性能，但完全出现在Set“受限制的monad”中

我不确定我是否相信你对Glivenko定理的主张导致（标准化）证明大小呈指数增长 - 至少在Call-By-Need环境中。那是因为我们可以任意重复使用subproofs（我们的逻辑是二阶的，我们只需要一个forall a. ~~(a \/ ~a)的证明）。证明不是树，它们是图（共享）。

一般情况下，您可能会看到Cont包裹Set的效果成本，但通常可以通过

来避免

smash :: (Ord r, Ord k) => SetM r r -> SetM k r
smash = fromSet . toSet

Answer 4

我发现了另一种可能性，基于GHC的ConstraintKinds扩展。我们的想法是重新定义Monad，使其包含对允许值的参数约束：

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RebindableSyntax #-}

import qualified Data.Foldable as F
import qualified Data.Set as S
import Prelude hiding (Monad(..), Functor(..))

class CFunctor m where
    -- Each instance defines a constraint it valust must satisfy:
    type Constraint m a
    -- The default is no constraints.
    type Constraint m a = ()
    fmap   :: (Constraint m a, Constraint m b) => (a -> b) -> (m a -> m b)
class CFunctor m => CMonad (m :: * -> *) where
    return :: (Constraint m a) => a -> m a
    (>>=)  :: (Constraint m a, Constraint m b) => m a -> (a -> m b) -> m b
    fail   :: String -> m a
    fail   = error

-- [] instance
instance CFunctor [] where
    fmap = map
instance CMonad [] where
    return  = (: [])
    (>>=)   = flip concatMap

-- Set instance
instance CFunctor S.Set where
    -- Sets need Ord.
    type Constraint S.Set a = Ord a
    fmap = S.map
instance CMonad S.Set where
    return  = S.singleton
    (>>=)   = flip F.foldMap

-- Example:

-- prints fromList [3,4,5]
main = print $ do
    x <- S.fromList [1,2]
    y <- S.fromList [2,3]
    return $ x + y

（这种方法的问题在于monadic值是函数，例如m (a -> b)，因为它们不能满足像Ord (a -> b)这样的约束。所以不能像{一样使用组合器这个约束<*> monad的{1}}（或ap）。

使用continuation monad在`Set`（以及具有约束的其他容器）上构造有效的monad实例

4 个答案: