为什么此Haskell代码在-O下运行速度较慢?


88

这件作品的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

1
感谢您提供GHC版本!
dfeuer

2
@dfeuer结果现在内联到我的问题中。
johnchen902

13
可以尝试的另一种选择:-fno-state-hack。然后,我将不得不实际尝试研究细节。
dfeuer

17
我不知道太多细节,但是基本上,这是一种启发式的猜测,即程序创建的某些功能(即隐藏在IOST类型中的功能)仅被调用一次。通常这是一个很好的猜测,但是当它是一个错误的猜测时,GHC可能会生成非常糟糕的代码。相当长的一段时间以来,开发人员一直试图找到一种在没有坏处获得好处的方法。我认为Joachim Breitner如今正在努力。
dfeuer 2015年

2
这看起来非常像ghc.haskell.org/trac/ghc/ticket/10102。请注意,这两个程序都使用replicateM_,并且GHC会错误地将计算从外部replicateM_移至内部,从而重复执行。
Joachim Breitner

Answers:


42

我想是该问题得到适当答案的时候了。

您的代码发生了什么 -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

您可以立即在这里看到问题。

什么是状态骇客,为何破坏我的程式效能

原因是状态骇客,粗略地说:“当某种类型的东西时IO a,假设它只被调用一次。” 该官方文档是不是更复杂的:

-fno-state-hack

关闭“状态黑客”,将带有State#令牌作为参数的任何lambda都视为一次输入,因此可以将其中的内容内联。这可以提高IO和ST monad代码的性能,但是存在减少共享的风险。

大致的想法如下:如果您定义一个带有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仅包含一个参数,而另一个则仅在以后由本地lambda表达式使用!拨打将会非常缓慢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,以尝试这样做。修复它的问题在于,即使在编译器可能无法确定的情况下,在很多情况下转换都可以进行,这降低性能。在某些情况下,从技术上讲,它不可行,即丢失了共享,但它仍然是有益的,因为更快的呼叫所带来的加速超过了重新计算的额外成本。因此,不清楚从这里到哪里。


4
很有意思!但是我还不太清楚为什么:“另一个稍后只会被本地lambda表达式占用!这将是对foo“ 的非常慢的调用?
imz-伊万·扎哈拉里舍夫(Ivan Zakharyaschev),2015年

是否有针对特定本地案例的解决方法?-f-no-state-hack编译时看起来很沉重。{-# NOINLINE #-}看起来很明显,但是我想不起来如何在这里应用它。也许仅仅做nodes一个IO动作并依靠s的顺序就足够了>>=吗?
Barend Venter 2015年

我也看到replicateM_ n fooforM_ (\_ -> foo) [1..n]帮助代替。
Joachim Breitner,2015年
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.