Конкурентное программирование с использованием Haskell

Question

В настоящее время я пытаюсь обновить свои знания Haskell, решая некоторые проблемы с Hackerrank.

Например:

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 для 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;
    }
}

UPDATE:

Ответ Даниэля Вагнера подтвердил мое подозрение, что основной проблемой в моем коде было использование 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

Answer 1

Я думаю, что ты выстрелил себе в ногу, пытаясь быть слишком умным. Ниже я покажу прямую реализацию немного другого алгоритма, который примерно в 5 раз быстрее, чем ваш код на Haskell.

Вот основные комбинаторные вычисления. Учитывая количество символов в подстроке, мы можем вычислить число палиндромов максимальной длины следующим образом:

• Разделите все частоты на две, округляя вниз; Назовите это div2-частотами. Нам также понадобятся частоты mod2, которые представляют собой набор букв, для которых нам пришлось округлить.
• Суммируйте div2-частоты, чтобы получить общую длину префикса палиндрома; его факториал дает пересчет числа возможных префиксов для палиндрома.
• Возьмите произведение факториалов от div2-частот. Это говорит о том факторе, по которому мы переоценены выше.
• Возьмите размер мод2-частот или выберите 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 s и выпекать в модульных операциях, где это возможно. Я сделаю 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))

Реализация описанного выше базового вычисления - это всего лишь несколько строк кода, теперь у нас есть подходящие Num и Integral экземпляры для Mod1000000007:

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. Ой! Кажется, есть еще много висячих фруктов, если это еще недостаточно быстро.