Haskell: niepotrzebne przewartościowań w stałych wyrażeniach

Question

mam zamiar wykazać problem stosując następujący przykładowy program

{-# LANGUAGE BangPatterns #-} 

data Point = Point !Double !Double 

fmod :: Double -> Double -> Double 
fmod a b | a < 0  = b - fmod (abs a) b 
     | otherwise = if a < b then a 
         else let q = a/b 
          in b * (q - fromIntegral (floor q :: Int)) 

standardMap :: Double -> Point -> Point 
standardMap k (Point q p) = 
    Point (fmod (q + p) (2 * pi)) (fmod (p + k * sin(q)) (2 * pi)) 

iterate' gen !p = p : (iterate' gen $ gen p) 

main = putStrLn 
    . show 
    . (\(Point a b) -> a + b) 
    . head . drop 100000000 
    . iterate' (standardMap k) $ (Point 0.15 0.25) 
    where k = (cos (pi/3)) - (sin (pi/3)) 

Tutaj standardMap k jest funkcja sparametryzowanego i k=(cos (pi/3))-(sin (pi/3)) jest parametrem. Jeśli skompiluję ten program z ghc -O3 -fllvm, czas wykonania na moim komputerze wynosi około 42s, jednak jeśli napiszę k w postaci 0.5 - (sin (pi/3)), czas wykonania będzie równy 21s, a jeśli napiszę k = 0.5 - 0.5 * (sqrt 3), to zajmie to tylko 12s.

Wniosek jest taki, że k jest ponownie oceniany przy każdym wywołaniu standardMap k.

Dlaczego to nie jest zoptymalizowane?

P.S. Kompilator ghc 7.6.3 na ArchLinux

EDIT

Dla tych, którzy obawiają się o dziwnych właściwościach standardMap tu jest prostszy i bardziej intuicyjny przykład, który wykazuje ten sam problem

{-# LANGUAGE BangPatterns #-} 

data Point = Point !Double !Double 

rotate :: Double -> Point -> Point 
rotate k (Point q p) = 
    Point ((cos k) * q - (sin k) * p) ((sin k) * q + (cos k) * p) 

iterate' gen !p = p : (iterate' gen $ gen p) 

main = putStrLn 
    . show 
    . (\(Point a b) -> a + b) 
    . head . drop 100000000 
    . iterate' (rotate k) $ (Point 0.15 0.25) 
    where --k = (cos (pi/3)) - (sin (pi/3)) 
     k = 0.5 - 0.5 * (sqrt 3) 

EDYTOWANIE

Zanim zadałem pytanie, które próbowałem wykonać, zmieniono je na k ja sposób Don zasugerował, ale z ghc -O3 nie widziałem różnicy. Rozwiązanie ze ścisłością działa, jeśli program jest skompilowany z ghc -O2. Tęskniłem za tym, ponieważ nie wypróbowałem wszystkich możliwych kombinacji flag z wszystkimi możliwymi wersjami programu.

Jaka jest różnica między -O3 a -O2, która wpływa na takie przypadki?

Czy powinienem ogólnie preferować -O2?

EDIT

Jak zauważył Mike Hartl i innych, jeśli rotate k zmienia się rotate $ k lub standardMap k do standardMap $ k, wydajność poprawia się, choć nie jest to najlepszy możliwy (roztwór Dona). Czemu?

Answer 1

Nie sądzę, że jest to ponowna ocena.

Najpierw przełączyłem się na notację "do" i użyłem "let" dla definicji "k", którą uznałem za pomocne. Nie - wciąż wolno.

Następnie dodałem wywołanie śledzenia - tylko raz zostało ocenione. Nawet sprawdził, czy szybki wariant faktycznie produkuje podwójne.

Następnie wydrukowałem obie odmiany. Istnieje niewielka różnica w wartościach początkowych.

Podnoszenie wartości wariantu "powolnego" powoduje, że prędkość jest taka sama. Nie mam pojęcia, jaki jest twój algorytm - czy byłby bardzo wrażliwy na wartości początkowe?

import Debug.Trace (trace) 

... 

main = do 
    -- is -0.3660254037844386 
    let k0 = (0.5 - 0.5 * (sqrt 3))::Double 
    -- was -0.3660254037844385 
    let k1 = (cos (pi/3)) - (trace "x" (sin (pi/3))) + 0.0000000000000001; 
    putStrLn (show k0) 
    putStrLn (show k1) 
    putStrLn 
    . show 
    . (\(Point a b) -> a + b) 
    . head . drop 100000000 
    . iterate' (standardMap k1) $ (Point 0.15 0.25) 

---

