Оптимизация GHC: гипотеза Collatz

Я написал код для Project Euler Challenge 14, в Haskell и С++ (ideone links). Они оба помнят любые вычисления, которые они ранее делали в массиве.

Используя ghc -O2 и g++ -O3 соответственно, С++ работает в 10-15 раз быстрее, чем версия Haskell.

Пока я понимаю, что версия Haskell может работать медленнее, и что Haskell - более удобный язык для записи, было бы неплохо узнать некоторые изменения кода, которые я могу сделать для версии Haskell, чтобы заставить ее работать быстрее (в идеале в пределах фактора 2 или 3 версии С++)?

Код Haskell находится здесь:

import Data.Array
import Data.Word
import Data.List

collatz_array = 
  let
    upperbound = 1000000
    a = array (1, upperbound) [(i :: Word64, f i :: Int) | i <- [1..upperbound]]
    f i = i `seq`
      let
        check_f i = i `seq` if i <= upperbound then a ! i else f i
      in
        if (i == 1) then 0 else (check_f ((if (even i) then i else 3 * i + 1) `div` 2)) + 1
  in a

main = 
  putStrLn $ show $ 
   foldl1' (\(x1,x2) (y1,y2) -> if (x2 >= y2) then (x1, x2) else (y1, y2)) $! (assocs collatz_array)

Edit:

Я также сделал версию с использованием unboxed изменяемых массивов. Он по-прежнему в 5 раз медленнее, чем версия С++, но значительно улучшилась. Код находится на ideone здесь.

Я хотел бы знать улучшения в версии mutable array, которые приближают ее к версии С++.

Ответ 1

Некоторые проблемы с вашим (изменяемым массивом):

Вы используете складку, чтобы найти максимальную длину цепи, так как массив должен быть преобразован в список ассоциаций, что требует времени и распределения, поэтому версия С++ не нужна.
Вы используете even и div для тестирования и деления на 2. Они медленные. g++ оптимизирует обе операции для более быстрых операций с битами (на платформах, где, предположительно, быстрее), но GHC не выполняет эти низкоуровневые оптимизации (пока), поэтому пока что они должны выполняться вручную.
Вы используете readArray и writeArray. Дополнительная проверка границ, которая не выполняется в коде на С++, также требует времени, как только будут рассмотрены другие проблемы, это составляет значительную часть времени работы (около 25% на моей коробке), поскольку они сделаны много чтения и записи в алгоритме.

Включая это в реализацию, я получаю

import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits

collatz_array :: ST s (STUArray s Int Int)
collatz_array = do
    let upper = 10000000
    arr <- newArray (0,upper) 0
    unsafeWrite arr 2 1
    let check i
            | upper < i = return arr
            | i .&. 1 == 0 = do
                l <- unsafeRead arr (i `shiftR` 1)
                unsafeWrite arr i (l+1)
                check (i+1)
            | otherwise = do
                let j = (3*i+1) `shiftR` 1
                    find k l
                        | upper < k = find (next k) $! l+1
                        | k < i     = do
                            m <- unsafeRead arr k
                            return (m+l)
                        | otherwise = do
                            m <- unsafeRead arr k
                            if m == 0
                              then do
                                  n <- find (next k) 1
                                  unsafeWrite arr k n
                                  return (n+l)
                              else return (m+l)
                          where
                            next h
                                | h .&. 1 == 0 = h `shiftR` 1
                                | otherwise = (3*h+1) `shiftR` 1
                l <- find j 1
                unsafeWrite arr i l
                check (i+1)
    check 3

collatz_max :: ST s (Int,Int)
collatz_max = do
    car <- collatz_array
    (_,upper) <- getBounds car
    let find w m i
            | upper < i = return (w,m)
            | otherwise = do
                l <- unsafeRead car i
                if m < l
                  then find i l (i+1)
                  else find w m (i+1)
    find 1 0 2

main :: IO ()
main = print (runST collatz_max)

И тайминги (оба для 10 миллионов):

$ time ./cccoll
8400511 429

real    0m0.210s
user    0m0.200s
sys     0m0.009s
$ time ./stcoll
(8400511,429)

real    0m0.341s
user    0m0.307s
sys     0m0.033s

который выглядит не так уж плохо.

Важное примечание: Этот код работает только на 64-битном GHC (так, в частности, в Windows вам нужен ghc-7.6.1 или новее, предыдущие GHC были 32-битными даже на 64 -бит Windows), поскольку элементы промежуточной цепи превышают 32-битный диапазон. В 32-битных системах нужно было бы использовать Integer или 64-разрядный целочисленный тип (Int64 или Word64) для цепочки с высокой стоимостью, поскольку примитивные 64-битные операции (арифметические и сдвиги) реализованы как внешние вызовы функций C в 32-битных GHC (быстрые внешние вызовы, но все же намного медленнее, чем прямые машинные операции).

Ответ 2

Сайт ideone использует ghc 6.8.2, который становится довольно старым. На ghc версии 7.4.1 разница намного меньше.

С ghc:

$ ghc -O2 euler14.hs && time ./euler14
(837799,329)
./euler14  0.63s user 0.04s system 98% cpu 0.685 total

С g++ 4.7.0:

$ g++ --std=c++0x -O3 euler14.cpp && time ./a.out
8400511 429
./a.out  0.24s user 0.01s system 99% cpu 0.252 total

Для меня версия ghc только в 2,7 раза медленнее, чем версия С++. Кроме того, обе программы не дают того же результата... (не хороший знак, особенно для бенчмаркинга)