Submission #62829720

---

Source Code Expand

import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

import Data.Array.ST
import Control.Monad
import Control.Monad.ST
import Data.Bits

import Data.Array.Unboxed

main :: IO ()
main = do
  [n] <- bsGetLnInts
  ss <- bsGetLnInts
  let ans = abc392g n ss
  print ans

bsGetLnInts :: IO [Int]
bsGetLnInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

abc392g :: Int -> [Int] -> Int
abc392g _n ss = sum $ zipWith f ps (olol cs)
  where
    n = maximum ss
    arr = accumArray (+) 0 (0, n) [(s,1) | s <- ss] :: UArray Int Int
    ps = elems arr
    cs = convolution ps ps
    f 1 c = div (pred c) 2
    f 0 _ = 0
-- 偶数番目を取り出す
    olol (x:xs) = x : olol (drop 1 xs)
    olol _ = []

convolution :: [Int] -> [Int] -> [Int]
convolution as bs = runST $
  do
    ar <- newListArray bnds $ as ++ repeat 0 :: ST s (STUArray s Int Int)
    br <- newListArray bnds $ bs ++ repeat 0 :: ST s (STUArray s Int Int)
    fft ar root
    fft br root
    forM_ (range bnds) (\i -> do
      a <- readArray ar i
      b <- readArray br i
      writeArray ar i $ mul a b
      )
    fft ar invroot

    forM [0 .. na + pred nb] (fmap (mul divn) . readArray ar)
  where
-- 定数
    p = 998244353
    root = 3
    invroot = modRecip root
-- pを底とするモジュロ演算
    reg x = mod x p
    add x y = reg $ x + y
    mul x y = reg $ x * y
    modRecip a = reg $ fst $ loop a p
      where
        loop a 0 = (1, 0)
        loop a b = let (y, x) = loop b (mod a b)
                   in  (x, y - div a b * x)
    pow b e = loop e (reg b) 1
      where
        loop 0 _ acc = acc
        loop k c acc = loop (div k 2) (mul c c) $ if odd k then mul acc c else acc
-- 本体
    na = length as
    nb = length bs
    (n, w) = (n, length xs)
      where
        (xs, n:_) = span ((na + nb) >) $ iterate (2 *) 1
    bnds = (0, pred n)
    divn = modRecip n
-- 下請け
-- ビット反転
    bitReverse :: Int -> Int
    bitReverse j = sum [bit i | i <- [0 .. pred w], testBit j (pred w - i)]
-- 高速フーリエ変換
    fft a base =
      do
-- 配列ビット反転
        forM_ (range bnds) (\i -> do
          let j = bitReverse i
          when (i < j) $ do
            x <- readArray a i
            y <- readArray a j
            writeArray a i y
            writeArray a j x
            )
        forM_ (zip omega2N $ iterate (2 *) 1) (\(omega, dist) ->
          forM_ [0, dist + dist .. pred n] (\b -> do
            let (omegas1, omegas2) = splitAt dist $ iterate (mul omega) 1
            forM_ (zip3 omegas1 omegas2 [b ..]) (\(o1, o2, i) -> do
              f_even <- readArray a i
              f_odd  <- readArray a (i + dist)
              writeArray a  i         (reg $ f_even + o1 * f_odd)
              writeArray a (i + dist) (reg $ f_even + o2 * f_odd)
              )
            )
          )
      where
        omegaN = pow base (div (pred p) n)
        omega2N = reverse $ take w $ iterate (\x -> mul x x) omegaN

Submission Info

Compile Error

app/Main.hs:29:5: warning: [-Wincomplete-patterns]
    Pattern match(es) are non-exhaustive
    In an equation for ‘f’:
        Patterns of type ‘a’, ‘a’ not matched:
            p _ where p is not one of {1, 0}
   |
29 |     f 1 c = div (pred c) 2
   |     ^^^^^^^^^^^^^^^^^^^^^^...

app/Main.hs:57:5: warning: [-Wunused-local-binds]
    Defined but not used: ‘add’
   |
57 |     add x y = reg $ x + y
   |     ^^^

app/Main.hs:61:14: warning: [-Wunused-matches]
    Defined but not used: ‘a’
   |
61 |         loop a 0 = (1, 0)
   |              ^

app/Main.hs:61:14: warning: [-Wname-shadowing]
    This binding for ‘a’ shadows the existing binding
      bound at app/Main.hs:59:14
   |
61 |         loop a 0 = (1, 0)
   |              ^

app/Main.hs:62:14: warning: [-Wname-shadowing]
    This binding for ‘a’ shadows the existing binding
      bound at app/Main.hs:59:14
   |
62 |         loop a b = let (y, x) = loop b (mod a b)
   |              ^

app/Main.hs:73:9: warning: [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a pattern binding:
        Patterns of type ‘([Int], [Int])’ not matched: (_, [])
   |
73 |         (xs, n:_) = span ((na + nb) >) $ iterate (2 *) 1
   |         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

app/Main.hs:73:14: warning: [-Wname-shadowing]
    This binding for ‘n’ shadows the existing binding
      bound at app/Main.hs:71:6
   |
73 |         (xs, n:_) = span ((na + nb) >) $ iterate (2 *) 1
   |              ^

Judge Result