Есть ли способ быстрее сделать программу подсчета слов без использования нечистых трюков?

Как небольшое упражнение, я сделал следующую программу подсчета слов в 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 " "

Проблема в том, что он в 16 раз медленнее, чем моя реализация python с изменяемым dict:

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, использование изменяемых структур данных и т.д.?

PS: файл данных доступен по следующему URL-адресу: http://www.gutenberg.org/cache/epub/13951/pg13951.txt

Ответы

Ответ 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 - это связанный список символов, который позволяет манипулировать струны довольно изящные, но неэффективные. Мы можем использовать тип Text, чтобы получить больше эффективная обработка строк. Я также переписал вашу функцию pp для использования unlines вместо foldl' и используйте words вместо splitOn для исходного раскола.

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