2017-02-11 7 views
19

Это продолжение моего previous question, на котором я спросил, почему потоковое слияние не пинало в определенной программе. Оказывается, проблема заключалась в том, что некоторые функции не были встроены, а флаг INLINE улучшил производительность примерно на 17x (что демонстрирует важность встраивания!).Есть ли способ встроить рекурсивную функцию?

Теперь, обратите внимание, что по первому вопросу я жестко запрограммировал 64 звонки incAll сразу. Теперь предположим, что вместо этого я создаю nTimes функцию, которая вызывает функцию несколько раз:

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) 

В этом случае, просто добавляя INLINE прагму к nTimes не поможет, потому что AFAIK GHC не встраивать рекурсивный функции. Есть ли какой-либо трюк, чтобы заставить GHC развернуть nTimes во время компиляции и, таким образом, восстановить ожидаемую производительность?

+2

Вы можете использовать Template Haskell для введения синтаксиса для расширения повторяющегося приложения. –

+1

@JoachimBreitner только законченный сделав это. Пришлось изучить Template Haskell. Все еще проверяю мой ответ, но он кажется намного быстрее (аналогично другому вопросу). – Zeta

ответ

26

Нет, но вы можете использовать лучшие функции. Я не говорю о V.map (+64), что сделает вещи намного быстрее, но примерно nTimes. У нас есть три кандидата, которые уже делают то, что делает 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) 

Все версии занимают около 8 секунд, по сравнению с 40 секунд ваши версии берут. Кстати, версия Иоахима также занимает 8 секунд. Обратите внимание, что версия iterate занимает больше памяти в моей системе. Хотя для GHC есть unroll plugin, он не обновлялся за последние пять лет (он использует пользовательские ANNotations).

Нет разворота вообще?

Однако, прежде чем мы отчаиваемся, насколько GHC действительно пытается встроить все? Давайте использовать nTimesTail и 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 #) -> 

Мы можем остановить прямо там. $wgo - это go, определенный выше. Даже с 1 GHC не разворачивает цикл. Это беспокоит, так как 1 является константой.

Шаблоны для спасения

Но увы, это не все напрасно. Если программисты на C++ могут сделать следующее для констант времени компиляции, значит, правильно?

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; 
    } 
}; 

И, конечно, мы можем, с 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 Что делать? Он создает новую функцию, в которой первое имя f будет применяться ко второму имени x в общей сложности n раз. n теперь необходимо, чтобы быть во время компиляции константы, которая нам подходит, так как петля-раскатывание возможно только с константами времени компиляции:

$(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)) 
... 

ли работа? И быстро? Как быстро по сравнению с nTimes? Давайте попробуем другой main для этого:

-- 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>> 

Это дает правильный результат. Как быстро? Давайте использовать другой 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   

Ну, сравните это с 8s. Итак, для TL; DR: если у вас есть константы времени компиляции, и вы хотите создать и/или изменить свой код на основе этих констант, рассмотрите шаблон Haskell.

* Обратите внимание, что это мой первый код шаблона Haskell, который я когда-либо писал. Используйте с осторожностью. Не используйте слишком большой n, иначе вы можете переиграть функцию.

+2

Примечание: решение доступно для просмотра кода (https://codereview.stackexchange.com/questions/155144/execute-a-function-n-times-where-n-is-known-at-compile-time). – Zeta

+0

Эй, просто возвращайся, чтобы сообщить, что это блестящий ответ в большинстве аспектов, спасибо. – MaiaVictor

4

No.

Вы могли бы написать

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

и GHC бы встраивать nTimes, и, вероятно, специализируются рекурсивную go к вашим конкретным аргументам incAll и array, но не раскатывать петлю.

+0

Ах, это отстой, спасибо. – MaiaVictor

14

Существует малоизвестный трюк, о котором Андрес сказал мне раньше, где вы можете фактически получить GHC для встроенных рекурсивных функций, используя классы типов.

Идея состоит в том, что вместо того, чтобы писать функцию, обычно, когда вы выполняете структурную рекурсию по значению. Вы определяете свою функцию с помощью классов типов и выполняете структурную рекурсию на аргументе типа. В этом примере натуральные числа типа.

GHC будет счастливо встроить каждый рекурсивный вызов и создать эффективный код, поскольку каждый рекурсивный вызов имеет другой тип.

Я не оценил это или не посмотрел на ядро, но заметно быстрее.

{-# 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

Приятно, хотя если вы хотите использовать 'nTimes 64', термин' Proxy :: Proxy (S (S (S (S ... (SZ) ...) 'будет ... интересным для записи. Арифметика уровня типа.Состязается как «Прокси (Десять: *: Шесть: +: Четыре)». – Zeta

+0

Я до сих пор не могу получить эти программные программы, которые делают это явно волшебником для меня. – MaiaVictor