#583482 (Haskell) No.490 yukiソート

提出ソース

結果

問題	No.490 yukiソート
ユーザー	こまる
提出日時	2020-11-23 23:49:35
言語	Haskell (9.8.2)
結果	RE
実行時間	-
コード長	11,668 bytes
コンパイル時間	8,812 ms
コンパイル使用メモリ	254,340 KB
実行使用メモリ	6,948 KB
最終ジャッジ日時	2024-07-23 18:09:03
合計ジャッジ時間	8,663 ms
ジャッジサーバーID （参考情報）	judge1 / judge5

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

テストケース

テストケース表示

入力	結果	実行時間実行使用メモリ
testcase_00	AC	1 ms 5,248 KB
testcase_01	AC	2 ms 5,248 KB
testcase_02	RE	-
testcase_03	RE	-
testcase_04	RE	-
testcase_05	RE	-
testcase_06	RE	-
testcase_07	RE	-
testcase_08	RE	-
testcase_09	RE	-
testcase_10	RE	-
testcase_11	RE	-
testcase_12	RE	-
testcase_13	RE	-
testcase_14	RE	-
testcase_15	RE	-
testcase_16	RE	-
testcase_17	RE	-
testcase_18	RE	-
testcase_19	RE	-
testcase_20	RE	-
testcase_21	RE	-
testcase_22	RE	-
testcase_23	RE	-
testcase_24	RE	-
testcase_25	RE	-
testcase_26	RE	-
testcase_27	RE	-
testcase_28	RE	-
testcase_29	RE	-
testcase_30	RE	-
testcase_31	RE	-
testcase_32	RE	-
testcase_33	RE	-
testcase_34	RE	-
testcase_35	RE	-

権限があれば一括ダウンロードができます

コンパイルメッセージ

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

ソースコード

raw source code

