使用Haskell进行竞争性编程

时间:2018-09-10 18:00:37

标签: performance haskell

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

它通过所有中小型测试用例,但大型测试用例却超时了。 解决此问题的关键是在一开始就预先计算一些内容,并使用它们有效地回答各个查询。

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

初始配置文件显示lookup的{​​{1}}操作似乎是主要瓶颈。除IntMap之外,还有其他更好的备忘方法吗?还是应该看一下IntMapVector,我相信它们会导致更多“丑陋”的代码。 即使在当前状态下,代码(按功能标准)也不是很好,也不像我的C ++解决方案那样冗长。有什么技巧可以使它更加惯用吗?除了Array用于记忆之外,您是否发现其他可能导致性能问题的明显问题?

有没有好的资料,我可以在其中学习如何更有效地使用Haskell进行竞争性编程?

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

input.txt output.txt

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

IntMap

更新:

DanielWagner的回答证实了我的怀疑,即我代码中的主要问题是使用#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; } } 进行记忆。用IntMap代替IntMap使我的代码执行起来与DanielWagner的解决方案相似。

Array

1 个答案:

答案 0 :(得分:6)

我认为您试图变得过于机灵已使自己陷入困境。下面,我将展示一个略有不同的算法的简单实现,该算法的运行速度比Haskell代码快约5倍。

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

  • 将所有频率除以二,四舍五入;将此称为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

像您一样,我想在便宜的Int上进行所有计算,并尽可能进行模块化操作。我将创建一个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类来选择基数来进行概括。如果您不确定如何和感兴趣,请提出一个新问题;我很乐意进行更详尽的撰写。由于Haskell的wacko数字类层次结构,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))

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

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倍的代码的一半。

P.S。只是为了好玩,我用print (l+r :: Int)代替了最后一行...,发现在read中花费了大约一半的时间。哎哟!如果这还不够快的话,似乎还有很多悬而未决的果实。