2017-02-11 17 views
19

To jest kontynuacja mojego previous question, na której zapytałem, dlaczego stream fusion nie kopie w pewien program. Problem polega na tym, że niektóre funkcje nie zostały wstawione, a flaga INLINE poprawiła wydajność o około 17x (co pokazuje wagę wstawiania!).Czy istnieje sposób na wstawienie funkcji rekursywnej?

Zauważmy teraz, że na oryginalne pytanie zakodowałem na stałe 64 od incAll. Teraz załóżmy, że zamiast tego utworzyć nTimes funkcję, która wywołuje funkcję wielokrotnie:

module Main where 

import qualified Data.Vector.Unboxed as V 

{-# INLINE incAll #-} 
incAll :: V.Vector Int -> V.Vector Int 
incAll = V.map (+ 1) 

{-# INLINE nTimes #-} 
nTimes :: Int -> (a -> a) -> a -> a 
nTimes 0 f x = x 
nTimes n f x = f (nTimes (n-1) f x) 

main :: IO() 
main = do 
    let size = 100000000 :: Int 
    let array = V.replicate size 0 :: V.Vector Int 
    print $ V.sum (nTimes 64 incAll array) 

W tym przypadku, po prostu dodając INLINE pragmy do nTimes nie pomoże, bo AFAIK GHC nie inline rekurencyjne Funkcje. Czy istnieje jakaś sztuczka, aby zmusić GHC do rozbudowy nTimes podczas kompilacji, a tym samym do odzyskania oczekiwanej wydajności?

+2

Można użyć szablonu Haskell do wprowadzenia składni rozszerzającej powtarzającą się aplikację. –

+1

@ JoachimBreitner właśnie skończył to robić. Musiał nauczyć się szablonu Haskell. Wciąż testuję moją odpowiedź, ale wydaje się to dużo szybsze (podobnie jak w przypadku innego pytania). – Zeta

Odpowiedz

26

Nie, ale można użyć lepszych funkcji. Nie mówię o V.map (+64), co sprawiłoby, że rzeczy z pewnością byłyby o wiele szybsze, ale o nTimes. Mamy trzech kandydatów, którzy już robić to, co robi nTimes:

{-# INLINE nTimesFoldr #-} 
nTimesFoldr :: Int -> (a -> a) -> a -> a  
nTimesFoldr n f x = foldr (.) id (replicate n f) $ x 

{-# INLINE nTimesIterate #-} 
nTimesIterate :: Int -> (a -> a) -> a -> a  
nTimesIterate n f x = iterate f x !! n 

{-# INLINE nTimesTail #-} 
nTimesTail :: Int -> (a -> a) -> a -> a  
nTimesTail n f = go n 
    where 
    {-# INLINE go #-} 
    go n x | n <= 0 = x 
    go n x   = go (n - 1) (f x) 

Wszystkie wersje trwa około 8 sekund, w porównaniu do 40 sekund twoje wersje podjąć. Wersja Joachima również przybiera 8 sekund. Zauważ, że wersja iterate zajmuje więcej pamięci w moim systemie. Chociaż istnieje unroll plugin dla GHC, nie został on zaktualizowany w ciągu ostatnich pięciu lat (używa niestandardowych zgłoszeń).

Brak rozwijania w ogóle?

Zanim jednak rozpaczamy, jak dobrze GHC rzeczywiście próbuje wprowadzić wszystko? Użyjmy nTimesTail i nTimes 1:

module Main where 
import qualified Data.Vector.Unboxed as V 

{-# INLINE incAll #-} 
incAll :: V.Vector Int -> V.Vector Int 
incAll = V.map (+ 1) 

{-# INLINE nTimes #-} 
nTimes :: Int -> (a -> a) -> a -> a  
nTimes n f = go n 
    where 
    {-# INLINE go #-} 
    go n x | n <= 0 = x 
    go n x   = go (n - 1) (f x) 

main :: IO() 
main = do 
    let size = 100000000 :: Int 
    let array = V.replicate size 0 :: V.Vector Int 
    print $ V.sum (nTimes 1 incAll array) 
$ stack ghc --package vector -- -O2 -ddump-simpl -dsuppress-all SO.hs 
main2 = 
    case (runSTRep main3) `cast` ... 
    of _ { Vector ww1_s9vw ww2_s9vx ww3_s9vy -> 
    case $wgo 1 ww1_s9vw ww2_s9vx ww3_s9vy 
    of _ { (# ww5_s9w3, ww6_s9w4, ww7_s9w5 #) -> 

Możemy zatrzymać się właśnie tam. $wgo jest zdefiniowany powyżej go. Nawet z 1 GHC nie rozwija pętli. To niepokojące, ponieważ 1 jest stałą.

szablonów ratunek

ale niestety, to nie wszystko na marne. Jeśli programiści C++ są w stanie wykonać następujące czynności dla kompilacji stałych czasowych, to czy powinniśmy, prawda?

template <int N> 
struct Call{ 
    template <class F, class T> 
    static T call(F f, T && t){ 
     return f(Call<N-1>::call(f,std::forward<T>(t))); 
    } 
}; 
template <> 
struct Call<0>{ 
    template <class F, class T> 
    static T call(F f, T && t){ 
     return t; 
    } 
}; 

I rzeczywiście, możemy, z TemplateHaskell*:

-- Times.sh 
{-# LANGUAGE TemplateHaskell #-} 
module Times where 

import Control.Monad (when) 
import Language.Haskell.TH 

nTimesTH :: Int -> Q Exp 
nTimesTH n = do 
    f <- newName "f" 
    x <- newName "x" 

    when (n <= 0) (reportWarning "nTimesTH: argument non-positive") 

    let go k | k <= 0 = VarE x 
     go k   = AppE (VarE f) (go (k - 1)) 
    return $ LamE [VarP f,VarP x] (go n) 

nTimesTH Co zrobić? Tworzy nową funkcję, w której imię f zostanie zastosowane na drugie nazwisko x, co daje łącznie n razy. n teraz musi być stała w czasie kompilacji, która nam odpowiada, gdyż rozwijanie pętli jest możliwe tylko przy stałych czasu kompilacji:

$(nTimesTH 0) = \f x -> x 
$(nTimesTH 1) = \f x -> f x 
$(nTimesTH 2) = \f x -> f (f x) 
$(nTimesTH 3) = \f x -> f (f (f x)) 
... 

Czy to działa? I czy to szybko? Jak szybko w porównaniu do nTimes? Spróbujmy innego main na to:

-- SO.hs 
{-# LANGUAGE TemplateHaskell #-} 
module Main where 
import Times 
import qualified Data.Vector.Unboxed as V 

{-# INLINE incAll #-} 
incAll :: V.Vector Int -> V.Vector Int 
incAll = V.map (+ 1) 

{-# INLINE nTimes #-} 
nTimes :: Int -> (a -> a) -> a -> a  
nTimes n f = go n 
    where 
    {-# INLINE go #-} 
    go n x | n <= 0 = x 
    go n x   = go (n - 1) (f x) 

main :: IO() 
main = do 
    let size = 100000000 :: Int 
    let array = V.replicate size 0 :: V.Vector Int 
    let vTH = V.sum ($(nTimesTH 64) incAll array) 
    let vNorm = V.sum (nTimes 64 incAll array) 
    print $ vTH == vNorm 
stack ghc --package vector -- -O2 SO.hs && SO.exe +RTS -t 
True 
<<ghc: 52000056768 bytes, 66 GCs, 400034700/800026736 avg/max bytes residency (2 samples), 1527M in use, 0.000 INIT (0.000 elapsed), 8.875 MUT (9.119 elapsed), 0.000 GC (0.094 elapsed) :ghc>> 

To daje poprawny wynik. Jak szybko to działa? Załóżmy ponownie użyć innego main:

main :: IO() 
main = do 
    let size = 100000000 :: Int 
    let array = V.replicate size 0 :: V.Vector Int 
    print $ V.sum ($(nTimesTH 64) incAll array) 
 800,048,112 bytes allocated in the heap           
      4,352 bytes copied during GC            
      42,664 bytes maximum residency (1 sample(s))        
      18,776 bytes maximum slop             
      764 MB total memory in use (0 MB lost due to fragmentation)    

            Tot time (elapsed) Avg pause Max pause   
    Gen 0   1 colls,  0 par 0.000s 0.000s  0.0000s 0.0000s   
    Gen 1   1 colls,  0 par 0.000s 0.049s  0.0488s 0.0488s   

    INIT time 0.000s ( 0.000s elapsed)           
    MUT  time 0.172s ( 0.221s elapsed)           
    GC  time 0.000s ( 0.049s elapsed)           
    EXIT time 0.000s ( 0.049s elapsed)           
    Total time 0.188s ( 0.319s elapsed)           

    %GC  time  0.0% (15.3% elapsed)           

    Alloc rate 4,654,825,378 bytes per MUT second         

    Productivity 100.0% of total user, 58.7% of total elapsed   

Dobrze, że porównanie do 8s. Tak więc dla TL; DR: jeśli masz stałe w czasie kompilacji i chcesz utworzyć i/lub zmodyfikować swój kod na podstawie tych stałych, rozważ szablon Haskell.

* Proszę zauważyć, że jest to mój pierwszy szablon kodu Haskella, jaki kiedykolwiek napisałem. Używaj ostrożnie. Nie używaj zbyt dużej wartości n, bo możesz też uzyskać funkcję pomieszania.

+2

Uwaga: rozwiązaniem jest [do przeglądu kodu] (https://codereview.stackexchange.com/questions/155144/execute-a-function-n-times-where-n-is-known-at-compile-time). – Zeta

+0

Hej, wracając, aby poinformować, że jest to znakomita odpowiedź w większości aspektów, dziękuję. – MaiaVictor

4

nr

można napisać

{-# INLINE nTimes #-} 
nTimes :: Int -> (a -> a) -> a -> a 
nTimes n f x = go n 
    where go 0 = x 
     go n = f (go (n-1)) 

i GHC będzie inline nTimes i prawdopodobnie specjalizują rekurencyjnej go do konkretnych argumentów incAll i array, ale nie byłoby rozwinąć pętlę.

+0

Ach, to jest do bani, dzięki. – MaiaVictor

14

Istnieje mało znana sztuczka, którą Andres powiedział mi wcześniej, gdzie można rzeczywiście uzyskać GHC wbudowane funkcje rekurencyjne przy użyciu klas typu.

Chodzi o to, że zamiast pisać funkcję zwykle, gdy wykonujesz strukturalną rekurencję na wartości. Definiujesz swoją funkcję za pomocą klas typów i wykonuje strukturalną rekursję na argumencie typu. W tym przykładzie liczby naturalne typu.

GHC z radością wprowadzi każde wywołanie cykliczne i wygeneruje efektywny kod, ponieważ każde wywołanie rekurencyjne jest innego rodzaju.

Nie testowałem tego ani nie badałem rdzenia, ale zauważalnie szybciej.

{-# LANGUAGE DataKinds #-} 
{-# LANGUAGE KindSignatures #-} 
{-# LANGUAGE PolyKinds #-} 
{-# LANGUAGE ScopedTypeVariables #-} 
module Main where 

import qualified Data.Vector.Unboxed as V 

data Proxy a = Proxy 

{-# INLINE incAll #-} 
incAll :: V.Vector Int -> V.Vector Int 
incAll = V.map (+ 1) 

oldNTimes :: Int -> (a -> a) -> a -> a 
oldNTimes 0 f x = x 
oldNTimes n f x = f (oldNTimes (n-1) f x) 

-- New definition 

data N = Z | S N 

class Unroll (n :: N) where 
    nTimes :: Proxy n -> (a -> a) -> a -> a 

instance Unroll Z where 
    nTimes _ f x = x 

instance Unroll n => Unroll (S n) where 
    nTimes p f x = 
     let Proxy :: Proxy (S n) = p 
     in f (nTimes (Proxy :: Proxy n) f x) 

main :: IO() 
main = do 
    let size = 100000000 :: Int 
    let array = V.replicate size 0 :: V.Vector Int 
    print $ V.sum (nTimes (Proxy :: Proxy (S (S (S (S (S (S (S (S (S (S (S Z)))))))))))) incAll array) 
    print $ V.sum (oldNTimes 11 incAll array) 
+0

Przyjemnie, ale jeśli chcesz użyć 'nTimes 64', termin' Proxy :: Proxy (S (S (S (S ... (SZ) ...) 'będzie raczej ... ciekawy do napisania. Arytmetyka typu poziomowego.Coś w stylu 'Proxy (Ten: *: Six: +: Four)'. – Zeta

+0

Nadal nie mogę uzyskać shenaniganów programowania typeclass, każdy, kto to robi, jest dla mnie niewątpliwie czarodziejem. – MaiaVictor