Submission #524236


Source Code Expand

Copy
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception (assert)
import Control.Monad hiding (foldM)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.Monoid
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import Data.Word
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  sts <- parse.map (pred.readInt).B.words <$> B.getContents
  let res = solve n m sts
  print $ length res
  putStr.unlines.map show $ res

parse :: [Int] -> [(Int, Int)]
parse (s:t:sts) = (s,t) : parse sts
parse _ = []

solve :: Int -> Int -> [(Int, Int)] -> [Int]
solve n m sts = runST $ do
  segtree <- mkSegTree 0 (n-1) freqs
  let go res (i:is) ((s,t):sts) = do
        freq <- query s t segtree
        if freq > 1 then do
          go (i:res) is sts
        else do
          go res is sts
      go res _  _ = return $! reverse res
  go [] [1..] sts

   where
     freqs :: UArray Int Int
     !freqs = listArray(0,n-1).scanl1 (+) $ map (unsafeAt arr) [0..n-1]
     arr :: UArray Int Int
     !arr = unsafeAccumArray (+) 0 (0,n) $ go0 sts
     go0 ((s,t):sts) = (s,1):(t+1,-1):go0 sts
     go0 _ = []

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM p f=p>>=flip when f
unlessM p f=p>>=flip unless f
{-# INLINE whenM #-}
{-# INLINE unlessM #-}
foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM f a xs=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=assert(inRange(bounds a)i).unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;assert(inRange lr i)$unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;assert(inRange lr i)$unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;assert(inRange lr i)$unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

instance Monoid Int where
  mempty = maxBound
  mappend = min

data SegTree s m = Node {-# UNPACK #-} !Int {-# UNPACK #-} !Int !(STRef s m) !(SegTree s m) !(SegTree s m)
                 | Leaf {-# UNPACK #-} !Int !(STRef s m)

getVal :: SegTree s m -> ST s m
getVal (Node _ _ ref _ _) = readSTRef ref
getVal (Leaf _ ref)       = readSTRef ref

mkSegTree :: (Monoid m, IArray a m) => Int -> Int -> a Int m -> ST s (SegTree s m)
mkSegTree l r arr = go l r
   where
     go !l !r
       | l < r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           res <- mappend <$> getVal lt <*> getVal rt
           ref <- newSTRef $! res
           return $! Node l r ref lt rt
       | otherwise = do
           ref <- newSTRef $! unsafeAt arr l
           return $! Leaf l ref

update :: (Monoid m) => Int -> (m -> m) -> SegTree s m -> ST s ()
update key f segtree = go segtree
   where
     go (Node l r ref lt rt) = do
       when (l<=key && key<=r) $ do
         if 2*key <= l+r then go lt else go rt
         res <- mappend <$> getVal lt <*> getVal rt
         writeSTRef ref $! res
     go (Leaf k ref) = do
       when (k==key) $ do
         modifySTRef' ref f

query :: (Monoid m) => Int -> Int -> SegTree s m -> ST s m
query kl kr segtree = go segtree
   where
     go (Node l r ref lt rt)
       | r<kl  || kr<l  = return mempty
       | kl<=l && r<=kr = readSTRef ref
       | otherwise = do
           res <- mappend <$> go lt <*> go rt
           return $! res
     go (Leaf k ref)
       | kl<=k && k<=kr = readSTRef ref
       | otherwise      = return mempty

Submission Info

Submission Time
Task B - ドキドキデート大作戦高橋君
User cojna
Language Haskell (Haskell Platform 2014.2.0.0)
Score 100
Code Size 5118 Byte
Status
Exec Time 713 ms
Memory 84136 KB

Test Cases

Set Name Score / Max Score Test Cases
Sample 0 / 0 subtask0_sample_01.txt, subtask0_sample_02.txt, subtask0_sample_03.txt
Subtask1 30 / 30 subtask1_01.txt, subtask1_02.txt, subtask1_03.txt, subtask1_04.txt, subtask1_05.txt, subtask1_06.txt, subtask1_07.txt, subtask1_08.txt, subtask1_09.txt, subtask0_sample_01.txt, subtask0_sample_02.txt, subtask0_sample_03.txt
All 70 / 70 subtask0_sample_01.txt, subtask0_sample_02.txt, subtask0_sample_03.txt, subtask1_01.txt, subtask1_02.txt, subtask1_03.txt, subtask1_04.txt, subtask1_05.txt, subtask1_06.txt, subtask1_07.txt, subtask1_08.txt, subtask1_09.txt, subtask2_01.txt, subtask2_02.txt, subtask2_03.txt, subtask2_04.txt, subtask2_05.txt, subtask2_06.txt, subtask2_07.txt, subtask2_08.txt
Case Name Status Exec Time Memory
subtask0_sample_01.txt 32 ms 1304 KB
subtask0_sample_02.txt 27 ms 1308 KB
subtask0_sample_03.txt 28 ms 1324 KB
subtask1_01.txt 530 ms 65676 KB
subtask1_02.txt 600 ms 65740 KB
subtask1_03.txt 541 ms 60800 KB
subtask1_04.txt 497 ms 51336 KB
subtask1_05.txt 495 ms 51400 KB
subtask1_06.txt 28 ms 1816 KB
subtask1_07.txt 26 ms 1432 KB
subtask1_08.txt 27 ms 1300 KB
subtask1_09.txt 27 ms 1304 KB
subtask2_01.txt 626 ms 84136 KB
subtask2_02.txt 664 ms 65704 KB
subtask2_03.txt 27 ms 1560 KB
subtask2_04.txt 27 ms 1432 KB
subtask2_05.txt 27 ms 1556 KB
subtask2_06.txt 28 ms 1532 KB
subtask2_07.txt 27 ms 1564 KB
subtask2_08.txt 713 ms 63660 KB