当前位置 : 主页 > 网络安全 > 测试自动化 >

性能 – 使用Haskell进行竞争性编程

来源:互联网 收集:自由互联 发布时间:2021-06-22
我目前正试图通过解决一些Hackerrank问题来刷新我的 Haskell知识. 例如: https://www.hackerrank.com/challenges/maximum-palindromes/problem 我已经在C中实现了一个必要的解决方案,它已被所有测试用例接
我目前正试图通过解决一些Hackerrank问题来刷新我的 Haskell知识.

例如:

https://www.hackerrank.com/challenges/maximum-palindromes/problem

我已经在C中实现了一个必要的解决方案,它已被所有测试用例接受.现在我试图在(合理的惯用)Haskell中提出一个纯粹的功能解决方案.

我目前的代码是

module Main where

import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.Bits
import           Data.List
import qualified Data.Map.Strict       as Map
import qualified Data.IntMap.Strict    as IntMap
import           Debug.Trace

-- precompute factorials
compFactorials :: Int -> Int -> IntMap.IntMap Int
compFactorials n m = go 0 1 IntMap.empty
  where
    go a acc map
      | a < 0     = map
      | a < n     = go a' acc' map'
      | otherwise = map'
      where
        map' = IntMap.insert a acc map
        a'   = a + 1
        acc' = (acc * a') `mod` m

-- precompute invs
compInvs :: Int -> Int -> IntMap.IntMap Int -> IntMap.IntMap Int
compInvs n m facts = go 0 IntMap.empty
  where
    go a map
      | a < 0     = map
      | a < n     = go a' map'
      | otherwise = map'
      where
        map' = IntMap.insert a v map
        a' = a + 1
        v = (modExp b (m-2) m) `mod` m
        b = (IntMap.!) facts a


modExp :: Int -> Int -> Int -> Int
modExp b e m = go b e 1
  where
    go b e r
      | (.&.) e 1 == 1 = go b' e' r'
      | e > 0 = go b' e' r
      | otherwise = r
        where
          r' = (r * b) `mod` m
          b' = (b * b) `mod` m
          e' = shift e (-1)

