Почему этот код Haskell работает медленнее с -O?

Этот фрагмент кода Haskell работает намного медленнее с -O, но -O должен быть неопасно. Кто-нибудь может сказать мне, что случилось? Если это имеет значение, это попытка решить эту проблему, и он использует двоичный дерево поиска и постоянных сегментов:

import Control.Monad
import Data.Array

data Node =
      Leaf   Int           -- value
    | Branch Int Node Node -- sum, left child, right child
type NodeArray = Array Int Node

-- create an empty node with range [l, r)
create :: Int -> Int -> Node
create l r
    | l + 1 == r = Leaf 0
    | otherwise  = Branch 0 (create l m) (create m r)
    where m = (l + r) `div` 2

-- Get the sum in range [0, r). The range of the node is [nl, nr)
sumof :: Node -> Int -> Int -> Int -> Int
sumof (Leaf val) r nl nr
    | nr <= r   = val
    | otherwise = 0
sumof (Branch sum lc rc) r nl nr
    | nr <= r   = sum
    | r  > nl   = (sumof lc r nl m) + (sumof rc r m nr)
    | otherwise = 0
    where m = (nl + nr) `div` 2

-- Increase the value at x by 1. The range of the node is [nl, nr)
increase :: Node -> Int -> Int -> Int -> Node
increase (Leaf val) x nl nr = Leaf (val + 1)
increase (Branch sum lc rc) x nl nr
    | x < m     = Branch (sum + 1) (increase lc x nl m) rc
    | otherwise = Branch (sum + 1) lc (increase rc x m nr)
    where m = (nl + nr) `div` 2

