#580618 (Haskell) No.1285 ゴミ捨て

提出ソース

結果

問題	No.1285 ゴミ捨て
ユーザー	こまる
提出日時	2020-11-16 17:28:40
言語	Haskell (9.8.2)
結果	CE (最新) AC (最初)
実行時間	-
コード長	7,936 bytes
コンパイル時間	1,211 ms
コンパイル使用メモリ	205,828 KB
最終ジャッジ日時	2024-04-27 05:01:50
合計ジャッジ時間	2,276 ms
ジャッジサーバーID （参考情報）	judge2 / judge5

このコードへのチャレンジ
（要ログイン）

コンパイルエラー時のメッセージ・ソースコードは、提出者また管理者しか表示できないようにしております。（リジャッジ後のコンパイルエラーは公開されます）
ただし、clay言語の場合は開発者のデバッグのため、公開されます。

コンパイルメッセージ

Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:51:33: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:11:1-26,
           or ‘Main..>>.’, defined at Main.hs:115:1.
   |
51 |     mask k x = fromIntegral $ x .>>. k .&. 0xffff
   |                                 ^^^^

Main.hs:80:33: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:11:1-26,
           or ‘Main..>>.’, defined at Main.hs:115:1.
   |
80 |     mask k x = fromIntegral $ x .>>. k .&. 0xffff
   |                                 ^^^^

Main.hs:99:14: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:11:1-26,
           or ‘Main..>>.’, defined at Main.hs:115:1.
   |
99 |         if x .>>. 32 == y .>>. 32
   |              ^^^^

Main.hs:99:27: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:11:1-26,
           or ‘Main..>>.’, defined at Main.hs:115:1.
   |
99 |         if x .>>. 32 == y .>>. 32
   |                           ^^^^

Main.hs:104:26: error: [GHC-87543]
    Ambiguous occurrence ‘.<<.’.
    It could refer to
       either ‘Data.Bits..<<.’,
              imported from ‘Data.Bits’ at Main.hs:11:1-26,
           or ‘Main..<<.’, defined at Main.hs:111:1.
    |
104 |     $ VU.imap (\i x -> x .<<. 32 .|. i) vec
    |                          ^^^^

Main.hs:134:24: error: [GHC-87543]
    Ambiguous occurrence ‘.<<.’.
    It could refer to
       either ‘Data.Bits..<<.’,
              imported fr

ソースコード

raw source code

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections     #-}

module Main where

import           Control.Monad
import           Control.Monad.Cont
import           Control.Monad.ST
import           Control.Monad.State
import           Data.Bits
import qualified Data.ByteString.Char8             as BSC8
import           Data.Char
import           Data.Coerce
import qualified Data.Foldable                     as F
import           Data.IORef
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM

import qualified Data.Vector.Unboxed               as VU
import qualified Data.Vector.Unboxed.Mutable       as VUM
import           Data.Word
import           Unsafe.Coerce


main :: IO ()
main = do
  n <- readLn :: IO Int
  a <- radixSortInt <$> parseN1 n
  check <- newIORef True
  rep (n - 1) $ \i -> when (a VU.! i == a VU.! (i + 1) - 1) $ do
    writeIORef check False
  b <- readIORef check
  if b
    then putStrLn "1"
    else putStrLn "2"

