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 不断地重新分配新地图，而它可以一遍又一遍地重用同一个地图。运行时统计显示了很多分配：

$ 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

1. 而不是使用insertandfoldl'你可以使用fromListWith来计算单词。

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

   这快了两倍多。

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

2. 该String类型是字符的链接列表，这使得操作字符串相当优雅但效率低下。我们可以使用该Text类型来获得更有效的字符串处理。我还重写了你的pp函数来使用unlines 而不是使用foldl'原始拆分。wordssplitOn

   {-# 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
   

3. 使用严格的版本Map

   import qualified Data.Map.Strict as Map
   

   速度提升约 20%

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