虽然我有一个很好的LSFR C实现，我想我会在Haskell中尝试相同 - 只是为了看看它是怎么回事。到目前为止，我提出的结果比C实现慢了两个数量级，这引出了一个问题：如何提高性能？显然，小巧的操作是瓶颈，并且剖析器证实了这一点。
以下是使用列表和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
基本上，它测试tap :: [[Int]]中任何给定位长度中定义的LSFR是否为最大长度。 （更确切地说，它只检查在2 n 次迭代后LSFR是否达到初始状态（零）。）
根据剖析器，最昂贵的一行是反馈位d0 = xor' $ map (testBit lfsr) tap'。
到目前为止我尝试过：
Data.Array：尝试放弃，因为没有foldl / r Data.Vector：比基线快一点我使用的编译器选项是：-O2，LTS Haskell 8.12 (GHC-8.0.2)。
可以在gist.github.com上找到参考C ++程序。
不能期望Haskell代码（？）以与C代码一样快的速度运行，但是两个数量级太多，必须有更好的方法来进行比特操作。
更新：应用答案中建议的优化的结果
-O2 -fllvm），执行时间降至1.7秒
-O2 -fllvm -optlc -mcpu=native使其达到0.73s iterate @cirdec替换iterate'与使用Thomas代码时无关（使用默认的“本机”后端和LLVM）。但是，当使用基线代码时， 会产生影响。所以，我们来自100x到8x到1.09x，即比C慢9％！
注意
LLVM后端到GHC 8.0.2需要LLVM 3.7。在Mac OS X上，这意味着使用brew安装此版本，然后符号链接opt和llc。请参阅7.10. GHC Backends。
答案 0 :(得分：8)
Up Front Matters
对于初学者，我在Intel I5~2.5GHz，linux x86-64上使用GHC 8.0.1。
初稿：哦不！慢了！
参数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
所以节拍的时间是77ms - 比这个Haskell代码好两个数量级。让我们潜入。
问题1：Shifty Code
我发现代码有些奇怪。首先是在高性能代码中使用shift。 Shift支持左右移位，这样做需要分支。让我们用两个更可读的权力杀死它（shift 1 x〜＆gt; 2^x和shift x 1〜＆gt; 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.匹配。最后，在部署的代码中，实际上通常使用带有C绑定的Haskell包，但这通常是一种教育练习，所以我希望你玩得开心。
编辑：现在可用的C ++代码占用了我的系统0.10（g++ -O3）和0.12（clang++ -O3 -march=native）秒，所以看起来我们已经击败了我们的标记。 / p>
答案 1 :(得分：6)
我怀疑在评估它之前，以下行正在内存中构建一个类似大型列表的thunk。
let out = last $ take (shift 1 len) $ iterate (advance len (tap!!len)) 0` is
让我们看看我是否正确，如果我是，我们会解决它。第一个调试步骤是了解程序使用的内存。要做到这一点，除了-rtsopts之外，我们将使用选项-O2进行编译。这样可以使RTS options运行程序，包含+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更严格来减少thunk大小。这不会删除thunk的脊柱（连续的迭代），但它可能会减少在脊柱被评估时构建的状态的大小。
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，或者长达3300多万个项目。列表本身可能被list fusion删除，但列表最后一项的thunk超过3300万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 from 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倍。
我不知道Thomas DeBuisson的answer that improves advance是否会有所改善，但仍然留下了iterate advance'。这很容易检查;将iterate'代码添加到该答案中，并使用iterate'代替该答案中的iterate。
答案 2 :(得分：2)
编译器是否将tap !! len移出循环？我怀疑它确实如此，但将其移出来保证这可能会造成伤害：
let tap1 = tap !! len
let out = last $ take (shift 1 len) $ iterate (advance len tap1) 0
在评论中你说＆＃34; 2^len只需要一次＆＃34;，但这是错误的。您每次都在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 is almost never what you need;因为xor总是需要两个参数并且是关联的，所以foldl'很可能是正确的选择（编译器可以优化它，但如果foldl和{{之间存在任何真正的区别1}}而不仅仅是随机变化，在这种情况下可能会失败。）