Submission #3752556

---

Source Code Expand

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.List
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Control.Monad
import Control.Monad.ST
-- import Debug.Trace
trace _ a = a

solve :: Int -> [(String,Int)] -> Int
solve n cas = revNums VU.! n
  where

{--
k :: [0..2n-1]
i :: [0..n]
bwTbl ! (enc k col i)
  = # { p | k < p, (col,j) is located at p, i >= j }
--}    

  bwTbl :: VU.Vector Int
  bwTbl = trace ("bwTbl = " ++ show bwTbl0) bwTbl0

  bwTbl0 = VU.create $ do
    bwv <- VUM.new ((2*n+1)*2*(n+1))
    forM_ [0..n] $ \i -> do
      VUM.write bwv (enc 0 0 i) i
      VUM.write bwv (enc 0 1 i) i
    forM_ (zip [1..] cas) $ \(k, (c, a)) -> do
      forM_ [0..n] $ \i -> do
        forM_ [0,1] $ \col -> do
          x <- VUM.read bwv (enc (k-1) col i)
          let y | col == color c && i >= a = x-1
                | otherwise = x
          VUM.write bwv (enc k col i) y
    return bwv
  enc  k col i = k * (2*(n+1)) + col * (n+1) + i
  bwT k col i = trace ("bwT " ++ show (k,col,i,ans)) ans
    where ans = bwT0 k col i
  bwT0 k col i = bwTbl VU.! (enc (k+1) col i)

  posTbl :: VU.Vector Int
  posTbl = VU.create $ do
    vec <- VUM.new (2*(n+1))
    forM_ (zip [0..] cas) $ \(k, (c,a)) -> do
      VUM.write vec (encP (color c) a) k
    return vec
  encP col a = col * (n+1) + a
  posT col a = trace ("posT " ++ show (col,a,ans)) ans
    where ans = posT0 col a
  posT0 col a = posTbl VU.! (encP col a)
    
  revNums = foldl op (VU.replicate (n+1) 0) [1..2*n]
    where
    op prev m = trace ("op " ++ show (prev, m, a)) a
      where a = op0 prev m

    op0 prev m = VU.create $ do
      vec <- VUM.replicate (n+1) 0
      forM_ indices $ \i -> do
        VUM.write vec i (min (putBlack i) (putWhite i))
      when (m <= n) $ do
        VUM.write vec 0 (putWhite 0)
        VUM.write vec m (putBlack m)
      return vec
      where
        indices | m <= n = [1..m-1]
                | otherwise = [m-n..n]
        putBlack i = (prev VU.! (i-1)) + (right (posT 0 i) (i-1) (m-i))
        putWhite i = (prev VU.! i) + (right (posT 1 (m-i)) i (m-i-1))
        right k bn wn = bwT k 0 bn + bwT k 1 wn

color s | head s == 'B' = 0
        | otherwise     = 1

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> Int
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_n]:remLines1 = remLines0
      n = readBInt bs_n
      cas = map (\[x1,x2] -> (B.unpack x1,readBInt x2)) remLines1
  in solve n cas

outAnswer :: Int -> IO ()
outAnswer = putStrLn . show

main :: IO ()
main = outAnswer . tmain =<< B.getContents

Submission Info

Judge Result