Haskell: ненужные переоценки постоянных выражений
Я собираюсь продемонстрировать проблему, используя следующую примерную программу
{-# 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))
Здесь standardMap k - параметризованная функция, а k=(cos (pi/3))-(sin (pi/3)) - параметр. Если я скомпилирую эту программу с помощью ghc -O3 -fllvm, время выполнения на моей машине примерно равно 42s, однако, если я пишу k в форме 0.5 - (sin (pi/3)), время выполнения равно 21s, и если я напишу k = 0.5 - 0.5 * (sqrt 3), будет принимать только 12s.
Вывод состоит в том, что k переоценивается при каждом вызове standardMap k.
Почему это не оптимизировано?
P.S. компилятор ghc 7.6.3 на archlinux
ИЗМЕНИТЬ
Для тех, кто связан со странными свойствами standardMap, здесь представлен более простой и интуитивно понятный пример, который показывает ту же проблему
{-# 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)
EDIT
Прежде чем я задал вопрос, я попытался сделать k strict, так же, как предложил Дон, но с ghc -O3 я не видел разницы. Решение со строгостью работает, если программа скомпилирована с помощью ghc -O2. Я пропустил это, потому что я не пытался использовать все возможные комбинации флагов со всеми возможными версиями программы.
В чем разница между -O3 и -O2, которая влияет на такие случаи?
Должен ли я предпочитать -O2 вообще?
EDIT
Как заметил Майк Хартл и другие, если rotate k изменено на rotate $ k или standardMap k на standardMap $ k, производительность улучшится, хотя это не самое лучшее (решение Don). Почему?
Ответы
Ответ 1
Как всегда, проверьте ядро.
С ghc-O2, k встроен в тело цикла, который выплывает как функция верхнего уровня:
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)
Указание того, что вызовы sin и cos не оцениваются во время компиляции.
В результате получается немного больше математики:
$ time ./A
3.1430515093368085
real 0m15.590s
Если вы делаете это строгим, это, по крайней мере, не пересчитывается каждый раз:
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))
Результат:
ipv_sEq =
GHC.Prim.-##
(GHC.Prim.cosDouble# 1.0471975511965976)
(GHC.Prim.sinDouble# 1.0471975511965976) } in
И время выполнения:
$ time ./A
6.283185307179588
real 0m7.859s
Которое я считаю достаточно хорошим. Я также добавляю распаковывать прагмы в тип Point.
Если вы хотите рассуждать о числовой производительности при разных схемах, вы должны проверить Core.
Использование вашего пересмотренного примера. Он испытывает такую же проблему. k является встроенным rotate. GHC считает, что это действительно дешево, когда в этом тесте он дороже.
Наивно, ghc-7.2.3 -O2
$ time ./A
0.1470480616244365
real 0m22.897s
И k оценивается каждый раз, когда вызывается поворот.
Сделайте k strict: один из способов заставить его не использовать общий доступ.
$ time ./A
0.14704806100839019
real 0m2.360s
Используя праймы UNPACK для конструктора точек:
$ time ./A
0.14704806100839019
real 0m1.860s
Ответ 2
Я не думаю, что это повторная оценка.
Во-первых, я переключился на "делать" нотацию и использовал "let" в определении "k", который, как я полагал, должен помочь. Нет - все еще медленно.
Затем я добавил вызов трассировки - просто оценивая один раз. Даже проверил, что быстрый вариант на самом деле производит Double.
Затем я распечатал оба варианта. Небольшая разница в начальных значениях.
Изменение значения "медленного" варианта делает его равной скоростью. Я не знаю, для чего нужен ваш алгоритм - будет ли он очень чувствителен к стартовым значениям?
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: это версия с числовыми литералами. Он отображает время от времени до 23сек против 7сек для меня. Я скомпилировал две отдельные версии кода, чтобы убедиться, что я не делал что-то глупое, не перекомпилируя.
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: я не знаю, как получить коды операций из ghc, но сравнение hexdumps для двух файлов .o показывает, что они отличаются одним байтом - предположительно литеральным. Таким образом, это не может быть время выполнения.
EDIT3: Пробовал профилирование, и это еще больше озадачило меня. если я не пропущу что-то, единственное различие заключается в небольшом расхождении в количестве вызовов fmod (fmod.q, если быть точным).
Профиль "5" предназначен для постоянного окончания "5", то же самое с "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: ссылка ниже относится к двум дампам opcode (благодаря @Tom Ellis). Хотя я не могу их прочитать, они, похоже, имеют одинаковую "форму". Предположительно, строки long random -O2 -fforce-recomp, так и временные различия.
https://gist.github.com/anonymous/6462797
