เหตุใดรหัส Haskell นี้จึงทำงานช้าลงด้วย -O


87

ชิ้นส่วนของรหัส 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
ฉันไม่รู้รายละเอียดมากเกินไป แต่โดยพื้นฐานแล้วมันเป็นการฮิวริสติกสำหรับการคาดเดาว่าฟังก์ชันบางอย่างที่โปรแกรมของคุณสร้างขึ้น (ได้แก่ ฟังก์ชันที่ซ่อนอยู่ในIOหรือSTประเภท) จะถูกเรียกเพียงครั้งเดียว โดยปกติจะเป็นการเดาที่ดี แต่เมื่อเดาไม่ถูก GHC สามารถสร้างรหัสที่ไม่ดีได้ นักพัฒนาได้พยายามหาวิธีที่จะได้รับสิ่งที่ดีโดยไม่ต้องเสียมาเป็นเวลานาน ฉันคิดว่าวันนี้ Joachim Breitner กำลังดำเนินการอยู่
dfeuer

2
ดูเหมือนghc.haskell.org/trac/ghc/ticket/10102มาก โปรดทราบว่าทั้งสองโปรแกรมใช้replicateM_และที่นั่น GHC จะย้ายการคำนวณจากภายนอกreplicateM_สู่ภายในโดยไม่ถูกต้องดังนั้นการทำซ้ำ
Joachim Breitner

คำตอบ:


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

ปิด "แฮ็กสถานะ" โดยที่แลมบ์ดาใด ๆ ที่มีโทเค็นสถานะ # เป็นอาร์กิวเมนต์จะถือเป็นรายการเดียวดังนั้นจึงถือว่าเป็นสิ่งที่ตกลงในบรรทัดภายใน สิ่งนี้สามารถปรับปรุงประสิทธิภาพของรหัส monad ของ IO และ ST แต่จะเสี่ยงต่อการลดการแชร์

โดยคร่าวๆแนวคิดมีดังนี้: ถ้าคุณกำหนดฟังก์ชันด้วยIOtype และ where clause เช่น

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-expansion และทำในหลาย ๆ สาเหตุ (เช่นโดยการวิเคราะห์นิยามของฟังก์ชันโดยการตรวจสอบว่ามีการเรียกใช้อย่างไรและในกรณีนี้คือการวิเคราะห์พฤติกรรมแบบกำกับ)

น่าเสียดายที่การดำเนินการนี้จะลดประสิทธิภาพลงหากการเรียกไปที่fooเป็นจริงในรูปแบบlet fooArgument = foo argumentเช่นมีอาร์กิวเมนต์ แต่ไม่มีการworldส่งผ่าน (ยัง) ในรหัสเดิมหากfooArgumentใช้หลายครั้งyจะยังคงคำนวณเพียงครั้งเดียวและใช้ร่วมกัน ในรหัสที่แก้ไขyจะคำนวณใหม่ทุกครั้ง - สิ่งที่เกิดขึ้นกับคุณอย่างแม่นยำnodesสิ่งที่ได้เกิดขึ้นกับคุณ

สิ่งต่างๆสามารถแก้ไขได้หรือไม่?

เป็นไปได้. โปรดดูที่# 9388สำหรับความพยายามในการดำเนินการดังกล่าว ปัญหาในการแก้ไขคือจะทำให้ประสิทธิภาพการทำงานลดลงในหลาย ๆ กรณีที่การแปลงเกิดขึ้นได้แม้ว่าคอมไพเลอร์จะไม่สามารถรู้ได้อย่างแน่นอน และอาจมีบางกรณีที่ไม่เป็นไปตามหลักเทคนิคกล่าวคือการแชร์หายไป แต่ก็ยังมีประโยชน์เนื่องจากการเร่งความเร็วจากการโทรที่เร็วกว่านั้นมีค่าใช้จ่ายเพิ่มเติมในการคำนวณใหม่ ดังนั้นจึงไม่ชัดเจนว่าจะไปที่ใดจากที่นี่


4
น่าสนใจมาก! แต่ฉันไม่ค่อยเข้าใจว่าทำไม: "อีกอันถูกใช้ในภายหลังโดยการแสดงออกของแลมบ์ดาในท้องถิ่นนั่นจะเป็นการเรียกที่ช้ามากfoo"?
imz - Ivan Zakharyaschev

มีวิธีแก้ปัญหาสำหรับกรณีเฉพาะบางกรณีหรือไม่? -f-no-state-hackเมื่อรวบรวมดูเหมือนจะมีน้ำหนักมาก {-# NOINLINE #-}ดูเหมือนเป็นสิ่งที่ชัดเจน แต่ฉันคิดไม่ออกว่าจะนำมาใช้ที่นี่อย่างไร บางทีอาจจะเพียงพอสำหรับnodesการดำเนินการ IO และอาศัยการจัดลำดับของ>>=?
Barend Venter

ฉันยังเห็นว่าการแทนที่replicateM_ n fooด้วยความforM_ (\_ -> foo) [1..n]ช่วยเหลือ
Joachim Breitner
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.