-- signature said it all
tonodes :: Int -> [Int] -> [Node]
tonodes n = reverse . tonodes' . reverse
    where
        tonodes' :: [Int] -> [Node]
        tonodes' (h:t) = increase h' h 0 n : s' where s'@(h':_) = tonodes' t
        tonodes' _ = [create 0 n]

-- find the minimum m in [l, r] such that (predicate m) is True
binarysearch :: (Int -> Bool) -> Int -> Int -> Int
binarysearch predicate l r
    | l == r      = r
    | predicate m = binarysearch predicate l m
    | otherwise   = binarysearch predicate (m+1) r
    where m = (l + r) `div` 2

-- main, literally
main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    nodes <- fmap (listArray (0, n) . tonodes n . map (subtract 1) . map read . words) getLine
    replicateM_ m $ query n nodes
    where
        query :: Int -> NodeArray -> IO ()
        query n nodes = do
            [p, k] <- fmap (map read . words) getLine
            print $ binarysearch (ok nodes n p k) 0 n
            where
                ok :: NodeArray -> Int -> Int -> Int -> Int -> Bool
                ok nodes n p k s = (sumof (nodes ! min (p + s + 1) n) s 0 n) - (sumof (nodes ! max (p - s) 0) s 0 n) >= k

(Это точно такой же код с проверкой кода, но этот вопрос решает другую проблему.)

Это мой генератор ввода на C ++:

#include <cstdio>
#include <cstdlib>
using namespace std;
int main (int argc, char * argv[]) {
    srand(1827);
    int n = 100000;
    if(argc > 1)
        sscanf(argv[1], "%d", &n);
    printf("%d %d\n", n, n);
    for(int i = 0; i < n; i++)
        printf("%d%c", rand() % n + 1, i == n - 1 ? '\n' : ' ');
    for(int i = 0; i < n; i++) {
        int p = rand() % n;
        int k = rand() % n + 1;
        printf("%d %d\n", p, k);
    }
}

Если у вас нет компилятора C ++, это результат ./gen.exe 1000.

Это результат выполнения на моем компьютере:

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.3
$ ghc -fforce-recomp 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m0.088s
user    0m0.015s
sys     0m0.015s
$ ghc -fforce-recomp -O 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m2.969s
user    0m0.000s
sys     0m0.045s

И это сводка профиля кучи:

$ ghc -fforce-recomp -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
      70,207,096 bytes allocated in the heap
       2,112,416 bytes copied during GC
         613,368 bytes maximum residency (3 sample(s))
          28,816 bytes maximum slop
               3 MB total memory in use (0 MB lost due to fragmentation)
                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0       132 colls,     0 par    0.00s    0.00s     0.0000s    0.0004s
  Gen  1         3 colls,     0 par    0.00s    0.00s     0.0006s    0.0010s
  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    0.03s  (  0.03s elapsed)
  GC      time    0.00s  (  0.01s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    0.03s  (  0.04s elapsed)
  %GC     time       0.0%  (14.7% elapsed)
  Alloc rate    2,250,213,011 bytes per MUT second
  Productivity 100.0% of total user, 83.1% of total elapsed
$ ghc -fforce-recomp -O -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
   6,009,233,608 bytes allocated in the heap
     622,682,200 bytes copied during GC
         443,240 bytes maximum residency (505 sample(s))
          48,256 bytes maximum slop
               3 MB total memory in use (0 MB lost due to fragmentation)
                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0     10945 colls,     0 par    0.72s    0.63s     0.0001s    0.0004s
  Gen  1       505 colls,     0 par    0.16s    0.13s     0.0003s    0.0005s
  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    2.00s  (  2.13s elapsed)
  GC      time    0.87s  (  0.76s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    2.89s  (  2.90s elapsed)
  %GC     time      30.3%  (26.4% elapsed)
  Alloc rate    3,009,412,603 bytes per MUT second
  Productivity  69.7% of total user, 69.4% of total elapsed

person johnchen902    schedule 02.04.2015    source источник
comment
Спасибо, что включили версию GHC!   -  person dfeuer    schedule 02.04.2015
comment
Но ... можете ли вы скомпилировать с -rtsopts и запустить с +RTS -s, чтобы получить сводку профиля кучи?   -  person dfeuer    schedule 02.04.2015
comment
@dfeuer Теперь результат встроен в мой вопрос.   -  person johnchen902    schedule 02.04.2015
comment
Теперь готовим с окунем. Попробуйте -fno-full-laziness и посмотрите, приведет ли это вас к чему-нибудь.   -  person dfeuer    schedule 02.04.2015
comment
@dfeuer Все та же ситуация. (0,099 с / 3,339 с)   -  person johnchen902    schedule 02.04.2015
comment
@dfeuer Если у вас нет компилятора C ++ для тестирования, это входной файл, который также является ссылка выше.   -  person johnchen902    schedule 02.04.2015
comment
Еще один вариант: -fno-state-hack. Тогда мне придется действительно попытаться изучить детали.   -  person dfeuer    schedule 02.04.2015
comment
Что ж, работает. (0,088 с / 0,076 с) Не могу понять этот флаг.   -  person johnchen902    schedule 02.04.2015
comment
Я не знаю слишком много деталей, но в основном это эвристика для предположения, что определенные функции, которые создает ваша программа (а именно те, которые скрыты в типах IO или ST), вызываются только один раз. Обычно это хорошее предположение, но когда это плохое предположение, GHC может создать очень плохой код. Разработчики довольно давно пытались найти способ получить хорошее без плохого. Думаю, сейчас над этим работает Йоахим Брайтнер.   -  person dfeuer    schedule 02.04.2015
comment
@dfeuer Спасибо. Теперь у меня есть версия без этой проблемы. (Хотя не удосужился опубликовать это)   -  person johnchen902    schedule 02.04.2015


Ответы (1)


Что случилось с вашим кодом с -O

Позвольте мне увеличить вашу основную функцию и немного ее переписать:

main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    line <- getLine
    let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
    replicateM_ m $ query n nodes

Ясно, что здесь подразумевается, что NodeArray создается один раз, а затем используется в каждом из m вызовов query.

К сожалению, GHC фактически преобразует этот код в

main = do
    [n, m] <- fmap (map read . words) getLine
    line <- getLine
    replicateM_ m $ do
        let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
        query n nodes

и тут проблема сразу видна.

Что такое State hack и почему он снижает производительность моих программ

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

-fno-state-hack

Отключите взлом состояния, при котором любая лямбда с токеном State # в качестве аргумента считается однократной, поэтому считается нормальным встраивать в нее вещи. Это может улучшить производительность кода монад ввода-вывода и ST, но рискует уменьшить совместное использование.

В общих чертах идея заключается в следующем: если вы определяете функцию с типом IO и предложением where, например

foo x = do
    putStrLn y
    putStrLn y
  where y = ...x...

Что-то типа IO a можно рассматривать как что-то типа RealWord -> (a, RealWorld). С этой точки зрения, вышеизложенное становится (примерно)

foo x = 
   let y = ...x... in 
   \world1 ->
     let (world2, ()) = putStrLn y world1
     let (world3, ()) = putStrLn y world2
     in  (world3, ())

Вызов foo (обычно) выглядел бы так foo argument world. Но определение foo принимает только один аргумент, а другой используется только позже локальным лямбда-выражением! Это будет очень медленный вызов foo. Было бы намного быстрее, если бы код выглядел так:

foo x world1 = 
   let y = ...x... in 
   let (world2, ()) = putStrLn y world1
   let (world3, ()) = putStrLn y world2
   in  (world3, ())

Это называется расширением eta и выполняется по разным причинам (например, путем анализа определения функции, проверяя, как он вызывается, и - в данном случае - типизированная эвристика).

К сожалению, это снижает производительность, если вызов foo фактически имеет форму let fooArgument = foo argument, то есть с аргументом, но world не передан (пока). В исходном коде, если fooArgument затем используется несколько раз, y все равно будет вычисляться только один раз и использоваться совместно. В измененном коде y будет пересчитываться каждый раз - именно то, что произошло с вашим nodes.

Что можно исправить?

Возможно. См. # 9388, чтобы попытаться сделать это. Проблема с его исправлением заключается в том, что это будет снижать производительность во многих случаях, когда преобразование происходит нормально, даже если компилятор не может знать этого наверняка. И, вероятно, бывают случаи, когда это технически не в порядке, т.е. совместное использование теряется, но это все же полезно, потому что ускорение от более быстрого вызова перевешивает дополнительные затраты на пересчет. Так что непонятно, что делать дальше.

person Joachim Breitner    schedule 02.06.2015
comment
Очень интересно! Но я не совсем понял, почему: другой используется только позже локальным лямбда-выражением! Это будет очень медленный вызов foo? - person imz -- Ivan Zakharyaschev; 03.06.2015
comment
Есть ли обходной путь для конкретного местного случая? -f-no-state-hack при компиляции кажется довольно тяжелым. {-# NOINLINE #-} кажется очевидным, но я не могу придумать, как это применить здесь. Может быть, было бы достаточно просто сделать nodes действие ввода-вывода и полагаться на последовательность >>=? - person Barend Venter; 04.06.2015
comment
Я также видел, что замена replicateM_ n foo на forM_ (\_ -> foo) [1..n] помогает. - person Joachim Breitner; 04.06.2015