algorithm - 在 Haskell 中使用向量来提高性能

Question

我对 Haskell 很陌生，我有一个问题，即使用不纯(可变)数据结构可以提高哪些性能。我试图将我听到的一些不同的东西拼凑起来，所以如果我的术语不完全正确，或者有一些小错误，请多多包涵。

为了具体说明这一点，请考虑快速排序算法(取自 Haskell wiki)。

quicksort :: Ord a => [a] -> [a]
quicksort []     = []
quicksort (p:xs) = (quicksort lesser) ++ [p] ++ (quicksort greater)
    where
        lesser  = filter (< p) xs
        greater = filter (>= p) xs

这不是“真正的快速排序”。 “真正的”快速排序算法就位，而事实并非如此。这是非常低效的内存。

另一方面，可以在 Haskell 中使用向量来实现就地快速排序。在 this stackoverflow answer. 中给出了一个示例

第二种算法比第一种算法快多少？ Big O 表示法在这里没有帮助，因为性能改进将来自更有效地使用内存，而不是拥有更好的算法(对吧？)。我厌倦了自己构建一些测试用例，但我很难让事情运行起来。

一个理想的答案会给出一些关于什么使就地 Haskell 算法在理论上更快的想法，以及一些测试数据集上运行时间的示例比较。

Answer 1

没有什么比测试更好的了，对吧？结果并不令人意外:对于 [0 .. 1000000] 范围内的随机整数列表，

list size: 200000         ghc              -O2     -fllvm  -fllvm-O2
────────                   ────────   ────────   ────────   ────────
Data.List.sort            0.878969s  0.883219s  0.878106s  0.888758s
Naïve.quicksort           0.711305s  0.870647s  0.845508s  0.919925s
UArray_IO.quicksort       9.317783s  1.919583s  9.390687s  1.945072s
Vector_Mutable.quicksort   1.48142s  0.823004s  1.526661s  0.806837s

在这里，Data.List.sort 就是它的本质，Naïve.quicksort 是您引用的算法，UArray_IO.quicksort 和 Vector_Mutable.quicksort 取自您链接到的问题:klapaucius' 和 Dan Burton's answer 结果证明在性能方面非常次优，看看有什么更好的包装以便接受列表(不确定我是否完全正确):

quicksort :: [Int] -> [Int]
quicksort l = unsafePerformIO $ do
  let bounds = (0, length l)
  arr <- newListArray bounds l :: IO (IOUArray Int Int)
  uncurry (qsort arr) bounds
  getElems arr

和

quicksort :: Ord a => [a] -> [a]
quicksort = toList . iqsort . fromList

分别。

如您所见，在对随机生成的整数列表进行排序的速度方面，naïve 算法与 Data.Vector 的可变解决方案相差不远，而 IOUArray 实际上要差得多。测试是在运行 Ubuntu 11.10 x86-64 的 Intel i5 笔记本电脑上进行的。

考虑到 ɢᴏᴏᴅ 可变实现毕竟仍然远远领先于此处比较的所有实现，以下内容并没有多大意义。

请注意，这并不意味着一个不错的基于列表的程序可以始终跟上其可变实现的等价物，但 GHC 确实在接近性能方面做得很好。此外，这当然取决于数据:这些是随机生成的列表进行排序的时间，其中包含 0 到 1000 之间的值，而不是 0 和 1000000 如上所述，即具有许多重复项:

list size: 200000         ghc               -O2      -fllvm  -fllvm-O2
────────                    ────────   ────────    ────────   ────────
Data.List.sort             0.864176s  0.882574s   0.850807s  0.857957s
Naïve.quicksort            1.475362s  1.526076s   1.475557s  1.456759s
UArray_IO.quicksort       24.405938s  5.255001s  23.561911s  5.207535s
Vector_Mutable.quicksort   3.449168s  1.125788s   3.202925s  1.117741s

更不用说预先排序的数组了。