EDIT: jest to wersja z literałów liczbowych. Wyświetla dla mnie czasy działania 23sec vs 7sec. Skompilowałem dwie oddzielne wersje kodu, aby upewnić się, że nie robię czegoś głupiego, jak nie rekompilacja.

main = do 
    -- -0.3660254037844386 
    -- -0.3660254037844385 
    let k2 = -0.3660254037844385 
    putStrLn 
    . show 
    . (\(Point a b) -> a + b) 
    . head . drop 100000000 
    . iterate' (standardMap k2) $ (Point 0.15 0.25) 

EDIT2: Nie wiem, jak uzyskać opcodes od GHC, ale porównując zrzutów heksowych dla dwóch .o plików pokazuje, że różnią się o jeden bajt - przypuszczalnie dosłowne. Więc nie może to być środowisko wykonawcze.

---

EDIT3: Próbowano włączyć profilowanie, a to tylko zdziwiło mnie jeszcze bardziej. chyba że czegoś mi brakuje, jedyną różnicą jest mała rozbieżność w liczbie połączeń z fmod (dokładniej fmod.q).

Profil "5" oznacza stałe zakończenie "5", to samo z "6".

 Fri Sep 6 12:37 2013 Time and Allocation Profiling Report (Final) 

      constant-timings-5 +RTS -p -RTS 

     total time =  38.34 secs (38343 ticks @ 1000 us, 1 processor) 
     total alloc = 12,000,105,184 bytes (excludes profiling overheads) 

COST CENTRE MODULE %time %alloc 

standardMap Main  71.0 0.0 
iterate' Main  21.2 93.3 
fmod  Main  6.3 6.7 


                  individual  inherited 
COST CENTRE  MODULE     no.  entries %time %alloc %time %alloc 

MAIN   MAIN      50   0 0.0 0.0 100.0 100.0         
main   Main     101   0 0.0 0.0  0.0 0.0         
CAF:main1  Main      98   0 0.0 0.0  0.0 0.0         
    main   Main     100   1 0.0 0.0  0.0 0.0         
CAF:main2  Main      97   0 0.0 0.0  1.0 0.0         
    main   Main     102   0 1.0 0.0  1.0 0.0         
    main.\  Main     110   1 0.0 0.0  0.0 0.0         
CAF:main3  Main      96   0 0.0 0.0 99.0 100.0         
    main   Main     103   0 0.0 0.0 99.0 100.0         
    iterate'  Main     104 100000001 21.2 93.3 99.0 100.0         
    standardMap Main     105 100000000 71.0 0.0 77.9 6.7         
    fmod  Main     106 200000001 6.3 6.7  6.9 6.7                         
     fmod.q Main     109 49999750 0.6 0.0  0.6 0.0                         
CAF:main_k  Main      95   0 0.0 0.0  0.0 0.0                         
    main   Main     107   0 0.0 0.0  0.0 0.0                         
    main.k2  Main     108   1 0.0 0.0  0.0 0.0                         
CAF   GHC.IO.Handle.FD   93   0 0.0 0.0  0.0 0.0                         
CAF   GHC.Conc.Signal   90   0 0.0 0.0  0.0 0.0                         
CAF   GHC.Float    89   0 0.0 0.0  0.0 0.0                         
CAF   GHC.IO.Encoding   82   0 0.0 0.0  0.0 0.0                         
CAF   GHC.IO.Encoding.Iconv 66   0 0.0 0.0  0.0 0.0 


     Fri Sep 6 12:38 2013 Time and Allocation Profiling Report (Final) 

      constant-timings-6 +RTS -p -RTS 

     total time =  22.17 secs (22167 ticks @ 1000 us, 1 processor) 
     total alloc = 11,999,947,752 bytes (excludes profiling overheads) 

COST CENTRE MODULE %time %alloc 

standardMap Main  48.4 0.0 
iterate' Main  38.2 93.3 
fmod  Main  10.9 6.7 
main  Main  1.4 0.0 
fmod.q  Main  1.0 0.0 


                  individual  inherited 
COST CENTRE  MODULE     no.  entries %time %alloc %time %alloc 

MAIN   MAIN      50   0 0.0 0.0 100.0 100.0 
main   Main     101   0 0.0 0.0  0.0 0.0 
CAF:main1  Main      98   0 0.0 0.0  0.0 0.0 
    main   Main     100   1 0.0 0.0  0.0 0.0 
CAF:main2  Main      97   0 0.0 0.0  1.4 0.0 
    main   Main     102   0 1.4 0.0  1.4 0.0 
    main.\  Main     110   1 0.0 0.0  0.0 0.0 
