Haskell 无限输入的不确定性
如果输入可以取无穷多个值,那么使用列表对不确定性建模是有问题的。比如说Haskell 无限输入的不确定性,haskell,monads,non-deterministic,Haskell,Monads,Non Deterministic,如果输入可以取无穷多个值,那么使用列表对不确定性建模是有问题的。比如说 pairs = [ (a,b) | a <- [0..], b <- [0..] ] 如果我们现在将其包装为单子,我们可以枚举所有可能的对 newtype Select a = Select { runSelect :: [a] } instance Monad Select where return a = Select [a] Select as >>= f = Select
pairs = [ (a,b) | a <- [0..], b <- [0..] ]
如果我们现在将其包装为单子,我们可以枚举所有可能的对
newtype Select a = Select { runSelect :: [a] }
instance Monad Select where
return a = Select [a]
Select as >>= f = Select $ as >>>= (runSelect . f)
pairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a,b)
这是一个更理想的结果。然而,如果我们要求使用三元组,那么输出的顺序就不那么“好”,我甚至不清楚最终是否包含了所有的输出--
请注意,(2,0,1)
出现在排序中的(0,1,1)
之前——我的直觉是,这个问题的一个好的解决方案将根据“大小”的一些概念对输出进行排序,这可能是算法的一个显式输入,也可能是隐式给定的(如本例中的“大小”输入的位置是其在输入列表中的位置)。当组合输入时,组合的“大小”应该是输入大小的某个函数(可能是总和)
对于我所缺少的这个问题,有一个优雅的解决方案吗?TL;DR:它一次展平两个维度,而不是一次展平三个维度。你不能在monad中整理这个,因为
>=
是二进制的,而不是三元的等等
我想你已经定义了
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor $ map f as
交叉排列列表列表
你喜欢它,因为它是对角的:
sums = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a+b)
因此,保持“大小”有序是一件令人愉快的事情,但是对于三元组,这种模式似乎被打破了,你怀疑完整性,但你不需要。它也在做同样的把戏,但是两次,而不是三次同时进行:
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
和(添加一些空格/换行符以清晰模式):
所以你可以看到它使用完全相同的模式。这并不能保持总的和,也不应该,因为我们先把二维展平,然后再把第三个展平,得到三维。这种模式是模糊的,但它也保证能排到列表的末尾
不幸的是,如果你想以一种求和的方式进行三维计算,你必须编写cantor2
,cantor3
和cantor4
函数,可能是一个cantorN
函数,但你必须抛弃一元接口,它本质上是基于>=
的括号,因此,一次两次展平维度。正确的多维枚举数可以用临时状态对象表示
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
这里,N
维度空间由枚举已经和没有触及的N-1
维度子空间列表的元组表示
然后,您可以使用以下命令生成一个有序的列表
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
.导入控制。应用程序
导入控制。箭头
数据选择a=选择[a]
|选择[选择一个]
实例函子选择位置
fmap f(选择x)=选择$map f x
fmap f(选择xss)=选择$map(fmap f)xss
实例应用程序选择位置
纯=选择。(:[])
Select fs xs=选择$map(`fmap`xs)fs
选择fs xs=选择$map(xs)fs
实例Monad选择where
返回=纯
选择xs>>=f=选择$map f xs
选择xs>>=f=选择$map(>=f)xs
runSelect::选择a->[a]
runSelect=go 1
其中go n xs=uncurry(++)。第二个(go$n+1)$splitOff n xs
拆分n(选择xs)=第二次选择$splitAt n xs
拆分n(选择sls)=(concat hs,选择$tsl++rl)
其中((hs,tsl,rl)=第一个(解压映射(拆分n))$splitAt n sls
*选择>拍摄15张。runSelect$do{a包完全按照您的要求执行,并保证最终访问每个元素:
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
你能替换一下吗使用logict?也许吧!我会看看它是如何实现的。我对它感兴趣主要是出于教育原因,而不是因为我想用它做点什么。这真的很酷;我不知道如何给它一个很好的一元界面,但也许空间填充曲线的概念可以给你你想要的行为(因为它们可以是n维的)?为什么不在你的帖子中包含你的输出,这样我们就可以在点击和滚动的情况下看到它是多么令人愉快的对称?@chunksOf50,因为我构建空间对象的方式对于公众来说太丑陋了:D。
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
ghci> map fst $ take 36 pairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map fst $ take 36 triplePairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map snd $ take 36 pairs
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0]
ghci> map snd $ take 36 triplePairs
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0),
(1,1),(0,2),(1,0),(0,1),(0,0),
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)]
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
import Control.Applicative
import Control.Arrow
data Select a = Select [a]
| Selects [Select a]
instance Functor Select where
fmap f (Select x) = Select $ map f x
fmap f (Selects xss) = Selects $ map (fmap f) xss
instance Applicative Select where
pure = Select . (:[])
Select fs <*> xs = Selects $ map (`fmap`xs) fs
Selects fs <*> xs = Selects $ map (<*>xs) fs
instance Monad Select where
return = pure
Select xs >>= f = Selects $ map f xs
Selects xs >>= f = Selects $ map (>>=f) xs
runSelect :: Select a -> [a]
runSelect = go 1
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs
splitOff n (Select xs) = second Select $ splitAt n xs
splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl)
where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
-- | Convert a list into any MonadPlus.
each :: (MonadPlus m) => [a] -> m a
each = msum . map return
-- | A fair variant of '(<*>)` that ensures that both branches are explored.
(<@>) :: (MonadLogic m) => m (a -> b) -> m a -> m b
(<@>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k'))
infixl 4 <@>
main = print . observeMany 200 $
(,,) <$> each [0..] <@> each [0..] <@> each [0..]