非常有趣的是(只有在非常大的尺寸时才变得明显，这需要 rtsopts 来增加堆栈容量)，是如何使用 -fllvm -O2 使两个可变实现变得显着变慢:

list size: 3⋅10⁶        ghc      -O1   -fllvm-O1         -O2   -fllvm-O2
────────                    ────────    ────────    ────────    ────────
Data.List.sort            23.897897s  24.138117s  23.708218s  23.631968s
Naïve.quicksort           17.068644s  19.547817s  17.640389s  18.113622s
UArray_IO.quicksort       35.634132s  38.348955s  37.177606s  49.190503s
Vector_Mutable.quicksort  17.286982s  17.251068s  17.361247s  36.840698s

对我来说，不可变实现在 llvm 上表现得更好似乎是合乎逻辑的(它在某种程度上不是一成不变地做所有事情吗？)，尽管我不明白为什么这只会随着高度优化的可变版本的放缓而变得明显和大数据量。

测试程序:

$ cat QSortPerform.hs
module Main where

import qualified Data.List(sort)
import qualified Naïve
import qualified UArray_IO
import qualified Vector_Mutable

import Control.Monad
import System.Random
import System.Environment

sortAlgos :: [ (String, [Int]->[Int]) ]
sortAlgos = [ ("Data.List.sort", Data.List.sort)
            , ("Naïve.quicksort", Naïve.quicksort)
            , ("UArray_IO.quicksort", UArray_IO.quicksort)
            , ("Vector_Mutable.quicksort", Vector_Mutable.quicksort) ]

main = do
   args <- getArgs
   when (length args /= 2) $ error "Need 2 arguments"

   let simSize = read $ args!!1
   randArray <- fmap (take simSize . randomRs(0,1000000)) getStdGen

   let sorted = case filter ((== args!!0) . fst) sortAlgos of
        [(_, algo)] -> algo randArray
        _ -> error $ "Argument must be one of " 
                        ++ show (map fst sortAlgos)

   putStr "First element:  "; print $ sorted!!0
   putStr "Middle element: "; print $ sorted!!(simSize`div`2)
   putStr "Last element:   "; print $ sorted!!(simSize-1)

它在命令行上获取算法名称和数组大小。运行时比较是用这个程序完成的:

$ cat PerformCompare.hs
module Main where

import System.Process
import System.Exit
import System.Environment
import Data.Time.Clock
import Data.List
import Control.Monad
import Text.PrettyPrint.Boxes

compiler = "ghc"
testProgram = "./QSortPerform"
flagOpts = [[], ["-O2"], ["-fllvm"], ["-fllvm","-O2"]]
algos = ["Data.List.sort","Naïve.quicksort","UArray_IO.quicksort","Vector_Mutable.quicksort"]


main = do
   args <- getArgs
   let testSize = case args of
         [numb] -> read numb
         _      -> 200000

   results <- forM flagOpts $ \flags -> do

      compilerExitC <- verboseSystem
              compiler $ testProgram : "-fforce-recomp" : flags
      when (compilerExitC /= ExitSuccess) .
         error $ "Compiler error \"" ++ show compilerExitC ++"\""

      algoCompare <- forM algos $ \algo -> do
         startTime <- getCurrentTime
         exitC <- verboseSystem testProgram [algo, show testSize]
         endTime <- getCurrentTime
         when (exitC /= ExitSuccess) .
            error $ "Program error \"" ++ show exitC ++"\""
         return . text . show $ diffUTCTime endTime startTime

      return . vcat right $ text(concat flags)
                          : text("────────")
                          : algoCompare

   let table = hsep 2 bottom
         $ vcat left (map text $ ("list size: "++show testSize)
                               : "────────"
                               : algos                          )
         : results

   printBox table



verboseSystem :: String -> [String] -> IO ExitCode
verboseSystem cmd args = do
   putStrLn . unwords $ cmd : args
   rawSystem cmd args