1). история

2). replicateM 1000000 randomNorm

3). использовать mwc-random или mersenne-random, и навсегда забыть про стандартный.

2). replicateM 1000000 randomNorm

спасибо, но все равно stack overflow

3). использовать mwc-random или mersenne-random, и навсегда забыть про стандартный.

Я посмотрю, но пусть randomNorm делала бы что-то другое, не связанное со случайными числами. Тогда что?

стандартный random «течет», просто не используй его, тогда проще будет определить есть ли проблемы в текущем коде.

а так вместо return в randomNorm сделать evaluate. в остальном вроде должно работать, хотя может глаз замылился..

{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}
import Foreign.C
import Control.Monad
import Data.List


foreign import ccall "rand" c_rand :: IO CInt
rand :: IO Double
rand = do
    x <- c_rand
    return $ fromIntegral (x `mod` 32657) / 32657

randomNorm :: IO Double
randomNorm = do
    u <- rand
    v <- rand
    return $! (sqrt ((-2) * log u) * cos (2*pi*v))
    

sum' = foldl1' (+)

main = do
    print =<< (liftM sum' $ replicateM 1000000 randomNorm)          

Проблема-то не в рандоме. Или не только в нем.

Вот эти два варианта работают правильно

print =<< (foldM (\s getA -> do { x <- getA; return $! (x+s)}) 0 $ replicate 1000000 randomNorm)
print =<< (foldM (\s _ -> do { x <- randomNorm; return $! (x+s)}) 0 $ [1..1000000])

Но мне эти варианты не нравятся. Мне, по сути, пришлось писать свою монадическую версию sum, вместо простого liftM sum

Проблема была в replicateM

{-# LANGUAGE BangPatterns #-}
import System.Random
import Data.List
import Control.Monad
import Control.DeepSeq

randomNorm :: IO Double
randomNorm = do
	u <- randomIO
	v <- randomIO
	let res = (sqrt ((-2) * log u) * cos (2*pi*v))
	res `deepseq` return res

sum' = foldl1' (+)

replicateM' :: Int -> IO Double -> [Double] -> IO [Double]
replicateM' !n !elem !a
	| n == 0 = return a
	| otherwise = elem >>= \e -> replicateM' (n-1) elem (e:a)

main = do
	print =<< (liftM sum' $ replicateM' 1000000 randomNorm [])

Просто foldM — это комбинация sequence и fold. Семантика такова, что sequence :: [m a] -> m [a] нужно отработать все монадические действия из списка [m a], чтобы получить ответ m [a]. Поэтому тот волнующий тебя код сначала делает кучу чисел и только потом их все складывает.

почему sum не использует строгую версию foldl?

По мелочи:

import System.Random
import Data.List

randomNorm :: IO Double
randomNorm = do
  u <- randomIO
  v <- randomIO
  return $! sqrt (-2 * log u) * cos (2 * pi * v)
  --     ^ rnf (x :: Double) = x `seq` ()

sum' :: Num a => [a] -> a
sum' = foldl' (+) 0

reverseReplicateM :: Monad m => Int -> m a -> m [a]
-- ^
-- > reverseReplicateM 2 getLine
-- 1
-- 2
-- ["2","1"]
reverseReplicateM n_ e = go n_ [] where
  go n a = if n <= 0 then return a else e >>= go (n - 1) . (: a)

main :: IO ()
main = print =<< sum' `fmap` reverseReplicateM 1000000 randomNorm

Вопрос: как это дело переписать красиво, идиоматично и так, чтобы работало, конечно.

Например, на стрелках. Единственный вариант, который я пока вижу. Нужно просто-типизированное LC это будет одна конструкция из стрелок/2-стрелок, нужно LC с зависимыми типами - другая, с субструктурными (линейными, в частности) - ещё третья. Т.е. фиксированное подмножество теории категорий само по себе довольно бедная метатеория, просто язык, в котором можно выразить все эти вещи. Мартин-Лёф предлагал формулировать разные теории типов в рамках метатеории LF, вот также это можно делать в рамках метатеории ТК.

Ну, например, берём декартово-замкнутую категорию Set, она же классический топос, т.е. категория всех малых множеств и тотальных функций, в agda она так и называется - «Set». Берём категорию всех малых категорий и функторов Cat (Set1 в agda) и утверждаем:

• Любой тип который может использоваться (ADTs, GADTs, Inductive families) это объект Set (объект топоса, в общем случае), т.е., как следствие, множество - множество всех термов данного типа.
• Любой параметрически-полиморфный тип это эндофунктор на Set, т.е. специального вида стрелка в Cat. (Непараметрический тип, который объект в Set, это вырожденный случай функтора из терминальной категории (как-то так)).
• Любой конструктор типа данных который может быть это стрелка в Set (стрелка в топосе, вообще).
• Любая функция которая может быть это тоже стрелка в Set, но отдельным классом (чтобы не путать стрелки-конструкторы и стрелки-функции). Как следствие, «функция» - тотальная функция между множествами.
• Любая композиция стрелок с учётом декартовых произведений и экспоненциалов это любой правильно составленный терм в данной системе (тут типизация из коробки).
• Любое определение конкретной редукции это 2-стрелка (струнная диаграмма).
• Любой конкретный ход редукций (вычислений) это композиции 2-стрелок (струнных диаграмм). + Правила построения редукций из коробки.

Например:

-- Тут рисуем коммутативную диаграмму:
ℕ : Set
0 : 1 → ℕ
s : ℕ → ℕ

-- Продолжаем коммутативную диаграмму:
+ : ℕ → (ℕ → ℕ)

-- Рисуем две струнных диаграммы, которые можно сочетать:
e₁(+) : + ∘ a ∘ 0 ⇒ a
e₂(+) : + ∘ a ∘ (s ∘ b) ⇒ s ∘ (+ ∘ a ∘ b)

и это просто ТК (можно представить формальный синтаксис такого языка), безотносительно какого-либо ЯП, но понятно из каких ADT и функции это получилось.

Тут ещё интересно, что можно легко добавлять конструкторы и правила редукций (как если бы в хаскеле можно было дописывать ADT и pattern matching cases по разным модулям).

Сами по себе 2-стрелки это непосредственно струнные диаграммы, т.е., рисуя коммутативные диаграммы, получим схемы типов, рисуя струнные - flow chart.

• Любая конкретная оптимизация это 3-стрелка. Правила построения оптимизаций тоже из коробки.

Например, если есть линейная рекурсия:

f x = z
f y = g (f (h y))

(f не появляется в g и h), т.е.:

-- любая стрелка вида:
f : x + y → r

-- с 2-стрелками вида:
e₁(f) : f ∘ x ⇒ z
e₂(f) : f ∘ y ⇒ g ∘ f ∘ h ∘ y

то она убирается такой 3-стрелкой:

-- Рисуем диаграмму между струнными:
o(f, f′) : e(f) ≡> e(f′ ∘ z)

-- TCO форма:
e₁(f′) : f′ ∘ a ∘ x ⇒ a
e₂(f′) : f′ ∘ a ∘ y ⇒ f′ ∘ (g ∘ a) ∘ (h ∘ y)

и остаётся только TCO.

Процесс унификации по 3-стрелкам это процесс оптимизаций, а процесс унификации по 2-стрелкам - интерпретации или компиляции (тогда нужен target). Как компилировать в target - конструкторы, например, достаточно точно отражаются в си-подобные структуры и объединения в памяти, можно даже в случае (s : ℕ → ℕ) или (_:_ : a → [a] → [a]) или вообще (con : [no `t' appears] → t → t) пытаться делать не связные списки, а аллоцируемые/реаллоцируемые массивы. Про компиляцию редукций ничего не скажу - только, наверно, тут, в первую очередь, нужен критерий линейности представляемого терма и/или его линеаризация.

Хотя такой вариант ест уже кучу.

А вот вариант с foldM/replicate нормально фьюзится. Можно вместо sum' написать sumM :: (Monad m, Num a) => [m a] -> m a:

sumM :: (Monad m, Num a) => [m a] -> m a
sumM = foldM (\a e -> (return $!) . (+ a) =<< e) 0

main :: IO ()
main = print =<< sumM (replicate 10000000 randomNorm)

Видимо, [m a] -> m a и [a] -> a это разные вещи, первое как liftM sum' . sequence от второго не работает в константной памяти. Как и liftM sum' . replicateM (replicateM n x = sequence (replicate n x)).

не вижу замены рандома на evaluate... :)

я правильно понял, что проблема аж sequence:

main = do
    print =<< ({-replicateM-} sequence (replicate 1000000 randomNorm))

randomNorm = return 42
{-# NOINLINE randomNorm #-}

т.к.

sequence       :: Monad m => [m a] -> m [a] 
{-# INLINE sequence #-}
sequence ms = foldr k (return []) ms
            where
              k m m' = do { x <- m; xs <- m'; return (x:xs) }

а всё потому, что нужно разделять IO и чистые вычисления:

import Control.Applicative
import Data.List
import System.Random.Mersenne

normal :: [Double] -> [Double]
normal (u:v:xs) = (sqrt ((-2) * log u) * cos (2*pi*v)) : normal xs

sum_sum   :: [Double] -> Double
sum_sum    = sum 
sum_foldl  = foldl1 (+)
sum_foldl' = foldl1' (+)
sum_foldr  = foldr1 (+)

main = do
    print =<< (sum_foldl . take 1000000 . normal) <$> (randoms =<< getStdGen)

ключевой пункты:

1). в одно действие генерируем случайные числа нормальным генератором, это единственное (кроме вывода) IO, всё остальное чистое.

2). делаем нужное распределение normal, и вытаскиваем нужное кол-во элементов, из-за ленивости всё хорошо

3). обрабатываем левой сверткой, соотв foldl(') будут работать, sum и foldr - нет.

а в MWC-random есть разные распределения изкоробки.

что примечательно разницы между foldl и foldl' не будет:

benchmarking foldl
mean: 18.65592 ns, lb 18.64342 ns, ub 18.68222 ns, ci 0.950
std dev: 88.86349 ps, lb 52.34942 ps, ub 172.0213 ps, ci 0.950

benchmarking foldl'
mean: 18.78176 ns, lb 18.70317 ns, ub 18.92129 ns, ci 0.950
std dev: 524.2704 ps, lb 332.6551 ps, ub 776.8505 ps, ci 0.950
found 10 outliers among 100 samples (10.0%)
  2 (2.0%) high mild
  8 (8.0%) high severe

я правильно понял, что проблема аж sequence

Да

liftM sum . replicateM n
==
                 replicateM n
            ~~~~~~~~~~~~~~~~~~~~~~
liftM sum . sequence . replicate n
~~~~~~~~~~~~~~~~~~~~
        sumM
==
sumM . replicate n

падают, тогда как sumM . replicate n при sumM через хвостовой foldM в обход replicate — работает.

http://comments.gmane.org/gmane.comp.lang.haskell.libraries/20113

что примечательно разницы между foldl и foldl' не будет

Разницы между foldl/foldl' на числах и sum/sum' в частности нет начиная с -O1 — видно, что много всего происходит в -ddump-simpl-stats, так что в итоге -ddump-simpl идентичны (с точностью до gensym-ов). Как и bang-patterns при оптимизациях часто не нужны (в base, например, не особо их видно).

соотв foldl(') будут работать, sum и foldr - нет

http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html...

Просто там INLINE/INLINABLE не хватает.

Всем большое спасибо! =)

мне кажется, что с INLINABLE ты сломаешь foldr/build дефорестификацию.

вообще стандартные правила, что для ленивых данных левая свертка, для строгих и deforestation - правую.

{-# INLINE sum #-} или {-# INLINABLE sum #-} в Data.List что-то сломает? И sum в любом случае и так левый/хвостовой, foldr/build никак не задействует.

Вообще опыт показывает, что точно такой же sum как в base, но в модуле пакета в котором находится клиентский код, либо такой же sum с INLINE/INLINABLE в модуле внешнего по отношению к клиентскому коду пакета, установленного по cabal install, начиная с -O1 ведёт себя нормально — как твой sum_foldl/sum_foldl'. То есть проблема в том, что не видны сорцы sum, INLINE/INLINABLE это решают.

Та же история с обобщением до Num и SPECIALISE.

для ленивых данных левая свертка, для строгих и deforestation - правую.

Может наоборот? sum, product — очевидно левые/хвостовые, так как тупо циклы с _коммутативной_ операцией, partition, unzip, unwords — правые/рекурсивные-over-cons, так как _порядок_ добавления элементов из ленивого потока играет роль (take 5 $ fst $ partition odd [1 ..], take 5 $ fst $ unzip $ let xs = (1, 1) : xs in xs, interact (unwords . take 5 . words)).

Может наоборот?

1). http://juick.com/ka3a4ok/2492253?view=list по нику @klapaucius я примерно тоже говорю, но у него слова лучше подобраны.

2). весь Data.List записывается через foldr, как показывал Олег, и как можно потренироваться на досуге. (Для дефорестификации это правда не заюзать, т.к. для неё нужно чтобы функция, которой сворачиваем не содержала ветвлений).

sum, product — очевидно левые/хвостовые, так как тупо циклы с _коммутативной_ операцией, partition, unzip, unwords — правые/рекурсивные-over-cons, так как _порядок_ добавления элементов из ленивого потока играет роль (take 5 $ fst $ partition odd [1 ..], take 5 $ fst $ unzip $ let xs = (1, 1) : xs in xs, interact (unwords . take 5 . words)).

не очень понял к чему ты это...

P.S. да я называю deforestation - дефорестификацией, т.к. более хорошего термина не знаю.

http://juick.com/ka3a4ok/2492253?view=list#19 ?

Метафоричненько, я бы сказал :)

Ну я написал бы print $ foldl (\(!a, !n) e -> (a + e, n + 1)) (0, 0) $ replicate 500000 1, а что касается переписывания вещей через foldr и тотальной ленивости — 1) как бы дело не только в стеке, но и в куче (привет санкам), то что мы тут обсуждаем вообще можно делать без памяти — часто регистров хватит, 2) как-то я иногда наблюдаю ассемблерные выхлопы GHC не хуже GCC/Clang-овских (пример — обход bytestring-а левой свёрткой не хуже for по char*, modulo соглашение о вызовах и прочее), интересно, что будет при тотальной ленивости и правых свёртках (ничего хорошо при текущей ситуации, я думаю).

не очень понял к чему ты это

К тому, что foldl'/foldr обе ленивы по отношению к своему списку (тут хорошо дописать их предикатом останова — на бесконечном потоке продолжат обе работать), а применимость одной или другой диктуется свойствами сворачиваемой функции и типа результата. И на примере sum, product — часто скалярный тип результата, желательно _строгий_, желательно _строгая_ коммутативная операция, _левая_ свёртка; partition, unzip, unwords — _ленивый_ список в качестве результата и _ленивое_ некоммутативное конструирование в качестве функции свёртки, _правая_ свёртка. То есть я не понял «для ленивых данных левая свертка, для строгих [...] - правую.» — если говорить про обобщённое понятие свёртки, то именно foldl'/foldr _обе_ про _ленивый_ список , первую можно считать практически полезной вариацией второй (теоретически, как ты сказал, хватит второй), если говорить про тип результата — частично строгая вариация имеет смысл именно для левой свёртки. Если и есть какая-то связь, то у меня почему-то ассоциации «строгий (тип результата) — левая свёртка» и «ленивый — правая», но только из-за приведённых простейших примеров. Если сложнее, то сложнее, опять же, свойства типа результата и операции кажутся важнее чем строгий/ленивый.

(!a, !n)

Кстати, в RWH же было, либо так, либо строгий кортеж типа data Pair a b = Pair !a !b. Вообще это разумно, строгой свёртке (foldl у GHC заочно строгий) — строгие данные (в смысле deepseq).

http://hackage.haskell.org/package/strict

Я фигею

Разработчик: (разрабатывает системы)
Хаскелистu]: (переписывает sum с ленивого foldl на строгий foldl1', красиво и идиоматично)

У меня пару раз был space leak в долго-игрующих имитациях, приводящий к полному выеданию ОЗУ. Заменил на строгость - все заработало как надо. Была проблема с ленивостью при программировании на хаскеле. Теперь при вычислениях стараюсь использовать строгость.

Метафорично, это да, зато новичкам понятно. Про правую свертку - можно, это не значит, что нужно. Плюсы могут быть только там, где функция простая, там мы получаем foldr\build. Действительно, если мы распишем фолдр то это:

1°x1°x2°...°xN, где ° это ф-я сверьки, а 1 - начальный эл-т. При прав свёртке мы можем перевести использование стека, в использование кучи, напр. Ладно, тут набирать не удобно попробую завтра примеры расписать, про то где фолдр, где фрлдл я пока с тем что ты писал не до конца согласен.

Метафорично, это да, зато новичкам понятно

Просто оно порой таки прибывает, но не убывает. Например, если немного обленить Int:

data {- newtype -} A = A {- ! -} Int deriving Show
A x & A y = A $ {- $! -} x + y
main = print $ foldl (&) (A 0) $ take 1000000000 $ let as = A 1 : as in as

то будет — http://i.imgur.com/FYGBue1.png. Вообще ленивость как таковая может создавать сколь угодно большие структуры из санков в памяти, но сам язык не строгий, то есть программы отображаются в семантические домены определённым образом (не так как в строгом языке — можно завязывать узлы и не виснуть, например), а лень — просто один из способов реализации (и не самый лучший, поэтому есть strictness analysis и рассматривалась optimistic evaluation).

И другой пример — левая и правая свёртка по строгому массиву:

data View = Nil | Cons Word8 ByteString

viewL :: ByteString -> View
viewL bs = if B.null bs then Nil else Cons (B.head bs) (B.tail bs)

viewR :: ByteString -> View
viewR bs = if B.null bs then Nil else Cons (B.last bs) (B.init bs)

fold :: (ByteString -> View) -> (t -> Word8 -> t) -> t -> ByteString -> t
fold v f = go where go a bs = case v bs of { Nil -> a; Cons x xs -> go (f a x) xs }

foldL :: (a -> Word8 -> a) -> a -> ByteString -> a
foldL = fold viewL

foldR :: (a -> Word8 -> a) -> a -> ByteString -> a
foldR = fold viewR

никаких украшений, даёт в итоге

M.$wgo_info:
	testq %r9,%r9
	jle _c22L
	movzbl (%rsi,%r8,1),%eax
	// ...
	// e.g.
	// addq %rax,%r14
	// for (+)
	incq %r8
	decq %r9
	jmp M.$wgo_info
_c22L:

для левой и

M.$wgo_info:
	testq %r9,%r9
	jle _c22Y
	leaq -1(%r9),%rbx
	movq %r8,%rax
	addq %rbx,%rax
	movzbl (%rsi,%rax,1),%eax
	// ...
	decq %r9
	jmp M.$wgo_info
_c22Y:

для правой. За счёт того, что массив настоящий, head, tail, last и init — O(1), сделаны через простую индексацию и заинлайнены (то есть видны оптимизатору, в отличии от sum), так что в итоге левая и правая свёртки не особо отличаются — два цикла по куску памяти, просто разных сторон, а вся основная разница, собственно, в направлении обхода, как на картинках тут — http://en.wikipedia.org/wiki/Fold_(higher-order_function)#Folds_as_structural....

А в случае ленивых списков разница уже есть — например, собирать (строгое) скалярное значение, типа sum, _выгодно_ левой свёрткой, строить другую ленивую структуру на основе — правой.