在随机光线跟踪器的背景下，我想从样本生成（均匀随机，分层，泊松，大都市......）中分离MC积分（路径跟踪，双向路径跟踪）。其中大部分已经实施，但使用起来很繁琐。所以我放弃了，并尝试通过分两个阶段分割采样计算来构建更好的东西：在SampleGen中，您可以使用mk1d和mk2d函数请求随机值，然后使用Float和SampleRun函数通过采样算法提供实际{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Applicative
import Control.Monad.State.Strict
import Control.Monad.Primitive
import System.Random.MWC as MWC
-- allows to construct sampled computations
newtype SampleGen s m a = SampleGen (StateT s m a)
deriving ( Functor, Applicative, Monad
, MonadState s, MonadTrans )
-- allows to evaluate sampled computations constructed in SampleGen
newtype SampleRun s m a = SampleRun (StateT s m a)
deriving ( Functor, Applicative, Monad
, MonadState s )
-- a sampled computation, parametrized over the generator's state g,
-- the evaluator's state r, the underlying monad m and the result
-- type a
type Sampled g r m a = SampleGen g m (SampleRun r m a)
----------------------
-- Stratified Sampling
----------------------
-- | we just count the number of requested 1D samples
type StratGen = Int
-- | the pre-computed values and a RNG for additional ones
type StratRun m = ([Float], Gen (PrimState m))
-- | specialization of Sampled for stratified sampling
type Stratified m a = Sampled StratGen (StratRun m) m a
-- | gives a sampled value in [0..1), this is kind
-- of the "prime" value, upon which all computations
-- are built
mk1d :: PrimMonad m => Stratified m Float
mk1d = do
n1d <- get
put $ n1d + 1
return $ SampleRun $ do
fs <- gets fst
if length fs > n1d
then return (fs !! n1d)
else gets snd >>= lift . MWC.uniform
-- | gives a pair of stratified values, should really also
-- be a "prime" value, but here we just construct them
-- from two 1D samples for fun
mk2d :: (Functor m, PrimMonad m) => Stratified m (Float, Float)
mk2d = mk1d >>= \f1 -> mk1d >>= \f2 ->
return $ (,) <$> f1 <*> f2
-- | evaluates a stratified computation
runStratified
:: (PrimMonad m)
=> Int -- ^ number of samples
-> Stratified m a -- ^ computation to evaluate
-> m [a] -- ^ the values produced, a list of nsamples values
runStratified nsamples (SampleGen c) = do
(SampleRun x, n1d) <- runStateT c 0
-- let's just pretend I'd use n1d to actually
-- compute stratified samples
gen <- MWC.create
replicateM nsamples $ evalStateT x ([{- samples would go here #-}], gen)
-- estimate Pi by Monte Carlo sampling
-- mcPi :: (Functor m, PrimMonad m) => Sampled g r m Float
mcPi :: (Functor m, PrimMonad m) => Stratified m Float
mcPi = do
v <- mk2d
return $ v >>= \(x, y) -> return $ if x * x + y * y < 1 then 4 else 0
main :: IO ()
main = do
vs <- runStratified 10000 mcPi :: IO [Float]
print $ sum vs / fromIntegral (length vs)
s。可以在mcPi中检查这些值以进行实际计算。这里有一些代码，包含分层采样器的有趣部分，并且可以使用：
mcPi :: (Functor m, PrimMonad m) => Stratified m Float
这里缺少的部分是，在它的当前形式中，mcPi :: (Functor m, PrimMonad m) => Sampled g r m Float
函数具有类型
Sampled虽然它应该真的像
mcPi承认，SampleGen上的四个类型参数并不完美，但至少这样的东西会很有用。总之，我正在寻找一些允许表达像SampleRun这样独立于采样算法的计算的东西，例如：
SampleGen阶段维持任何状态，只需要SampleRun阶段的RNG SampleGen和{ {1}}实施，仅在SampleRun和SampleRun之间发生的情况有所不同（实际填充了向量）MultiParamTypeClasses阶段使用lazy sample generation技术我想使用GHC进行编译，因此TypeFamilies和{{1}}等扩展程序对我来说没问题，但我没有想出任何可以远程使用的扩展程序。
PS：作为动机，有些pretty pictures。其当前表单中的代码位于GitHub
答案 0 :(得分：3)
我将从一个完全不同的问题开始，＆＃34;代码应该是什么样的＆＃34;？，然后努力解决问题＆＃34;如何将抽样框架放在一起＆ ＃34;？
mcPi的定义应为
mcPi :: (Num s, Num p) => s -> s -> p
mcPi x y = if x * x + y * y < 1 then 4 else 0
pi的蒙特卡罗估计是，给定两个数字（碰巧来自区间[0..1））pi是一个正方形的区域，如果它们落在一个圆圈内，否则它是0. pi的蒙特卡洛估计对计算一无所知。它不知道它是否会被重复，或者关于数字来自何处。它确实知道数字应该均匀分布在正方形上，但这是一个针对不同问题的主题。 pi的蒙特卡罗估计只是从样本到估计的函数。
其他随机事物会知道它们是随机过程的一部分。一个简单的随机过程可能是：翻转硬币，如果硬币出现＆＃34;头部＆＃34;，再翻转它。
simpleRandomProcess :: (Monad m, MonadCoinFlip m) => m Coin
simpleRandomProcess =
do
firstFlip <- flipACoin
case firstFlip of
Heads -> flipACoin
Tails -> firstFlip
这个随机过程希望能够看到像
这样的东西data Coin = Heads | Tails
class MonadCoinFlip m where
flipACoin :: m Coin -- The coin should be fair
随机过程可能会根据之前实验的结果更改所需的随机数据量。这表明我们最终需要提供Monad。
您希望从样本生成（均匀随机，分层，泊松，大都市，......）中解耦MC集成（路径跟踪，双向路径跟踪）＆＃34;。在您的示例中，他们都想要对浮点数进行采样。这表明以下课程
class MonadSample m where
sample :: m Float -- Should be on the interval [0..1)
除了两件事之外，这与existing MonadRandom class非常相似。 MonadRandom实现基本上需要在其自己选择的某个范围内提供一致的随机Int。您的采样器将在间隔[0..1]上提供未知分布的Float样本。这是不同的，足以证明拥有自己的新课程。
由于即将发生的Monad Applicative更改，我将为此课程SampleSource建议一个不同的名称。
class SampleSource f where
sample :: f Float -- Should be on the interval [0..1)
sample替换代码中的mk1d。 mk2d也可以被替换，同样不知道样本的来源是什么。 sample2d的替代mk2d将适用于任何Applicative示例来源，它不需要它为Monad。它不需要Monad的原因是它不会根据样本的结果来决定要获取多少样本或做什么？它的计算结构是提前知道的。
sample2d :: (Applicative f, SampleSource f) => f (Float, Float)
sample2d = (,) <$> sample <*> sample
如果您要允许样本源引入维度之间的交互，例如Poisson磁盘采样，则需要将其添加到接口，或者显式枚举维度
class SampleSource f where
sample :: f Float
sample2d :: f (Float, Float)
sample3d :: f (Float, Float, Float)
sample4d :: f (Float, Float, Float, Float)
或使用一些矢量库。
class SampleSource f where
sample :: f Float
samples :: Int -> f (Vector Float)
现在，我们需要描述每个示例源如何用作SampleSource。例如，我会针对其中一个最差的样本来源实施SampleSource。
newtype ZeroSampleSourceT m a = ZeroSampleSourceT {
unZeroSampleSourceT :: IdentityT m a
} deriving (MonadTrans, Monad, Functor, MonadPlus, Applicative, Alternative, MonadIO)
instance (Monad m) => SampleSource (ZeroSampleSourceT m a) where
sample = return 0
runZeroSampleSourceT :: (Monad m) => ZeroSampleSourceT m a -> m a
runZeroSampleSourceT = runIdentityT . unZeroSampleSourceT
如果所有Monad都是Applicative，我会写
instance (Applicative f) => SampleSource (ZeroSampleSourceT f) where
sample = pure 0
我还将实施MWC制服SampleSource。
newtype MWCUniformSampleSourceT m a = MWCUniformSampleSourceT m a {
unMWCUniformSampleSourceT :: ReaderT (Gen (PrimState m)) m a
} deriving (MonadTrans, Monad, Functor, MonadPlus, Applicative, Alternative, MonadIO)
runMWCUniformSampleSourceT :: MWCUniformSampleSourceT m a -> (Gen (PrimState m)) -> m a
runMWCUniformSampleSourceT = runReaderT . unMWCUniformSampleSourceT
-- MWC's uniform generates floats on the open-closed interval (0,1]
uniformClosedOpen :: PrimMonad m => Gen (PrimState m) -> m Float
uniformClosedOpen = fmap (\x -> x - 2**(-33)) . uniform
instance (PrimMonad m) => SampleSource (MWCUniformSampleSourceT m) where
sample = MWCUniformSampleSourceT . ReaderT $ uniformClosedOpen
我们不会完全实施Stratified或runStratified，因为您的示例代码并未包含完整的实现。
我不确定你想要做什么＆＃34;分层＆＃34;采样。预生成数字，并且当这些数字耗尽时使用生成器并不是我所理解的分层抽样。如果您要为某些东西提供monadic接口，您将无法提前告知将要执行的内容，因此您无法预测计算所需的样本数量。开始执行它。如果您只能使用Applicative接口，那么您可以提前测试整个计算需要多少样本。
如果单次采样可能取决于所需的样本数量和维数，例如Poisson Disk采样，则需要将这些采样传递给采样器。
class SampleSource f where
sample :: f Float
samples :: Int -> f ([Float])
sampleN :: Int -> f (Vector Float)
samplesN :: Int -> Int -> f ([Vector Float])
您可以将其概括为任意形状的任意形状的采样，这是我们在下一次飞跃时需要做的事情。
我们可以非常非常详细地为请求样本制作Applicative查询语言。该语言需要在Applicative已经完成的任务之上添加两个功能。它需要能够重复请求，并且需要将样本请求组合在一起以确定哪些分组是有意义的。它的动机来自以下代码，它希望获得6个不同的2d样本，其中sample2d与我们的第一个定义相同。
take 6 (repeat sample2d)
首先，我们需要能够一遍又一遍地重复。最好的方法是，如果我们可以写，例如
take 6 (repeat sample) :: SampleSource f => [f Float]
我们需要一种从[f a]到f [a]的方法。这已经存在;它是Data.Traversable的{{1}}，要求sequenceA为f。所以我们已经从Applicative重复了一遍。
Applicative要将请求组合在一起，我们会向sequenceA . take 6 . repeat $ sample2d
添加一个有意义的分组功能。
mark和一个可以标记某些分组的东西的类。如果我们需要更多的意义而不仅仅是分组 - 例如，如果内部事物应该依赖或独立，我们将在此处添加。
sequenceA . take 6 . repeat . mark $ sample2d
如果一切都非常同质，我们可能会为可查询的样本源添加一个类
class Mark f where
mark :: f a -> f a
现在我们将讨论具有更优化查询语言的monad的想法。在这里，我们将开始使用所有这些特定于GHC的扩展;特别是class (Applicative f, Mark f, SampleSource f) => QueryableSampleSouce f where
。
TypeFamilies最后是一个使用class MonadQuery m where
type Query m :: * -> *
interpret :: (Query m a) -> m a
查询语言
Applicative此时，我们想要弄清楚这些法律应遵循哪些法律。我建议一些：
class (MonadQuery m, QueryableSampleSource (Query m), SampleSource m, Monad m) => MonadSample m where
也就是说，如果没有interpret sample == sample
interpret (sequenceA a) = sequence (interpret a)
，示例来源就不会对查询做任何特别的事情。这意味着想要受Poisson磁盘特殊处理2d点的查询以及对该组点的特殊处理需要标记两次：
mark mark . sequenceA . take 6 . repeat . mark $ sample2d
查询语言排序与您的Applicative类型相对应;通过使用mearly StratGen接口，它允许您展望传入查询的结构。然后Applicative与您的Monad类型对应。