CAF:main3  Main      96   0 0.0 0.0 98.6 100.0 
    main   Main     103   0 0.0 0.0 98.6 100.0 
    iterate'  Main     104 100000001 38.2 93.3 98.6 100.0 
    standardMap Main     105 100000000 48.4 0.0 60.4 6.7 
    fmod  Main     106 200000001 10.9 6.7 12.0 6.7 
     fmod.q Main     109 49989901 1.0 0.0  1.0 0.0 
CAF:main_k  Main      95   0 0.0 0.0  0.0 0.0 
    main   Main     107   0 0.0 0.0  0.0 0.0 
    main.k2  Main     108   1 0.0 0.0  0.0 0.0 
CAF   GHC.IO.Handle.FD   93   0 0.0 0.0  0.0 0.0 
CAF   GHC.Conc.Signal   90   0 0.0 0.0  0.0 0.0 
CAF   GHC.Float    89   0 0.0 0.0  0.0 0.0 
CAF   GHC.IO.Encoding   82   0 0.0 0.0  0.0 0.0 
CAF   GHC.IO.Encoding.Iconv 66   0 0.0 0.0  0.0 0.0 

---

EDIT4: Link poniżej jest do dwóch wysypisk OPCODE (dzięki @Tom Ellis). Chociaż nie potrafię ich odczytać, wydają się mieć ten sam "kształt". Przypuszczalnie długie ciągi losowe są wewnętrznymi identyfikatorami. Właśnie przekompilowałem oba z -O2 -fforce-recomp, a różnice czasowe są prawdziwe. https://gist.github.com/anonymous/6462797

Answer 2

Jak zawsze, sprawdź rdzeń.

Z ghc -O2, k inlined do ciała pętli, który wypłynął jako funkcję najwyższego poziomu:

Main.main7 :: Main.Point -> Main.Point 
Main.main7 = 
    \ (ds_dAa :: Main.Point) -> 
    case ds_dAa of _ { Main.Point q_alG p_alH -> 
    case q_alG of _ { GHC.Types.D# x_s1bt -> 
    case p_alH of _ { GHC.Types.D# y_s1bw -> 
    case Main.$wfmod (GHC.Prim.+## x_s1bt y_s1bw) 6.283185307179586 
    of ww_s1bi { __DEFAULT -> 
    case Main.$wfmod 
      (GHC.Prim.+## 
       y_s1bw 
       (GHC.Prim.*## 
       (GHC.Prim.-## 
        (GHC.Prim.cosDouble# 1.0471975511965976) 
        (GHC.Prim.sinDouble# 1.0471975511965976)) 
       (GHC.Prim.sinDouble# x_s1bt))) 
      6.283185307179586 
    of ww1_X1bZ { __DEFAULT -> 
    Main.Point (GHC.Types.D# ww_s1bi) (GHC.Types.D# ww1_X1bZ) 

Wskazując, że sin i cos połączeń nie są oceniane w czasie kompilacji. Powoduje to, że nieco bardziej matematyka ma zamiar wystąpić:

$ time ./A 
3.1430515093368085 
real 0m15.590s 

Jeśli się to surowe, to przynajmniej nie przeliczone za każdym razem:

main = putStrLn 
    . show 
    . (\(Point a b) -> a + b) 
    . head . drop 100000000 
    . iterate' (standardMap k) $ (Point 0.15 0.25) 

    where 
     k :: Double 
     !k = (cos (pi/3)) - (sin (pi/3)) 

Wynikające w:

ipv_sEq = 
         GHC.Prim.-## 
         (GHC.Prim.cosDouble# 1.0471975511965976) 
         (GHC.Prim.sinDouble# 1.0471975511965976) } in 

I czas działania:

$ time ./A 
6.283185307179588 
real 0m7.859s 

Co moim zdaniem jest wystarczająco dobre na teraz. Dodałbym również rozpakować pragmy do typu Point.

Jeśli chcesz dowiedzieć się więcej o wydajności numerycznej przy różnych ustawieniach kodu, musisz sprawdzić rdzeń.

---

Korzystanie z poprawionego przykładu. Cierpi na ten sam problem. k jest wstawiony rotate. GHC uważa, że ​​jest naprawdę tani, gdy w tym benchmarku jest droższy.

Naiwny, ghc-7.2.3 -O2

$ time ./A 
0.1470480616244365 

real 0m22.897s 

Wartość jest obliczana przy każdym wywołaniu obrotu.

Złóż k strict: jeden sposób na wymuszenie nie udostępniania.

$ time ./A 
0.14704806100839019 

real 0m2.360s 

Korzystanie rozpakować pragma na konstruktora Point:

$ time ./A 
0.14704806100839019 

real 0m1.860s