performance - 有没有办法在不使用不纯技巧的情况下让我的字数计算程序更快？

Question

作为一个小练习，我在 haskell 中制作了以下单词计数程序。它计算文本文件中不同的单词，并输出 50 个最常见的单词及其频率。

import qualified Data.Map as Map
import Data.List.Split
import Data.List
import Data.Ord

-- Count words
count = Map.toList . foldl' increment Map.empty
    where
        increment dict k = Map.insert k (1 + Map.findWithDefault 0 k dict) dict

-- Sort the counts
countAndSort = sortBy (flip $ comparing snd) . count

-- Pretty printing
pp :: Show a => [(String,a)] -> IO()
pp = putStrLn . foldl' format "" where
    format text (x,y) = text ++ "\n" ++ x ++ "\t" ++ show y

main = readFile  "pg13951.txt" >>= pp . take 50 .countAndSort . splitOn " "

问题是它比我使用可变 dict 的 python 实现慢 16 倍:

def increment(dic,word):
    dic[word] = dic.get(word,0) + 1
    return dic

print sorted(reduce(increment,open("pg13951.txt").read().split(),{}).items(),key=lambda e:-e[1])[:50]

我认为问题是由于 ghc 不断地重新分配新 map ，而它可以一遍又一遍地重用同一个 map 。运行时统计显示了很多分配:

$ ghc -rtsopts count.hs
$ ./count +RTS -sstderr

de      7682
et      4423
la      4238
<snip>
d'Artagnan      511
M.      502
c'est   443
d'Artagnan,     443

     705,888,048 bytes allocated in the heap
     655,511,720 bytes copied during GC
     139,823,800 bytes maximum residency (10 sample(s))
       1,049,416 bytes maximum slop
             287 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1366 colls,     0 par    2.16s    2.26s     0.0017s    0.0072s
  Gen  1        10 colls,     0 par    2.86s    3.09s     0.3093s    1.5055s

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    3.18s  (  3.36s elapsed)
  GC      time    5.02s  (  5.36s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    8.20s  (  8.72s elapsed)

  %GC     time      61.2%  (61.4% elapsed)

  Alloc rate    221,831,366 bytes per MUT second

  Productivity  38.8% of total user, 36.5% of total elapsed

我的问题是:有没有办法让这个程序表现得更好，而无需使用诸如在 IO monad 中工作、使用可变数据结构等肮脏的技巧？

PS:数据文件可在以下网址获得: http://www.gutenberg.org/cache/epub/13951/pg13951.txt

Answer 1

以下是我尝试过的一些快速简单的优化。

我机器上的原始版本:

real    0m1.539s
user    0m1.452s
sys 0m0.076s

而不是使用 insert和 foldl'您可以使用 fromListWith数数
的话。

count = Map.toList . Map.fromListWith (+) . flip zip (repeat 1)

这快了两倍多。

real    0m0.687s
user    0m0.648s
sys 0m0.032s

String type 是一个字符的链表，它使操作
字符串相当优雅但效率低下。我们可以使用 Text输入以获取更多信息
高效的字符串处理。我还重写了您的pp使用函数unlines而不是 foldl'并使用 words而是 splitOn为原来的 split 。

{-# LANGUAGE OverloadedStrings #-}

import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T

pp :: Show a => [(Text,a)] -> IO()
pp = T.putStrLn . T.unlines . map format where
    format (x,y) = x <> "\t" <> (T.pack $ show y)

main = T.readFile  "pg13951.txt" >>= pp . take 50 .countAndSort . T.words

同样，速度是上一步的两倍。

real    0m0.330s
user    0m0.316s
sys 0m0.008s

使用 Map 的严格版本

import qualified Data.Map.Strict as Map

速度提升约 20%

real    0m0.265s
user    0m0.252s
sys 0m0.008s