-- precompute frequency table
initFreqMap :: C.ByteString -> Map.Map Char (IntMap.IntMap Int)
initFreqMap inp = go 1 map1 map2 inp
  where
    map1 = Map.fromList $zip ['a'..'z'] $repeat 0
    map2 = Map.fromList $zip ['a'..'z'] $repeat IntMap.empty

    go idx m1 m2 inp
      | C.null inp = m2
      | otherwise  = go (idx+1) m1' m2' $C.tail inp
      where
        m1' = Map.update (\v -> Just $v+1) (C.head inp) m1
        m2' = foldl' (\m w -> Map.update (\v -> liftM (\c -> IntMap.insert idx c v) $Map.lookup w m1') w m)
              m2 ['a'..'z']


query :: Int -> Int -> Int -> Map.Map Char (IntMap.IntMap Int)
         -> IntMap.IntMap Int -> IntMap.IntMap Int -> Int
query l r m freqMap facts invs
  | x > 1     = (x * y) `mod` m
  | otherwise = y
  where
    calcCnt cs = cr - cl
      where
         cl = IntMap.findWithDefault 0 (l-1) cs
         cr = IntMap.findWithDefault 0 r cs

    f1 acc cs
      | even cnt = acc
      | otherwise = acc + 1
      where
        cnt = calcCnt cs

    f2 (acc1,acc2) cs
      | cnt < 2   = (acc1 ,acc2)
      | otherwise = (acc1',acc2')
      where
        cnt = calcCnt cs

        n = cnt `div` 2

        acc1' = acc1 + n
        r = choose acc1' n
        acc2' = (acc2 * r) `mod` m


    -- calc binomial coefficient using Fermat's little theorem
    choose n k
      | n < k = 0
      | otherwise = (f1 * t) `mod` m
      where
        f1 = (IntMap.!) facts n
        i1 = (IntMap.!) invs k
        i2 = (IntMap.!) invs (n-k)

        t = (i1 * i2) `mod` m


    x = Map.foldl' f1 0 freqMap
    y = snd $Map.foldl' f2 (0,1) freqMap


main :: IO()
main = do
    inp <- C.getLine
    q   <- readLn :: IO Int

    let modulo  = 1000000007
    let facts   = compFactorials (C.length inp) modulo
    let invs    = compInvs (C.length inp) modulo facts
    let freqMap = initFreqMap inp

    forM_ [1..q] $\_ -> do

      line <- getLine

      let [s1, s2] = words line
      let l = (read s1) :: Int
      let r = (read s2) :: Int

      let result = query l r modulo freqMap facts invs

      putStrLn $show result

它通过了所有中小型测试用例,但是我对大型测试用例进行了超时.
解决这个问题的关键是在开始时预先计算一些东西并使用它们有效地回答各个查询.

现在,我需要帮助的主要问题是:

初始分析显示IntMap的查找操作似乎是主要的瓶颈.是否有更好的替代IntMap进行记忆?或者我应该看看Vector或Array,我认为这将导致更“丑陋”的代码.
即使在当前状态下,代码看起来也不是很好(按功能标准),并且与我的C解决方案一样冗长.任何提示,使它更惯用?除了用于记忆的IntMap用法之外,您是否发现了可能导致性能问题的任何其他明显问题?

是否有任何好的资源,我可以在哪里学习如何更有效地使用Haskell进行竞争性编程?

一个示例大型测试用例,当前代码超时:

input.txt
output.txt

为了比较我的C解决方案:

#include <vector>
#include <iostream>

#define MOD 1000000007L

long mod_exp(long b, long e) {
    long r = 1;

    while (e > 0) {
        if ((e & 1) == 1) {
            r = (r * b) % MOD;
        }

        b = (b * b) % MOD;
        e >>= 1;
    }

    return r;
}

long n_choose_k(int n, int k, const std::vector<long> &fact_map, const std::vector<long> &inv_map) {
    if (n < k) {
        return 0;
    }

    long l1 = fact_map[n];
    long l2 = (inv_map[k] * inv_map[n-k]) % MOD;

    return (l1 * l2) % MOD;
}

int main() {
    std::string s;
    int q;

    std::cin >> s >> q;

    std::vector<std::vector<long>> freq_map;
    std::vector<long> fact_map(s.size()+1);
    std::vector<long> inv_map(s.size()+1);

    for (int i = 0; i < 26; i++) {
        freq_map.emplace_back(std::vector<long>(s.size(), 0));
    }

    std::vector<long> acc_map(26, 0);
    for (int i = 0; i < s.size(); i++) {
        acc_map[s[i]-'a']++;

        for (int j = 0; j < 26; j++) {
            freq_map[j][i] = acc_map[j];
        }
    }

    fact_map[0] = 1;
    inv_map[0] = 1;
    for (int i = 1; i <= s.size(); i++) {
        fact_map[i] = (i * fact_map[i-1]) % MOD;
        inv_map[i] = mod_exp(fact_map[i], MOD-2) % MOD;
    }

    while (q--) {
        int l, r;

        std::cin >> l >> r;
        std::vector<long> x(26, 0);

        long t = 0;
        long acc = 0;
        long result = 1;

        for (int i = 0; i < 26; i++) {
            auto cnt = freq_map[i][r-1] - (l > 1 ? freq_map[i][l-2] : 0);

            if (cnt % 2 != 0) {
                t++;
            }

            long n = cnt / 2;

            if (n > 0) {
                acc += n;
                result *= n_choose_k(acc, n, fact_map, inv_map);
                result = result % MOD;
            }
        }

        if (t > 0) {
            result *= t;
            result = result % MOD;
        }

        std::cout << result << std::endl;
    }
}

更新:

DanielWagner的回答证实了我的怀疑,我的代码中的主要问题是使用IntMap进行记忆.用Array替换IntMap使我的代码执行类似于DanielWagner的解决方案.

module Main where

import           Control.Monad
import           Data.Array            (Array)
import qualified Data.Array            as A
import qualified Data.ByteString.Char8 as C
import           Data.Bits
import           Data.List
import           Debug.Trace


-- precompute factorials
compFactorials :: Int -> Int -> Array Int Int
compFactorials n m = A.listArray (0,n) $scanl' f 1 [1..n]
  where
    f acc a = (acc * a) `mod` m

-- precompute invs
compInvs :: Int -> Int -> Array Int Int -> Array Int Int
compInvs n m facts = A.listArray (0,n) $map f [0..n]
  where
    f a = (modExp ((A.!) facts a) (m-2) m) `mod` m

modExp :: Int -> Int -> Int -> Int
modExp b e m = go b e 1
  where
    go b e r
      | (.&.) e 1 == 1 = go b' e' r'
      | e > 0 = go b' e' r
      | otherwise = r
        where
          r' = (r * b) `mod` m
          b' = (b * b) `mod` m
          e' = shift e (-1)

-- precompute frequency table
initFreqMap :: C.ByteString -> Map.Map Char (Array Int Int)
initFreqMap inp = Map.fromList $map f ['a'..'z']
  where
    n = C.length inp
    f c = (c, A.listArray (0,n) $scanl' g 0 [0..n-1])
      where
        g x j
          | C.index inp j == c = x+1
          | otherwise = x

query :: Int -> Int -> Int -> Map.Map Char (Array Int Int)
         -> Array Int Int -> Array Int Int -> Int
query l r m freqMap facts invs
  | x > 1     = (x * y) `mod` m
  | otherwise = y
  where
    calcCnt freqMap = cr - cl
      where
         cl = (A.!) freqMap (l-1)
         cr = (A.!) freqMap r

    f1 acc cs
      | even cnt = acc
      | otherwise = acc + 1
      where
        cnt = calcCnt cs

    f2 (acc1,acc2) cs
      | cnt < 2   = (acc1 ,acc2)
      | otherwise = (acc1',acc2')
      where
        cnt = calcCnt cs

        n = cnt `div` 2

        acc1' = acc1 + n
        r = choose acc1' n
        acc2' = (acc2 * r) `mod` m


    -- calc binomial coefficient using Fermat's little theorem
    choose n k
      | n < k = 0
      | otherwise = (f1 * t) `mod` m
      where
        f1 = (A.!) facts n
        i1 = (A.!) invs k
        i2 = (A.!) invs (n-k)

        t = (i1 * i2) `mod` m


    x = Map.foldl' f1 0 freqMap
    y = snd $Map.foldl' f2 (0,1) freqMap


main :: IO()
main = do
    inp <- C.getLine
    q   <- readLn :: IO Int

    let modulo  = 1000000007
    let facts   = compFactorials (C.length inp) modulo
    let invs    = compInvs (C.length inp) modulo facts
    let freqMap = initFreqMap inp

    replicateM_ q $do

      line <- getLine

      let [s1, s2] = words line
      let l = (read s1) :: Int
      let r = (read s2) :: Int

      let result = query l r modulo freqMap facts invs

      putStrLn $show result
我觉得你试图过于聪明,已经让自己陷入了困境.下面我将展示一个稍微不同的算法的简单实现,该算法比Haskell代码快5倍.

这是核心组合计算.给定子字符串的字符频率计数,我们可以通过这种方式计算最大长度的回文数:

>将所有频率除以2,向下舍入;把它叫做div2频率.我们还需要mod2频率,这是我们必须向下舍入的字母集.
>对div2频率求和,得到回文前缀的总长度;它的阶乘给出了回文可能前缀数量的过多计数.
>获取div2频率的阶乘的乘积.这说明了我们在上面覆盖的因素.
>取mod2频率的大小,如果没有,则选择1.我们可以通过这个集合中的一个值扩展任何回文前缀,如果有的话,我们必须乘以这个大小.

对于过度计算步骤,对我来说,存储预计算的因子反转是否更快,并且采用他们的产品,或者是否更快地采用所有因子的乘积并在最后进行一次逆运算对我来说并不是非常明显的. .我会做后者,因为每个查询进行一次反转看起来比直接看起来更快,而不是每次重复一次查找,但我知道什么?如果您想尝试自己调整代码,应该很容易测试.

我对你的代码只有一个快速的见解,那就是我们可以缓存输入前缀的频率计数;然后计运算符串的频率计数只是两个缓存计数的逐点减法.你对输入的预计算比较有点过分.

不用多说,让我们看看一些代码.像往常一样,有一些序言.

module Main where

import           Control.Monad
import           Data.Array (Array)
import qualified Data.Array as A
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.Monoid

和你一样,我希望在便宜的Ints上进行所有计算,并在可能的情况下进行模块化操作.我会制作一个新类型,以确保这一切发生在我身上.

newtype Mod1000000007 = Mod Int deriving (Eq, Ord)

instance Num Mod1000000007 where
    fromInteger = Mod . (`mod` 1000000007) . fromInteger
    Mod l + Mod r = Mod ((l+r) `rem` 1000000007)
    Mod l * Mod r = Mod ((l*r) `rem` 1000000007)
    negate (Mod v) = Mod ((1000000007 - v) `rem` 1000000007)
    abs = id
    signum = id

instance Integral Mod1000000007 where
    toInteger (Mod n) = toInteger n
    quotRem a b = (a * b^1000000005, 0)

我在几个地方以1000000007为基础进行了烘焙,但是通过给一个幻影参数并使HasBase类选择基数来很容易推广.如果您不确定如何并且感兴趣,可以提出一个新问题;我很乐意做更全面的写作.由于Haskell的数字类层次结构,Mod还有一些基本上无趣且主要需要的实例:

instance Show Mod1000000007 where show (Mod n) = show n
instance Real Mod1000000007 where toRational (Mod n) = toRational n
instance Enum Mod1000000007 where
    toEnum = Mod . (`mod` 1000000007)
    fromEnum (Mod n) = n

这是我们想要进行因子分析的预计算…

type FactMap = Array Int Mod1000000007

factMap :: Int -> FactMap
factMap n = A.listArray (0,n) (scanl (*) 1 [1..])

…并预先计算每个前缀的频率图,并获得给定起点和终点的频率图.

type FreqMap = Map Char Int

freqMaps :: String -> Array Int FreqMap
freqMaps s = go where
    go = A.listArray (0, length s)
        (M.empty : [M.insertWith (+) c 1 (go A.! i) | (i, c) <- zip [0..] s])

substringFreqMap :: Array Int FreqMap -> Int -> Int -> FreqMap
substringFreqMap maps l r = M.unionWith (-) (maps A.! r) (maps A.! (l-1))

实现上述核心计算只需几行代码,现在我们为Mod1000000007提供了合适的Num和Integral实例:

palindromeCount :: FactMap -> FreqMap -> Mod1000000007
palindromeCount facts freqs
    =     toEnum (max 1 mod2Freqs)
    *     (facts A.! sum div2Freqs)
    `div` product (map (facts A.!) div2Freqs)
    where
    (div2Freqs, Sum mod2Freqs) = foldMap (\n -> ([n `quot` 2], Sum (n `rem` 2))) freqs

现在我们只需要一个简短的驱动程序来读取内容并将其传递给相应的函数.

main :: IO ()
main = do
    inp <- getLine
    q   <- readLn

    let freqs = freqMaps inp
        facts = factMap (length inp)

    replicateM_ q $do
        [l,r] <- map read . words <$> getLine
        print . palindromeCount facts $substringFreqMap freqs l r

而已.值得注意的是,我并没有试图对按位操作感兴趣,也没有对累加器做任何想象;一切都在我认为惯用的纯粹功能风格.最终计数大约是运行速度提高约5倍的代码的一半.

附:只是为了好玩,我用print(l r :: Int)替换了最后一行……并发现大约一半的时间用于读取.哎哟!如果这还不够快,似乎还有很多悬而未决的成果.

网友评论