Tại sao mã Haskell này chạy chậm hơn với -O?

Đoạn mã này Haskell chạy nhiều chậm với -O, nhưng -Onên không nguy hiểm . Bất cứ ai có thể cho tôi biết những gì đã xảy ra? Nếu nó quan trọng, đó là một nỗ lực để giải quyết vấn đề này và nó sử dụng tìm kiếm nhị phân và cây phân đoạn liên tục:

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

(Đây chính xác là mã giống với việc xem xét mã nhưng câu hỏi này giải quyết một vấn đề khác.)

Đây là trình tạo đầu vào của tôi trong 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);
    }
}

Trong trường hợp bạn không có sẵn trình biên dịch C ++, đây là kết quả của./gen.exe 1000 .

Đây là kết quả thực thi trên máy tính của tôi:

$ 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

Và đây là bản tóm tắt hồ sơ heap:

$ 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

Tôi đoán đã đến lúc câu hỏi này có một câu trả lời thích hợp.

Điều gì đã xảy ra với mã của bạn với -O

Hãy để tôi phóng to chức năng chính của bạn và viết lại một chút:

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

Rõ ràng, ý định ở đây là cái NodeArrayđược tạo một lần, và sau đó được sử dụng trong mọi lệnh mgọi của query.

Thật không may, GHC chuyển đổi mã này thành, một cách hiệu quả,

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

và bạn có thể thấy ngay vấn đề ở đây.

Hack trạng thái là gì và tại sao nó phá hủy hiệu suất chương trình của tôi

Nguyên nhân là do vụ hack nhà nước, nói (đại khái): “Khi một thứ gì đó thuộc loại IO a, hãy giả sử nó chỉ được gọi một lần.”. Các tài liệu chính thức không phải là nhiều hơn nữa công phu:

-fno-state-hack

Tắt tính năng "hack trạng thái" theo đó bất kỳ lambda nào có mã thông báo State # làm đối số được coi là mục nhập một lần, do đó việc nội dòng những thứ bên trong nó được coi là OK. Điều này có thể cải thiện hiệu suất của mã đơn nguyên IO và ST, nhưng nó có nguy cơ làm giảm khả năng chia sẻ.

Đại khái, ý tưởng như sau: Nếu bạn định nghĩa một hàm với IOkiểu và mệnh đề where, ví dụ:

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

Một cái gì đó thuộc loại IO acó thể được xem như một cái gì đó thuộc loại RealWord -> (a, RealWorld). Theo quan điểm đó, điều trên trở thành (đại khái)

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

Một cuộc gọi đến foosẽ (thường) trông như thế này foo argument world. Nhưng định nghĩa của foochỉ nhận một đối số và đối số kia chỉ được sử dụng sau đó bởi một biểu thức lambda cục bộ! Đó sẽ là một cuộc gọi rất chậm foo. Sẽ nhanh hơn nhiều nếu mã trông như thế này:

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

Điều này được gọi là mở rộng eta và được thực hiện trên nhiều cơ sở khác nhau (ví dụ: bằng cách phân tích định nghĩa của hàm , bằng cách kiểm tra cách nó được gọi và - trong trường hợp này - kiểu heuristics có hướng).

Thật không may, điều này làm giảm hiệu suất nếu lệnh gọi đến foothực sự có dạng let fooArgument = foo argument, tức là với một đối số, nhưng chưa worldđược chuyển (chưa). Trong mã gốc, nếu fooArgumentsau đó được sử dụng nhiều lần, ysẽ vẫn chỉ được tính một lần và được chia sẻ. Trong mã đã sửa đổi, ysẽ được tính toán lại mọi lúc - chính xác những gì đã xảy ra với bạn nodes.

Mọi thứ có thể sửa được không?

Có khả năng. Xem # 9388 để biết nỗ lực làm như vậy. Vấn đề với việc khắc phục nó là nó sẽ làm tốn hiệu suất trong nhiều trường hợp khi quá trình chuyển đổi xảy ra thành ok, mặc dù trình biên dịch không thể biết chắc chắn điều đó. Và có thể có những trường hợp nó không ổn về mặt kỹ thuật, tức là chia sẻ bị mất, nhưng nó vẫn có lợi vì tốc độ từ cuộc gọi nhanh hơn nhiều hơn chi phí tính toán lại thêm. Vì vậy không rõ sẽ đi đâu từ đây.