Haskell程序与Perl相比性能低下

Question

我正在使用Haskell处理Facebook Hackercup 2015问题并且遇到了这个问题.

输入:以整数T开头,问题数量.对于每个问题,有一行包含3个以空格分隔的整数:A,B和K.

输出:对于第i个问题,打印包含"Case #i:"的行,后跟包含范围[A,B]中的优先级为K的整数数.

数字X的优先级是其主要因素的数量.例如,12的优先级是2(因为它可以被素数2和3整除),550的优先级是3(因为它可以被素数2,5和11整除),7的优先级是1(作为只有素数可以被7整除.

1≤T≤1002≤A≤B≤10^ 71≤K≤10^ 9 

这是我的Haskell解决方案:

import System.IO
import Data.List
import Control.Monad

incEvery :: Int -> [(Int -> Int)]
incEvery n = (cycle ((replicate (n-1) id) ++ [(+ 1)]))

primes2 :: [Int]
primes2 = sieve 2 (replicate (10^7) 0)
  where
    sieve _ [] = []
    sieve n (a:xs) = (a + (if a == 0 then 1 else 0))
      : if a == 0 then
          sieve (n+1) (zipWith ($) (incEvery n) xs)
        else
          sieve (n+1) xs

process :: (Int, Int, Int) -> Int
process (lo, hi, k) =
  length . filter (\(a, b) -> a >= lo && a <= hi && b == k) . zip [2,3..] $ primes2

readIn :: [String] -> (Int, Int, Int)
readIn =
  (\[x, y, z] -> (x, y, z)) . fmap (read::String->Int) . take 3

lib :: String -> String
lib xs = unlines . fmap (\(i, x) -> "Case #" ++ (show i) ++ ": " ++ x) . zip [1,2..]
  . fmap parse . tail . lines $ xs
  where
    parse = (show . process . readIn . words)

main :: IO ()
main = interact lib

这是我的Perl解决方案:

use strict;
use warnings;

my $max = 10000010;

my @f = (0) x $max;

for my $i (2 .. $max) {
    if($f[$i] == 0) {
        $f[$i] = 1;
        # print $i . "\n";
        for my $j (2 .. ($max / $i)) {
            $f[$i * $j] ++;
        }
    }
}

my $k =  <STDIN>;
for my $i (1 .. $k) {
    my $line = <STDIN>;
    if($line) {
        chomp $line;
        my ($a, $b, $t) = split(' ', $line);
        my $ans = 0;
        for my $j ($a .. $b) {
            if($f[$j] == $t) {
                $ans ++;
            }
        }
        print "Case #$i: " . $ans . "\n";
    }    
}

虽然我对两种语言都使用相同的筛选算法,但Haskell版本在10 ^ 7比例的数据上明显慢于Perl版本.基本上,以下Haskell函数比它的Perl函数慢:

incEvery :: Int -> [(Int -> Int)]
incEvery n = (cycle ((replicate (n-1) id) ++ [(+ 1)]))

primes2 :: [Int]
primes2 = sieve 2 (replicate (10^7) 0)
  where
   sieve _ [] = []
   sieve n (a:xs) = (a + (if a == 0 then 1 else 0))
   : if a == 0 then
      sieve (n+1) (zipWith ($) (incEvery n) xs)
     else
      sieve (n+1) xs

我认为这两个递归都会(zipWith ($) (incEvery n) xs)导致问题.有任何想法吗？

Answer 1

绝对没有理由需要采用命令式编程来获得性能.关于Haskell的独特之处在于,如果您想以纯粹的功能性方式进行编程,您必须学会不同的思考方式.利用懒惰来加快速度:

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Applicative ( pure, (<$>) )
import Data.List           ( nub )
import Data.Monoid         ( (<>) )

isPrime :: (Integral i) => i -> Bool
isPrime n = isPrime_ n primes
  where isPrime_ n (p:ps)
          | p * p > n      = True
          | n `mod` p == 0 = False
          | otherwise      = isPrime_ n ps

primes :: (Integral i) => [i]
primes = 2 : filter isPrime [3,5..]

primeFactors :: (Integral i) => i -> [i]
primeFactors n = factors n primes
  where factors n (x:xs)
          | x * x > n      = [n]
          | n `mod` x == 0 = x : factors (n `div` x) (x:xs)
          | otherwise      = factors n xs

primacity :: (Integral i) => i -> Int
primacity = length . nub . primeFactors

user :: IO Int
user = do
  xs <- getLine
  let a :: Int = read . takeWhile (/=' ') . dropN 0 $ xs
  let b :: Int = read . takeWhile (/=' ') . dropN 1 $ xs
  let k :: Int = read . takeWhile (/=' ') . dropN 2 $ xs
  let n = length . filter (== k) . fmap primacity $ [a..b]
  pure n
    where
      dropN 0 = id
      dropN n = dropN (pred n) . drop 1 . dropWhile (/= ' ')

printNTimes :: Int -> Int -> IO ()
printNTimes 0 _ = pure ()
printNTimes n total = do
  ans <- user
  putStr $ "Case #" <> show (total - n + 1) <> ": "
  putStrLn $ show ans
  printNTimes (pred n) total

main :: IO ()
main = do
  n :: Int <- read <$> getLine
  printNTimes n n

这基本上是相互递归和懒惰.可能需要一段时间来理解它,但我可以保证它很快.

Answer 2

当然是.您正在有效地使用两种不同的算法.您的Haskell zipWith ($) (incEvery n) xs必须处理列表中的每个条目,而Perl for my $j (2 .. ($max / $i)) { $f[$i * $j] ++; }只需要处理它实际递增的条目,这是一个$i更快的因素.这是一个可变数组有用的问题的原型示例:例如,在Haskell中,您可以使用它STUArray.