{-# OPTIONS_GHC -mavx2            #-}
{-# OPTIONS_GHC -O3               #-}
{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE UndecidableInstances #-}

import           Control.Monad
import           Control.Monad.Cont
import           Control.Monad.ST
import           Control.Monad.State
import           Data.Char
import           Data.Coerce
import           Data.Int
import           Data.Maybe
import           Data.Word
import           System.IO
import qualified Data.ByteString                   as BS
import qualified Data.ByteString.Builder           as BSB
import qualified Data.ByteString.Char8             as BSC8
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Generic               as VG
import qualified Data.Vector.Generic.Mutable       as VGM
import qualified Data.Vector.Unboxed               as VU

main :: IO ()
main = do
  n  <- readLn :: IO Int
  xs <- seqInput n
  printVecInSpcSepLn $ yukiSort xs

yukiSort :: (Ord a, VG.Vector v a) => v a -> v a
yukiSort = yukiSortBy compare

yukiSortBy :: (Ord a, VG.Vector v a) => (a -> a -> Ordering) -> v a -> v a
yukiSortBy cmp vec
  | n <= 2    = vec
  | otherwise = VG.create $ do
    v <- VG.unsafeThaw vec
    range 1 (2 * n - 4) $ \i -> do
      range 0 ((n - 1) `div` 2) $ \p -> do
        let q = i - p
        when (p < q && (cmp (vec VG.! p) (vec VG.! q) == GT)) $ do
          VGM.unsafeWrite v p (vec VG.! q)
          VGM.unsafeWrite v q (vec VG.! p)
    return v
  where
    !n = VG.length vec

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep n = flip VFSM.mapM_ (streamG 0 (n - 1) const 0 (+) 1)
{-# INLINE rep #-}

rep' :: Monad m => Int -> (Int -> m ()) -> m ()
rep' n = flip VFSM.mapM_ (streamG 0 n const 0 (+) 1)
{-# INLINE rep' #-}

rep1 :: Monad m => Int -> (Int -> m ()) -> m ()
rep1 n = flip VFSM.mapM_ (streamG 1 (n - 1) const 0 (+) 1)
{-# INLINE rep1 #-}

rep1' :: Monad m => Int -> (Int -> m ()) -> m ()
rep1' n = flip VFSM.mapM_ (streamG 1 n const 0 (+) 1)
{-# INLINE rep1' #-}

rev :: Monad m => Int -> (Int -> m ()) -> m ()
rev n = flip VFSM.mapM_ (streamRG (n - 1) 0 const 0 (-) 1)
{-# INLINE rev #-}

rev' :: Monad m => Int -> (Int -> m ()) -> m ()
rev' n = flip VFSM.mapM_ (streamRG n 0 const 0 (-) 1)
{-# INLINE rev' #-}

rev1 :: Monad m => Int -> (Int -> m ()) -> m ()
rev1 n = flip VFSM.mapM_ (streamRG (n - 1) 1 const 0 (-) 1)
{-# INLINE rev1 #-}

rev1' :: Monad m => Int -> (Int -> m ()) -> m ()
rev1' n = flip VFSM.mapM_ (streamRG n 1 const 0 (-) 1)
{-# INLINE rev1' #-}

range :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
range l r = flip VFSM.mapM_ (streamG l r const 0 (+) 1)
{-# INLINE range #-}

rangeR :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
rangeR r l = flip VFSM.mapM_ (streamRG r l const 0 (-) 1)
{-# INLINE rangeR #-}

forP :: Monad m => Int -> (Int -> m ()) -> m ()
forP p = flip VFSM.mapM_ (streamG 2 p (^) 2 (+) 1)
{-# INLINE forP #-}

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 #-}

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

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 #-}

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

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 #-}

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 #-}
int1 :: CParser Int
int1 = fmap (subtract 1) int
{-# INLINE int1 #-}
char :: CParser Char
char = coerce BSC8.uncons
{-# INLINE char #-}
byte :: CParser Word8
byte = coerce BS.uncons
{-# INLINE byte #-}
skipSpaces :: CParser ()
skipSpaces = modify' (BSC8.dropWhile isSpace)
{-# INLINE skipSpaces #-}
seqInput :: Int -> IO (VU.Vector Int)
seqInput n = VU.unfoldrN n (runCParser int) <$> BSC8.getLine
{-# INLINE seqInput #-}
parseN1 :: Int -> IO (VU.Vector Int)
parseN1 n = VU.unfoldrN n (runCParser int) <$> BSC8.getContents
{-# INLINE parseN1 #-}
parseN2 :: Int -> IO (VU.Vector (Int, Int))
parseN2 n = VU.unfoldrN n (runCParser $ (,) <$> int <*> int) <$> BSC8.getContents
{-# INLINE parseN2 #-}
parseN3 :: Int -> IO (VU.Vector (Int, Int, Int))
parseN3 n = VU.unfoldrN n (runCParser $ (,,) <$> int <*> int <*> int) <$> BSC8.getContents
{-# INLINE parseN3 #-}
parseN4 :: Int -> IO (VU.Vector (Int, Int, Int, Int))
parseN4 n = VU.unfoldrN n (runCParser $ (,,,) <$> int <*> int <*> int <*> int) <$> BSC8.getContents
{-# INLINE parseN4 #-}
parseN5 :: Int -> IO (VU.Vector (Int, Int, Int, Int, Int))
parseN5 n = VU.unfoldrN n (runCParser $ (,,,,) <$> int <*> int <*> int <*> int <*> int) <$> BSC8.getContents
{-# INLINE parseN5 #-}
parseANBN :: Int -> IO (VU.Vector Int, VU.Vector Int)
parseANBN n = VU.unzip . VU.unfoldrN n (runCParser $ (,) <$> int <*> int) <$> BSC8.getContents
{-# INLINE parseANBN #-}
parseANBNCN :: Int -> IO (VU.Vector Int, VU.Vector Int, VU.Vector Int)
parseANBNCN n = VU.unzip3 . VU.unfoldrN n (runCParser $ (,,) <$> int <*> int <*> int) <$> BSC8.getContents
{-# INLINE parseANBNCN #-}

type Query3 = (Int, Int, Int)
query3Parser :: CParser Query3
query3Parser = do
  skipSpaces
  t <- char
  case t of
    '0' -> (,,) 0 <$> int <*> int
    _   -> (,,) 1 <$> int <*> pure 0
parseQ3 :: Int -> IO (VU.Vector Query3)
parseQ3 n = VU.unfoldrN n (runCParser query3Parser) <$> BSC8.getContents
{-# INLINE parseQ3 #-}

type Query5 = (Int, Int, Int, Int, Int)
query5Parser :: CParser Query5
query5Parser = do
  skipSpaces
  t <- char
  case t of
    '0' -> (,,,,) 0 <$> int <*> int <*> int    <*> int
    _   -> (,,,,) 1 <$> int <*> int <*> pure 0 <*> pure 0
parseQ5 :: Int -> IO (VU.Vector Query5)
parseQ5 n = VU.unfoldrN n (runCParser query5Parser) <$> BSC8.getContents
{-# INLINE parseQ5 #-}

readInt :: BSC8.ByteString -> Int
readInt = fst . fromJust . BSC8.readInt
{-# INLINE readInt #-}
getInt :: IO Int
getInt = readInt <$> BSC8.getLine
{-# INLINE getInt #-}
readIntList :: BSC8.ByteString -> [Int]
readIntList = map readInt . BSC8.words
{-# INLINE readIntList #-}
getIntList :: IO [Int]
getIntList = readIntList <$> BSC8.getLine
{-# INLINE getIntList #-}
readInteger :: BSC8.ByteString -> Integer
readInteger = fst . fromJust . BSC8.readInteger
{-# INLINE readInteger #-}
getInteger :: IO Integer
getInteger = readInteger <$> BSC8.getLine
{-# INLINE getInteger #-}
readIntegerList :: BSC8.ByteString -> [Integer]
readIntegerList = map readInteger . BSC8.words
{-# INLINE readIntegerList #-}
getIntegerList :: IO [Integer]
getIntegerList = readIntegerList <$> BSC8.getLine
{-# INLINE getIntegerList #-}

class ShowAsBuilder a where
  showAsBuilder :: a -> BSB.Builder
  default showAsBuilder :: (Show a) => a -> BSB.Builder
  showAsBuilder = BSB.string8 . show

instance ShowAsBuilder Int where
  showAsBuilder = BSB.intDec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Int8 where
  showAsBuilder = BSB.int8Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Int16 where
  showAsBuilder = BSB.int16Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Int32 where
  showAsBuilder = BSB.int32Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Int64 where
  showAsBuilder = BSB.int64Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Word8 where
  showAsBuilder = BSB.word8Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Word16 where
  showAsBuilder = BSB.word16Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Word32 where
  showAsBuilder = BSB.word32Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Word64 where
  showAsBuilder = BSB.word64Dec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Integer where
  showAsBuilder = BSB.integerDec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Float where
  showAsBuilder = BSB.floatDec
  {-# INLINE showAsBuilder #-}
instance ShowAsBuilder Double where
  showAsBuilder = BSB.doubleDec
  {-# INLINE showAsBuilder #-}

instance (ShowAsBuilder a, VG.Vector v a) => ShowAsBuilder (v a) where
  showAsBuilder = v2BSpcSep

putBuilder :: BSB.Builder -> IO ()
putBuilder = BSB.hPutBuilder stdout
{-# INLINE putBuilder #-}

printVecInLines :: (VG.Vector v a, ShowAsBuilder a) => v a -> IO ()
printVecInLines = putBuilder . v2BLines
{-# INLINE printVecInLines #-}

printVecInSpcSepLn :: (VG.Vector v a, ShowAsBuilder a) => v a -> IO ()
printVecInSpcSepLn = putBuilder . v2BSpcSepLn
{-# INLINE printVecInSpcSepLn #-}

v2BSpcSepLn :: (VG.Vector v a, ShowAsBuilder a) => v a -> BSB.Builder
v2BSpcSepLn = v2BSpcSepLnWith showAsBuilder
{-# INLINE v2BSpcSepLn #-}

v2BSpcSep :: (VG.Vector v a, ShowAsBuilder a) => v a -> BSB.Builder
v2BSpcSep = v2BSpcSepWith showAsBuilder
{-# INLINE v2BSpcSep #-}

v2BConcat:: (VG.Vector v a, ShowAsBuilder a) => v a -> BSB.Builder
v2BConcat = v2BConcatWith showAsBuilder
{-# INLINE v2BConcat #-}

v2BLines:: (VG.Vector v a, ShowAsBuilder a) => v a -> BSB.Builder
v2BLines = v2BLinesWith showAsBuilder
{-# INLINE v2BLines #-}

v2BSpcSepLnWith :: VG.Vector v a => (a -> BSB.Builder) -> v a -> BSB.Builder
v2BSpcSepLnWith = v2BSpcSepPostfWith "\n"
{-# INLINE v2BSpcSepLnWith #-}

v2BSpcSepWith :: VG.Vector v a => (a -> BSB.Builder) -> v a -> BSB.Builder
v2BSpcSepWith = v2BSpcSepPostfWith ""
{-# INLINE v2BSpcSepWith #-}

v2BConcatWith :: VG.Vector v a => (a -> BSB.Builder) -> v a -> BSB.Builder
v2BConcatWith showFct = VG.foldr ((<>) . showFct) mempty
{-# INLINE v2BConcatWith #-}

v2BLinesWith :: VG.Vector v a => (a -> BSB.Builder) -> v a -> BSB.Builder
v2BLinesWith showFct = VG.foldr (\a -> (showFct a <>) . (BSB.char7 '\n' <>)) mempty
{-# INLINE v2BLinesWith #-}

v2BSpcSepPostf :: (VG.Vector v a, ShowAsBuilder a) => BS.ByteString -> v a -> BSB.Builder
v2BSpcSepPostf = (`v2BSpcSepPostfWith` showAsBuilder)
{-# INLINE v2BSpcSepPostf #-}

v2BSpcSepPostfWith :: VG.Vector v a => BS.ByteString -> (a -> BSB.Builder) -> v a -> BSB.Builder
v2BSpcSepPostfWith = vecToBuilder "" " "
{-# INLINE v2BSpcSepPostfWith #-}

vecToBuilder :: VG.Vector v a => BS.ByteString -> BS.ByteString -> BS.ByteString -> (a -> BSB.Builder) -> v a -> BSB.Builder
vecToBuilder !prefix !separator !postfix = vecToBuilder_ (BSB.byteString prefix) (BSB.byteString separator) (BSB.byteString postfix)
{-# INLINE vecToBuilder #-}

vecToBuilder_ :: VG.Vector v a => BSB.Builder -> BSB.Builder -> BSB.Builder -> (a -> BSB.Builder) -> v a -> BSB.Builder
vecToBuilder_ !prefix !separator !postfix showFct vec = prefix <> VG.foldr (\a rest !prefx -> prefx <> (showFct a <> rest separator)) (const postfix) vec mempty
{-# INLINE vecToBuilder_ #-}

yukicoder

結果

テストケース

コンパイルメッセージ

ソースコード