Эффективное переключение битов в реализации LFSR
Хотя у меня есть хорошая реализация LSFR C, я решил попробовать то же самое в Haskell - просто чтобы посмотреть, как это будет. До сих пор я придумал, что на два порядка медленнее, чем реализация C, и возникает вопрос: как повысить производительность? Очевидно, что операции с битами являются узким местом, и профилировщик подтверждает это.
Вот базовый код на Haskell с использованием списков и Data.Bits:
import Control.Monad (when)
import Data.Bits (Bits, shift, testBit, xor, (.&.), (.|.))
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
tap :: [[Int]]
tap = [
[], [], [], [3, 2],
[4, 3], [5, 3], [6, 5], [7, 6],
[8, 6, 5, 4], [9, 5], [10, 7], [11, 9],
[12, 6, 4, 1], [13, 4, 3, 1], [14, 5, 3, 1], [15, 14],
[16,15,13,4], [17, 14], [18, 11], [19, 6, 2, 1],
[20, 17], [21, 19], [22, 21], [23, 18],
[24,23,22,17], [25, 22], [26, 6, 2, 1], [27, 5, 2, 1],
[28, 25], [29, 27], [30, 6, 4, 1], [31, 28],
[32,22,2,1], [33,20], [34,27,2,1], [35,33],
[36,25], [37,5,4,3,2,1],[38,6,5,1], [39,35],
[40,38,21,19], [41,38], [42,41,20,19], [43,42,38,37],
[44,43,18,17], [45,44,42,41], [46,45,26,25], [47,42],
[48,47,21,20], [49,40], [50,49,24,23], [51,50,36,35],
[52,49], [53,52,38,37], [54,53,18,17], [55,31],
[56,55,35,34], [57,50], [58,39], [59,58,38,37],
[60,59], [61,60,46,45], [62,61,6,5], [63,62] ]
xor' :: [Bool] -> Bool
xor' = foldr xor False
mask :: (Num a, Bits a) => Int -> a
mask len = shift 1 len - 1
advance :: Int -> [Int] -> Int -> Int
advance len tap lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
main :: IO ()
main = do
args <- getArgs
when (null args) $ fail "Usage: lsfr <number-of-bits>"
let len = read $ head args
when (len < 8) $ fail "No need for LFSR"
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0
if out == 0 then do
putStr "OK\n"
exitSuccess
else do
putStr "FAIL\n"
exitFailure
В основном это проверяет, определен ли LSFR в tap :: [[Int]] для любой заданной длины битов имеет максимальную длину. (Точнее, он просто проверяет, достигает ли LSFR начального состояния (ноль) после 2 n итераций.)
Согласно профилировщику самой дорогой строкой является бит обратной связи d0 = xor' $ map (testBit lfsr) tap',
Что я пробовал до сих пор:
- использование
Data.Array: Попытка прекращена, потому что нет фолд / р - использование
Data.Vector: Немного быстрее базовой линии
Опции компилятора, которые я использую: -O2, LTS Haskell 8.12 (GHC-8.0.2),
Справочную программу на C++ можно найти на gist.github.com.
Нельзя ожидать, что код на Haskell (?) Будет работать так же быстро, как и код на C, но на два порядка это слишком много, поэтому должен быть лучший способ сделать битовую игру.
Обновление: результаты применения оптимизаций, предложенных в ответах.
- Эталонная программа C++ с вводом 28, скомпилированная с LLVM 8.0.0, работает на моей машине за 0,67 с (то же самое с Clang 3.7 немного медленнее, 0,68 с)
- Базовый код на Haskell работает примерно в 100 раз медленнее (из-за неэффективности пространства не пробуйте его с входными данными больше 25)
- С переписыванием @Thomas M. DuBuisson, все еще использующим бэкэнд GHC по умолчанию, время выполнения снижается до 5,2 с.
- С переписыванием Thomas M. DuBuisson, теперь использующим бэкэнд LLVM (опция GHC
-O2 -fllvm), время выполнения уменьшается до 1.7с- Использование опции GHC
-O2 -fllvm -optlc -mcpu=nativeприносит это до 0,73 с
- Использование опции GHC
- Замена
iterateсiterate'из @cirdec не имеет значения, когда используется код Томаса (как с "родным" внутренним интерфейсом по умолчанию, так и с LLVM). Тем не менее, это имеет значение, когда используется базовый код.
Итак, мы выросли со 100х до 8х до 1,09х, то есть всего на 9% медленнее, чем С!
Примечание. Для бэкэнда LLVM в GHC 8.0.2 требуется LLVM 3.7. В Mac OS X это означает установку этой версии с brew а затем символические ссылки opt а также llc, Смотри 7.10. GHC Backends.
3 ответа
Up Front Matters
Для начала я использую GHC 8.0.1 на Intel I5 ~2,5 ГГц, linux x86-64.
Первый проект: О, нет! Замедляет!
Ваш стартовый код с параметром 25 выполняется:
% ghc -O2 orig.hs && time ./orig 25
[1 of 1] Compiling Main ( orig.hs, orig.o )
Linking orig ...
OK
./orig 25 7.25s user 0.50s system 99% cpu 7.748 total
Таким образом, время удара составляет 77 мс - на два порядка лучше, чем этот код на Haskell. Давайте погрузимся в.
Вопрос 1: Код Shifty
Я нашел пару странностей с кодом. Сначала было использование shift в коде высокой производительности. Shift поддерживает сдвиг влево и вправо, и для этого требуется ветвь. Давайте убьем это с более читаемыми степенями два и такие (shift 1 x ~> 2^x а также shift x 1 ~> 2*x):
% ghc -O2 noShift.hs && time ./noShift 25
[1 of 1] Compiling Main ( noShift.hs, noShift.o )
Linking noShift ...
OK
./noShift 25 0.64s user 0.00s system 99% cpu 0.637 total
(Как вы отметили в комментариях: да, это требует расследования. Возможно, некоторая странность предыдущего кода препятствовала запуску правила перезаписи и, как следствие, приводил к гораздо худшему коду)
Проблема 2: списки битов? Операции Int спасают день!
Одно изменение, один порядок величины. Ура. Что-то еще? Ну, у вас есть этот неуклюжий список битовых локаций, которые вы используете, и это похоже на то, что вы просите о неэффективности и / или опираетесь на хрупкую оптимизацию. На этом этапе я отмечу, что жесткое кодирование любого выбора из этого списка приводит к действительно хорошей производительности (такой как testBit lsfr 24 `xor` testBit lsfr 21) но мы хотим более общее быстрое решение.
Я предлагаю, чтобы мы вычислили маску всех местоположений крана, а затем сделали подсчет попсов за одну инструкцию. Для этого нам нужен только один Int перешел в advance вместо целого списка. Инструкция popcount требует хорошей генерации сборки, которая требует llvm и, вероятно, -optlc-mcpu=native или другой набор инструкций, который не является пессимистичным.
Этот шаг дает нам pc ниже. Я сложил в охранник-удаление advance это было упомянуто в комментариях:
let tp = sum $ map ((2^) . subtract 1) (tap !! len)
pc lfsr = fromEnum (even (popCount (lfsr .&. tp)))
mask = 2^len - 1
advance' :: Int -> Int
advance' lfsr = (2*lfsr .&. mask) .|. pc lfsr
out :: Int
out = last $ take (2^len) $ iterate advance' 0
Наши итоговые показатели:
% ghc -O2 so.hs -fforce-recomp -fllvm -optlc-mcpu=native && time ./so 25
[1 of 1] Compiling Main ( so.hs, so.o )
Linking so ...
OK
./so 25 0.06s user 0.00s system 96% cpu 0.067 total
Это более чем на два порядка от начала до конца, так что, надеюсь, он соответствует вашему C. Наконец, в развернутом коде на самом деле очень распространены пакеты Haskell с привязками C, но это часто является обучающим упражнением, поэтому я надеюсь, что вам было весело.
Редактировать: теперь доступный код C++ занимает мою систему 0.10 (g++ -O3) и 0,12 (clang++ -O3 -march=native) секунд, так что, кажется, мы побили нашу отметку честно.
Я подозреваю, что следующая строка строит большой подобный списку thunk в памяти перед его оценкой.
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0` is
Давайте выясним, прав ли я, и если да, то мы это исправим. Первый шаг отладки - получить представление о памяти, используемой программой. Для этого мы собираемся скомпилировать с параметрами -rtsopts в дополнение к -O2, Это позволяет запустить программу с опциями RTS, в том числе +RTS -s который выводит небольшое резюме памяти.
Начальная производительность
Запуск вашей программы как lfsr 25 +RTS -s Я получаю следующий вывод
OK
5,420,148,768 bytes allocated in the heap
6,705,977,216 bytes copied during GC
1,567,511,384 bytes maximum residency (20 sample(s))
357,862,432 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.453s 2.522s 0.0002s 0.0009s
Gen 1 20 colls, 0 par 2.281s 3.065s 0.1533s 0.7128s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.438s ( 1.162s elapsed)
GC time 4.734s ( 5.587s elapsed)
EXIT time 0.016s ( 0.218s elapsed)
Total time 6.188s ( 6.967s elapsed)
%GC time 76.5% (80.2% elapsed)
Alloc rate 3,770,538,273 bytes per MUT second
Productivity 23.5% of total user, 19.8% of total elapsed
Это много памяти, используемой одновременно. Скорее всего, где-то там находится большой гром.
Попытка уменьшить размер thunk
Я предположил, что стук встраивается в iterate (advance ...), Если это так, мы можем попытаться уменьшить размер переходника, сделав advance более строг в своем lsfr аргумент. Это не удалит позвоночник (последовательные итерации), но может уменьшить размер состояния, которое создается при оценке позвоночника.
BangPatterns это простой способ сделать функцию строгой в аргументе. f !x = .. это сокращение для f x = seq x $ ...
{-# LANGUAGE BangPatterns #-}
advance :: Int -> [Int] -> Int -> Int
advance len tap = go
where
go !lfsr
| d0 = shifted
| otherwise = shifted .|. 1
where
shifted = shift lfsr 1 .&. mask len
d0 = xor' $ map (testBit lfsr) tap'
tap' = map (subtract 1) tap
Давайте посмотрим, что это меняет...
>lfsr 25 +RTS -s
OK
5,420,149,072 bytes allocated in the heap
6,705,979,368 bytes copied during GC
1,567,511,448 bytes maximum residency (20 sample(s))
357,862,448 bytes maximum slop
3025 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10343 colls, 0 par 2.688s 2.711s 0.0003s 0.0059s
Gen 1 20 colls, 0 par 2.438s 3.252s 0.1626s 0.8013s
INIT time 0.000s ( 0.000s elapsed)
MUT time 1.328s ( 1.146s elapsed)
GC time 5.125s ( 5.963s elapsed)
EXIT time 0.000s ( 0.226s elapsed)
Total time 6.484s ( 7.335s elapsed)
%GC time 79.0% (81.3% elapsed)
Alloc rate 4,081,053,418 bytes per MUT second
Productivity 21.0% of total user, 18.7% of total elapsed
Ничего заметного.
Устранение позвоночника
Я полагаю, что это позвоночник iterate (advance ...) это строится. Ведь для команды, которую я запускаю, список будет 2^25 или чуть более 33 миллионов предметов. Сам список, вероятно, удаляется слиянием списков, но за последний элемент списка требуется более 33 миллионов приложений. advance ...
Для решения этой проблемы нам нужна строгая версия iterate так что значение вынуждено Int перед применением advance функционировать снова. Это должно держать память только до одного lfsr значение за один раз, наряду с вычисленным в настоящее время применением advance,
К сожалению, строгого iterate в Data.List, Вот тот, который не разочаровывается в слиянии списков, который обеспечивает другие важные (я думаю) оптимизации производительности для этой проблемы.
{-# LANGUAGE BangPatterns #-}
import GHC.Base (build)
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' f = go
where go !x = x : go (f x)
{-# NOINLINE [0] iterateFB' #-}
iterateFB' :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB' c f = go
where go !x = x `c` go (f x)
{-# RULES
"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterateFB' c f x)
"iterateFB'" [1] iterateFB' (:) = iterate'
#-}
Это просто iterate от GHC.List (вместе со всеми правилами переписывания), но сделан строгим в накопленном аргументе.
Оснащен строгой итерацией, iterate' мы можем изменить неприятную линию на
let out = last $ take (shift 1 len) $ iterate' (advance len (tap!!len)) 0
Я ожидаю, что это будет работать намного лучше. Посмотрим...
>lfsr 25 +RTS -s
OK
3,758,156,184 bytes allocated in the heap
297,976 bytes copied during GC
43,800 bytes maximum residency (1 sample(s))
21,736 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 7281 colls, 0 par 0.047s 0.008s 0.0000s 0.0000s
Gen 1 1 colls, 0 par 0.000s 0.000s 0.0002s 0.0002s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.750s ( 0.783s elapsed)
GC time 0.047s ( 0.008s elapsed)
EXIT time 0.000s ( 0.000s elapsed)
Total time 0.797s ( 0.792s elapsed)
%GC time 5.9% (1.0% elapsed)
Alloc rate 5,010,874,912 bytes per MUT second
Productivity 94.1% of total user, 99.0% of total elapsed
Это б 0.00002 раза больше памяти и работает в 10 раз быстрее.
Я не знаю, улучшит ли это ответ Томаса Дебюссона, который улучшит advance но все равно оставляет ленивым iterate advance' на месте. Это было бы легко проверить; добавить iterate' код для этого ответа и использовать iterate' на месте iterate в этом ответе.
Поднимает ли компилятор
tap !! lenвне цикла? Я подозреваю, что это так, но его перемещение, чтобы гарантировать, что это не повредит:let tap1 = tap !! len let out = last $ take (shift 1 len) $ iterate (advance len tap1) 0В комментариях говорите
2^lenнужно ровно один раз ", но это неправильно. Вы делаете это каждый раз вadvance, Так что вы можете попробоватьadvance len tap mask lfsr | d0 = shifted | otherwise = shifted .|. 1 where shifted = shift lfsr 1 .&. mask d0 = xor' $ map (testBit lfsr) tap' tap' = map (subtract 1) tap -- in main let tap1 = tap !! len let numIterations = 2^len let mask = numIterations - 1 let out = iterate (advance len tap1 mask) 0 !! (numIterations - 1)(компилятор не может оптимизировать
last $ take ...в!!в общем, потому что они разные для конечных списков, ноiterateвсегда возвращает бесконечный.)Вы сравнили
foldrсfoldl, ноfoldlпочти никогда не то, что вам нужно; посколькуxorвсегда нужны оба аргумента и является ассоциативным,foldl'очень вероятно, будет правильным выбором (компилятор может оптимизировать его, но если есть какая-либо реальная разница междуfoldlа такжеfoldrи не просто случайное изменение, оно могло бы в этом случае потерпеть неудачу).