使用延续单子上`Set`（与约束其他容器）构造有效单子实例(Constructing efficie

Set ，类似于[]已完全定义一元操作。 问题是，它们要求值满足Ord约束，所以这是不可能的定义return和>>=不受任何约束。 同样的问题也适用于需要某种可能的值约束的很多其他数据结构。

标准的把戏（在向我建议哈斯克尔咖啡厅后 ）是包装Set成延续单子。 ContT并不关心底层型仿函数具有任何约束。 包装成为唯一需要的约束时/展开Set s转换/从延续：

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] 如果我们用[]单子相反，我们会得到

[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操作都在年底进行，而不是每个一元计算后执行它们。 其结果是，许多成倍Set s的建造和union只是在最后，这是最不能接受的任务编。

有什么办法解决它，使这个建设高效？ 我试过，但没有成功。

（我甚至怀疑，有可能是某些类型的从咖喱霍华德同构和下面的理论极限Glivenko定理 。Glivenko定理说，对于任何命题同义反复φ公式¬¬φ可以在直觉逻辑来证明。但是，我怀疑证明（在正常的形式）的长度可成倍长。所以，也许，有可能包装计算入延续单子时，会使其成倍不再是个案？）

Answer 1:

单子结构和排序计算的一个特定的方式。 一个单子的绑定无法神奇地调整你的计算，以便以更有效的方式发生。 有两个问题与你组织你的计算方式。

1. 当评估stepN 20 0 ，结果step 0将被计算的20倍。 这是因为计算的每个步骤产生0作为一个替代方案中，然后将其馈送到下一步骤，这也产生0作为替代，等等...

   或许有点记忆化的这里可以提供帮助。

2. 一个更大的问题是效果ContT您计算的结构。 带着几分等式推理，向外扩展的结果replicate 20 step ，定义foldrM简化了多次必要，我们可以看到， stepN 20 0相当于：

    (...(return 0 >>= step) >>= step) >>= step) >>= ...) 

   这个表达式联想到左边的所有括号。 这是伟大的，因为这意味着每次出现的RHS (>>=)是一个基本的计算，即step ，而不是由一个。 然而，在定义的缩放(>>=)用于ContT ，

    m >>= k = ContT $ \c -> runContT m (\a -> runContT (ka) c) 

   我们看到，评估的链时(>>=)关联到左边，每个绑定将推送新计算到当前延续c 。 为了说明到底是怎么回事，我们可以再次使用了一下等式推理，扩大了这个定义(>>=)和定义runContT ，并简化，得到以下特性：

    setReturn 0 `setBind` (\x1 -> step x1 `setBind` (\x2 -> step x2 `setBind` (\x3 -> ...)...) 

   现在，每次出现setBind ，让我们扪心自问RHS论点是什么。 最左边的发生，RHS参数是计算后所有的剩余setReturn 0 。 对于第二次出现，这一切后step x1等让我们放大到定义setBind ：

    setBind set f = foldl' (\s -> union s . f) empty set 

   这里f代表计算的所有其他人都对发生的右侧setBind 。 这意味着，在每一个步骤中，我们正在捕获的计算作为其余f ，并施加f因为有在元件多次set 。 该计算是不是基本和以前一样，而是组成，而这些计算将被复制多次。

问题的关键在于ContT单子转换正在改变着计算的初始结构，你的意思是作为一个左结合链setBind的，与不同结构的计算，即右结合链。 毕竟这是完全正常的，因为单子法律人说，对于每m ， f和g我们

(m >>= f) >>= g = m >>= (\x -> f x >>= g)

然而，单子法律并没有强加的复杂性保持在每法律方程的每一面相同。 事实上，在这种情况下，构建这个计算的左结合的方法是很多更有效。 左联链setBind的评估在任何时间，因为只有小学subcomputations被复制。

事实证明，其他的解决方案shoehorning Set成一个单子也有同样的问题。 特别地， 设定单子包，产生类似的运行时间。 是的原因，这也改写左结合表达式为右结合的。

我想你已经把手指放在一个非常重要又相当微妙的问题 ，坚持Set服从一个Monad接口。 而且我不认为它可以解决的。 的问题是，一个单子的绑定的类型需要是

(>>=) :: m a -> (a -> m b) -> m b

即，没有类约束允许在任a或b 。 这意味着，我们不能嵌套结合在左边，而无需首先调用单子法律改写成右结合链。 原因如下：给定的(m >>= f) >>= g ，计算的类型(m >>= f)的形式为mb 。 计算的值(m >>= f)的类型为b 。 但是，因为我们不能挂任何类约束到类型变量b ，我们无法知道该值，我们得到满足的Ord约束，因此不能使用这个值作为上，我们希望能够一组元素计算union的。

Answer 2:

最近关于Haskell的咖啡馆奥列格举了一个例子如何实现Set有效的单子。 引用：

......然而，高效的正版套装单子是可能的。

...封闭是有效的正版套装单子。 我写它直接的风格（这似乎是更快，反正）。 关键是要使用的时候，我们可以优化选择功能。

  {-# 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 xy) 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 xy) choose :: MonadPlus m => [a] -> ma 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 fn = 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 fn = 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 “限制单子”

我不知道如果我相信你对Glivenko定理导致（标准化）证明大小指数增长要求 - 在Call-BY-需要上下文至少。 这是因为我们可以任意重用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

（这种方法的问题是在一元值的功能，例如，该情况m (a -> b)因为它们不能满足像约束Ord (a -> b) ，所以人们不能使用像组合子<*>或ap ），用于该约束Set单子。）

文章来源: Constructing efficient monad instances on `Set` (and other containers with constraints) using the continuation monad