Question

我正在努力加快以下功能：

{-# LANGUAGE BangPatterns #-}

import Data.Word
import Data.Bits
import Data.List (foldl1')
import System.Random
import qualified Data.List as L

data Tree a = AB (Tree a) (Tree a) | A (Tree a) | B (Tree a) | C !a
    deriving Show

merge :: Tree a -> Tree a -> Tree a
merge (C x) _               = C x
merge _ (C y)               = C y
merge (A ta) (A tb)         = A (merge ta tb)
merge (A ta) (B tb)         = AB ta tb
merge (A ta) (AB tb tc)     = AB (merge ta tb) tc
merge (B ta) (A tb)         = AB tb ta
merge (B ta) (B tb)         = B (merge ta tb)
merge (B ta) (AB tb tc)     = AB tb (merge ta tc)
merge (AB ta tb) (A tc)     = AB (merge ta tc) tb
merge (AB ta tb) (B tc)     = AB ta (merge tb tc)
merge (AB ta tb) (AB tc td) = AB (merge ta tc) (merge tb td)

为了强调其效果，我使用merge实现了排序：

fold ab a b c list = go list where
    go (AB a' b') = ab (go a') (go b')
    go (A a')     = a (go a')
    go (B b')     = b (go b')
    go (C x)      = c x

mergeAll :: [Tree a] -> Tree a
mergeAll = foldl1' merge

foldrBits :: (Word32 -> t -> t) -> t -> Word32 -> t
foldrBits cons nil word = go 32 word nil where
    go 0 w !r = r
    go l w !r = go (l-1) (shiftR w 1) (cons (w.&.1) r)

word32ToTree :: Word32 -> Tree Word32
word32ToTree w = foldrBits cons (C w) w where
    cons 0 t = A t
    cons 1 t = B t

toList = fold (++) id id (\ a -> [a])

sort = toList . mergeAll . map word32ToTree

main = do
    is <- mapM (const randomIO :: a -> IO Word32) [0..500000]
    print $ sum $ sort is

随着时间的推移表现相当不错，比Data.List sort慢约2.5倍。然而，我没有采取任何措施进一步加强这一点：在UNPACK C !a上列出几个函数，在许多地方敲打注释// Container activity must implement this interface public interface OnCreateViewCalledListener { void OnCreateViewCalled(String someData); }。有没有办法加快这个功能？

Answer 1

你肯定分配了太多的thunk。我将展示如何分析代码：

merge (A ta) (A tb)         = A (merge ta tb)

这里你用一个参数分配构造函数A，这是一个thunk。你能说出merge ta tb块会被迫吗？可能只在最后，当使用结果树时。尝试为每个Tree构造函数的每个参数添加一个爆炸，以确保它是严格的脊柱：

data Tree a = AB !(Tree a) !(Tree a) | A !(Tree a) | B !(Tree a) | C !a

下一个例子：

go l w !r = go (l-1) (shiftR w 1) (cons (w.&.1) r)

在这里，您要为l-1，shifrR w 1和cons (w.&.1) r分配一个thunk。在将l与o进行比较时，第一个将强制进行下一次迭代，在下一次迭代中强制执行3d thunk时将强制执行第二次迭代（此处使用w），由于r上的爆炸，第三个thunk被强制进行下一次迭代。所以可能这个特殊的条款还可以。

加快此功能有哪些可能性？

1 个答案: