【问题标题】:Competitive programming using Haskell使用 Haskell 进行竞争性编程
【发布时间】:2019-02-15 04:55:39
【问题描述】:

我目前正在尝试通过解决一些 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

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

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

初始分析显示IntMaplookup 操作似乎是主要瓶颈。有没有更好的替代IntMap 来记忆?或者我应该看看VectorArray,我相信这会导致更多“丑陋”的代码。 即使在当前状态下,代码看起来也不好看(按功能标准),并且像我的 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 进行记忆。将 IntMap 替换为 Array 使我的代码执行类似于 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

【问题讨论】:

  • 请将这个问题缩小到可以用几句话完全解释的问题,而不需要链接到 HackerRank 之类的东西。就目前而言,它太开放了。另外,您为什么不展示您的 C++ 代码以及在该版本中运行得更快的是什么?
  • 你可能想把它分成几个不同的问题。
  • 这不是简单的偶数字母数加一(如果有奇数字母)? week -&gt; e:2 w:1 k:1 -&gt; 2+1=3
  • @karafka 没有;例如对于week,只有两个最大长度的回文,即eweeke。不,这也不是 odd 字母的数量。想想例如bookmark,其中长回文以 okko 开头,然后是 bmar,因此有 2*4=8 个最大长度回文。
  • 哦,最大长度回文数。不是最大长度!

标签: performance haskell


【解决方案1】:

我认为你太聪明了,是在自取其辱。下面我将展示一个稍微不同的算法的简单实现,它比您的 Haskell 代码快约 5 倍。

这是核心组合计算。给定子串的字符频率计数,我们可以这样计算最大长度回文数:

  • 将所有频率除以二,向下取整;称之为 div2 频率。我们还需要 mod2-frequencies,这是我们必须向下舍入的一组字母。
  • 将 div2-frequencies 相加得到回文前缀的总长度;它的阶乘计算了回文的可能前缀的数量。
  • 取 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 以确保这发生在我身上。

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 的基础上进行了烘焙,但是通过给Mod 一个幻像参数并创建一个HasBase 类来选择基础很容易概括。如果您不确定如何以及感兴趣,请提出一个新问题;我很乐意做一个更彻底的写作。 Mod 的更多实例基本上是无趣的,主要是因为 Haskell 的古怪数字类层次结构需要:

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 提供了合适的NumIntegral 实例:

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)...替换了最后一行,发现大约一半的时间都花在了read上。哎哟!如果这还不够快,似乎还有很多容易实现的目标。

【讨论】:

  • 非常感谢您的详细解答!正如我所怀疑的(并且您的回答证实了这一点),我的主要问题是我使用IntMap 进行记忆...我在我的代码中将IntMap 替换为Array 和瞧,现在它的性能与您的解决方案相似.而且我的频率图肯定不如你的转置版本那么紧凑,但我认为它并没有太大的区别,特别是对于大型测试实例。我学到的主要教训是,在这种情况下,Array 是比IntMap 更好的记忆选择。
  • 但是,我们的 Haskell 解决方案的性能仍然比同等的 C++ 解决方案差 10 倍左右。正如您在上一段中所怀疑的那样,也许 IO 是罪魁祸首……您认为我们可以进一步优化它以达到 C++ 的性能而不会使代码“太难看”吗?
  • @bmk 通常可以达到 C 和 C++ 解决方案的 2-3 倍而不会变得丑陋,并且如果您愿意处理一些分散的碍眼的问题,则具有可比性。如果你想更快,可能是时候开始分析了。
  • instance Integral 是否正确? 5 看起来像是错字。
  • @BartekBanachewicz 是正确的。自己试试看:试试(x `div` y) * y 来选择xy
猜你喜欢
  • 1970-01-01
  • 2019-04-25
  • 1970-01-01
  • 1970-01-01
  • 2023-03-08
  • 1970-01-01
  • 2021-01-07
  • 2021-06-05
  • 2015-02-02
相关资源
最近更新 更多