type CParser a = StateT BSC8.ByteString Maybe a
runCParser :: CParser a -> BSC8.ByteString -> Maybe (a, BSC8.ByteString)
runCParser = runStateT
{-# INLINE runCParser #-}
int :: CParser Int
int = coerce $ BSC8.readInt . BSC8.dropWhile isSpace
{-# INLINE int #-}
parseN1 :: Int -> IO (VU.Vector Int)
parseN1 n = VU.unfoldrN n (runCParser int) <$> BSC8.getContents
{-# INLINE parseN1 #-}

radixSort64 :: VU.Vector Word64 -> VU.Vector Word64
radixSort64 vword = F.foldl' step vword [0,16,32,48]
  where
    mask k x = fromIntegral $ x .>>. k .&. 0xffff
    step v k = VU.create $ do
      pref <- VU.unsafeThaw
            . VU.prescanl' (+) 0
            . VU.unsafeAccumulate (+) (VU.replicate 0x10000 0)
            $ VU.map ((, 1) . mask k) v
      res <- VUM.unsafeNew $ VU.length v
      VU.forM_ v $ \x -> do
        let !masked = mask k x
        i <- VUM.unsafeRead pref masked
        VUM.unsafeWrite pref masked $ i + 1
        VUM.unsafeWrite res i x
      return res
{-# INLINE radixSort64 #-}

radixSort :: (VU.Unbox a, Word64Encode a) => VU.Vector a -> VU.Vector a
radixSort = VU.map decode64 . radixSort64 . VU.map encode64
{-# INLINE radixSort #-}

radixSortInt :: VU.Vector Int -> VU.Vector Int
radixSortInt = unsafeCoerce . radixSort64 . unsafeCoerce

radixSortNonNegative :: (VU.Unbox a, Word64Encode a) => VU.Vector a -> VU.Vector a
radixSortNonNegative = VU.map decodeNonNegative64 . radixSort64 . VU.map encodeNonNegative64
{-# INLINE radixSortNonNegative #-}

radixSort32 :: VU.Vector Word32 -> VU.Vector Word32
radixSort32 vec = F.foldl' step vec [0, 16]
  where
    mask k x = fromIntegral $ x .>>. k .&. 0xffff
    step v k = VU.create $ do
      pref <- VU.unsafeThaw
            . VU.prescanl' (+) 0
            . VU.unsafeAccumulate (+) (VU.replicate 0x10000 0)
            $ VU.map ((, 1) . mask k) v
      res <- VUM.unsafeNew $ VU.length v
      VU.forM_ v $ \x -> do
        let !masked = mask k x
        i <- VUM.unsafeRead pref masked
        VUM.unsafeWrite pref masked $ i + 1
        VUM.unsafeWrite res i x
      return res
{-# INLINE radixSort32 #-}

compress :: VU.Vector Int -> VU.Vector Int
compress vec = VU.create $ do
  mvec <- VUM.unsafeNew (VU.length vec)
  VU.mapM_ (\(i, x) -> VUM.unsafeWrite mvec (x .&. 0xffffffff) i) . VU.postscanl' (\(!i, !x) y ->
        if x .>>. 32 == y .>>. 32
          then (i, y)
          else (i + 1, y)
      ) (-1, -1)
    . radixSortInt
    $ VU.imap (\i x -> x .<<. 32 .|. i) vec
  return mvec
{-# INLINE compress #-}

infixl 8 .<<., .>>.

(.<<.) :: Bits b => b -> Int -> b
(.<<.) = unsafeShiftL
{-# INLINE (.<<.) #-}

(.>>.) :: Bits b => b -> Int -> b
(.>>.) = unsafeShiftR
{-# INLINE (.>>.) #-}

class Word64Encode a where
  encode64 :: a -> Word64
  decode64 :: Word64 -> a
  encodeNonNegative64 :: a -> Word64
  encodeNonNegative64 = encode64
  decodeNonNegative64 :: Word64 -> a
  decodeNonNegative64 = decode64

instance Word64Encode Int where
  encode64 x = unsafeCoerce $ x + 0x3fffffffffffffff
  decode64 x = unsafeCoerce x - 0x3fffffffffffffff
  encodeNonNegative64 = unsafeCoerce
  decodeNonNegative64 = unsafeCoerce

instance Word64Encode (Int, Int) where
  encode64 (x, y) = unsafeCoerce
    $ (x + 0x3fffffff) .<<. 31 .|. (y + 0x3fffffff)
  decode64 xy = unsafeCoerce (x, y)
    where
      !x = xy .>>. 31 - 0x3fffffff
      !y = (xy .&. 0x7fffffff) - 0x3fffffff
  encodeNonNegative64 (x, y) = unsafeCoerce $ x .<<. 31 .|. y
  decodeNonNegative64 xy     = unsafeCoerce (x, y)
    where
      !x = xy .>>. 31
      !y = xy .&. 0x7fffffff

instance Word64Encode (Int, Int, Int) where
  encode64 (x, y, z) = unsafeCoerce $ ((x + 0xfffff) .<<. 21 .|. (y + 0xfffff)) .<<. 21 .|. (z + 0xfffff)
  decode64 xyz = unsafeCoerce (x, y, z)
    where
      !x = xyz .>>. 42 - 0xfffff
      !y = (xyz .>>. 21 .&. 0x1fffff) - 0xfffff
      !z = xyz .&. 0x1fffff - 0xfffff
  encodeNonNegative64 (x, y, z) = unsafeCoerce $ (x .<<. 21 .|. y) .<<. 21 .|. z
  decodeNonNegative64 xyz = unsafeCoerce (x, y, z)
    where
      !x = xyz .>>. 42
      !y = xyz .>>. 21 .&. 0x1fffff
      !z = xyz .&. 0x1fffff

-- | l -> x -> r, +d
stream :: Monad m => Int -> Int -> Int -> VFSM.Stream m Int
stream !l !r !d = VFSM.Stream step l
  where
    step x
      | x <= r    = return $ VFSM.Yield x (x + d)
      | otherwise = return VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] stream #-}

-- | 0 <= x < n, interval = 1
rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep n = flip VFSM.mapM_ (stream 0 (n - 1) 1)
{-# INLINE rep #-}

-- | 0 <= x <= n, interval = 1
rep' :: Monad m => Int -> (Int -> m ()) -> m ()
rep' n = flip VFSM.mapM_ (stream 0 n 1)
{-# INLINE rep' #-}

-- | 1 <= x < n, interval = 1
rep1 :: Monad m => Int -> (Int -> m ()) -> m ()
rep1 n = flip VFSM.mapM_ (stream 1 (n - 1) 1)
{-# INLINE rep1 #-}

-- | 1 <= x <= n, interval = 1
rep1' :: Monad m => Int -> (Int -> m ()) -> m ()
rep1' n = flip VFSM.mapM_ (stream 1 n 1)
{-# INLINE rep1' #-}

-- | l <= x <= r, interval = d
for :: Monad m => Int -> Int -> Int -> (Int -> m ()) -> m ()
for l r d = flip VFSM.mapM_ (stream l r d)
{-# INLINE for #-}

-- | r -> x -> l, -d
streamR :: Monad m => Int -> Int -> Int -> VFSM.Stream m Int
streamR !r !l !d = VFSM.Stream step r
  where
    step x
      | x >= l    = return $ VFSM.Yield x (x - d)
      | otherwise = return VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] streamR #-}

-- | n > x >= 0, interval = -1
rev :: Monad m => Int -> (Int -> m ()) -> m ()
rev n = flip VFSM.mapM_ (streamR (n - 1) 0 1)
{-# INLINE rev #-}

-- | n >= x >= 0, interval = -1
rev' :: Monad m => Int -> (Int -> m ()) -> m ()
rev' n = flip VFSM.mapM_ (streamR n 0 1)
{-# INLINE rev' #-}

-- | n > x >= 1, interval = -1
rev1 :: Monad m => Int -> (Int -> m ()) -> m ()
rev1 n = flip VFSM.mapM_ (streamR (n - 1) 1 1)
{-# INLINE rev1 #-}

-- | n >= x >= 1, interval = -1
rev1' :: Monad m => Int -> (Int -> m ()) -> m ()
rev1' n = flip VFSM.mapM_ (streamR n 1 1)
{-# INLINE rev1' #-}

-- | r >= x >= l, interval = -d
forR :: Monad m => Int -> Int -> Int -> (Int -> m ()) -> m ()
forR r l d = flip VFSM.mapM_ (streamR r l d)
{-# INLINE forR #-}

-- | for (int i = l; f(i, p) <= r ; g(i, d))
streamG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> VFSM.Stream m Int
streamG l r f p g d = VFSM.Stream step l
  where
    step x
      | f x p <= r = return $ VFSM.Yield x (g x d)
      | otherwise  = return VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] streamG #-}

forG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> (Int -> m ()) -> m ()
forG l r f p g d = flip VFSM.mapM_ (streamG l r f p g d)
{-# INLINE forG #-}

withBreakIO :: ((r -> ContT r IO b) -> ContT r IO r) -> IO r
withBreakIO = flip runContT pure . callCC
{-# INLINE withBreakIO #-}

withBreakST :: ((r -> ContT r (ST s) b) -> ContT r (ST s) r) -> (ST s) r
withBreakST = flip runContT pure . callCC
{-# INLINE withBreakST #-}

yukicoder

結果

コンパイルメッセージ

ソースコード