#517483 (Haskell) No.5 数字のブロック

提出ソース

結果

問題	No.5 数字のブロック
ユーザー	poapoa
提出日時	2020-07-24 00:06:27
言語	Haskell (9.8.2)
結果	AC
実行時間	26 ms / 5,000 ms
コード長	6,321 bytes
コンパイル時間	5,983 ms
コンパイル使用メモリ	195,072 KB
実行使用メモリ	11,008 KB
最終ジャッジ日時	2024-06-23 23:26:09
合計ジャッジ時間	7,214 ms
ジャッジサーバーID （参考情報）	judge1 / judge4

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

テストケース

テストケース表示

入力	結果	実行時間実行使用メモリ
testcase_00	AC	2 ms 6,812 KB
testcase_01	AC	2 ms 6,940 KB
testcase_02	AC	2 ms 6,944 KB
testcase_03	AC	15 ms 10,368 KB
testcase_04	AC	11 ms 9,728 KB
testcase_05	AC	18 ms 10,496 KB
testcase_06	AC	13 ms 10,240 KB
testcase_07	AC	11 ms 9,856 KB
testcase_08	AC	14 ms 10,112 KB
testcase_09	AC	7 ms 8,704 KB
testcase_10	AC	20 ms 11,008 KB
testcase_11	AC	11 ms 9,856 KB
testcase_12	AC	16 ms 10,112 KB
testcase_13	AC	17 ms 10,496 KB
testcase_14	AC	2 ms 6,944 KB
testcase_15	AC	2 ms 6,944 KB
testcase_16	AC	20 ms 11,008 KB
testcase_17	AC	25 ms 11,008 KB
testcase_18	AC	21 ms 10,880 KB
testcase_19	AC	26 ms 10,880 KB
testcase_20	AC	2 ms 6,940 KB
testcase_21	AC	1 ms 6,944 KB
testcase_22	AC	2 ms 6,944 KB
testcase_23	AC	2 ms 6,940 KB
testcase_24	AC	2 ms 6,944 KB
testcase_25	AC	3 ms 6,940 KB
testcase_26	AC	2 ms 6,940 KB
testcase_27	AC	2 ms 6,940 KB
testcase_28	AC	2 ms 6,940 KB
testcase_29	AC	11 ms 9,856 KB
testcase_30	AC	7 ms 8,704 KB
testcase_31	AC	2 ms 6,944 KB
testcase_32	AC	2 ms 6,944 KB
testcase_33	AC	1 ms 6,944 KB

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

コンパイルメッセージ

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

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
import qualified Data.Char             as Char
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.List             as L
pair :: (a -> b, a -> c) -> a -> (b, c)
pair (f, g) x = (f x, g x)
cross :: (a -> c, b -> d) -> (a, b) -> (c, d)
cross (f, g) (x, y) = (f x , g y)
proj :: (a -> b) -> (a -> c) -> a -> (b, c)
proj f g x = (f x, g x)
type   Algebra f a = f a -> a
type CoAlgebra f a =   a -> f a
newtype Fix f = InF { outF :: f (Fix f) }
data Fx f a x = Fx { unFx :: Either a (f x) }
  deriving (Show, Functor)
data Hx f a x = Hx { unHx :: (a, f x) }
  deriving (Show, Functor)
newtype Free   f a = Free   { unFree   :: Fix (Fx f a) }
newtype CoFree f a = CoFree { unCoFree :: Fix (Hx f a) }
instance Functor f => Functor (Free f) where
  fmap f = Free . cata (InF . phi) . unFree
    where
      phi (Fx (Left a))  = Fx (Left (f a))
      phi (Fx (Right b)) = Fx (Right b)
instance Functor f => Functor (CoFree f) where
  fmap f = CoFree . ana (psi . outF) . unCoFree
    where
      psi (Hx (a, x)) = Hx (f a, x)
extract :: Functor f => CoFree f t -> t
extract cf = case outF (unCoFree cf) of
  Hx (a, _) -> a
sub :: Functor f => CoFree f a -> f (CoFree f a)
sub cf = case outF (unCoFree cf) of
  Hx (_, b) -> fmap CoFree b
inject :: Functor f => a -> Free f a
inject = Free . InF . Fx . Left
cata :: Functor f => Algebra f a -> (Fix f -> a)
cata phi = phi . fmap (cata phi) . outF
ana :: Functor f => CoAlgebra f a -> (a -> Fix f)
ana psi = InF . fmap (ana psi) . psi
hylo :: Functor f => Algebra f b -> CoAlgebra f a -> (a -> b)
hylo phi psi = phi . fmap (hylo phi psi) . psi
meta :: Functor f => Algebra f a -> CoAlgebra f a -> (Fix f -> Fix f)
meta phi psi = InF . fmap (meta phi psi) . outF
para :: Functor f => (f (Fix f, t) -> t) -> (Fix f -> t)
para phi = phi . fmap (pair (id, para phi)) . outF
apo :: Functor f => (t -> f (Either (Fix f) t)) -> (t -> Fix f)
apo psi = InF . fmap (uncurry either (id, apo psi)) . psi
hist :: Functor f => (f (CoFree f t) -> t) -> (Fix f -> t)
hist phi = extract . cata ap
  where
    ap   = cast . Hx . pair (phi, id)
    cast = CoFree . InF . fmap unCoFree
futu :: Functor f => (t -> f (Free f t)) -> (t -> Fix f)
futu psi = ana ap . inject
  where
    ap   = uncurry either (psi, id) . unFx . cast
    cast = fmap Free . outF . unFree
chrono :: Functor f => (f (CoFree f b) -> b) -> (a -> f (Free f a)) -> (a -> b)
chrono phi psi = extract . hylo phi' psi' . inject
  where
    phi'     = toCoFree . Hx . pair (phi, id)
    toCoFree = CoFree . InF . fmap unCoFree
    psi'     = uncurry either (psi, id) . unFx . fromFree
    fromFree = fmap Free . outF . unFree
cochrono :: Functor f => (f (CoFree f t) -> t) -> (t -> f (Free f t)) -> (Fix f -> Fix f)
cochrono phi psi = futu psi . hist phi
zygo :: Functor f => Algebra f a -> (f (a, b) -> b) -> (Fix f -> b)
zygo f phi = snd . cata (pair (f . fmap fst, phi))
cozygo :: Functor f => CoAlgebra f a -> (b -> f (Either a b)) -> (b -> Fix f)
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
dyna :: Functor f => (f (CoFree f b) -> b) -> CoAlgebra f a -> (a -> b)
dyna f g = chrono f (fmap inject . g)
codyna :: Functor f => Algebra f b -> (a -> f (Free f a)) -> (a -> b)
codyna f = chrono (f . fmap extract)
mutu :: Functor f => (a -> b) -> Algebra f a -> (Fix f -> b)
mutu p phi = p . cata phi
comutu :: Functor f => (b -> a) -> CoAlgebra f a -> (b -> Fix f)
comutu p psi = ana psi . p
prepro :: Functor f => (forall a. f a -> f a) -> Algebra f a -> (Fix f -> a)
prepro h f = f . fmap (prepro h f . cata (InF . h)) . outF
postpro :: Functor f => (forall a. f a -> f a) -> CoAlgebra f a -> a -> (Fix f)
postpro h f = InF . fmap (ana (h . outF) . postpro h f) . f

data ListF a r
  = Nil
  | Cons a r
  deriving (Show, Functor)
type List a = Fix (ListF a)
instance Show a => Show (List a) where
  show (InF Nil) = "Nil"
  show (InF (Cons x xs)) = "(Cons " ++ show x ++ " " ++ show xs ++ ")"
nil :: List a
nil = InF Nil
cons :: a -> List a -> List a
cons x xs = InF (Cons x xs)
data SListF a r
  = SNil
  | SCons a r
  deriving (Show, Functor)
type SList a = Fix (SListF a)
instance Show a => Show (SList a) where
  show (InF SNil) = "SNil"
  show (InF (SCons x xs)) = "(SCons " ++ show x ++ " " ++ show xs ++ ")"
snil :: SList a
snil = InF SNil
scons :: a -> SList a -> SList a
scons x xs = InF (SCons x xs)
toList :: [a] -> List a
toList = L.foldr cons nil
fromList :: List a -> [a]
fromList = L.unfoldr psi
  where
    psi (InF Nil) = Nothing
    psi (InF (Cons x xs)) = Just (x, xs)
fromSList :: SList a -> [a]
fromSList = L.unfoldr psi
  where
    psi (InF SNil) = Nothing
    psi (InF (SCons x xs)) = Just (x, xs)
maphd :: (a -> a) -> (List a -> List a)
maphd f = apo psi
  where
    psi (InF Nil) = Nil
    psi (InF (Cons x xs)) = Cons (f x) (Left xs)
type ListF' = ListF Int
type SListF' = SListF Int
swap :: ListF' (SListF' a) -> SListF' (ListF' a)
swap Nil = SNil
swap (Cons a SNil) = SCons a Nil
swap (Cons a (SCons b x))
  | a <= b         = SCons a (Cons b x)
  | otherwise      = SCons b (Cons a x)
swop :: ListF' (a, SListF' a) -> SListF' (Either a (ListF' a))
swop Nil = SNil
swop (Cons a (x, SNil)) = SCons a (Left x)
swop (Cons a (x, SCons b x'))
  | a <= b              = SCons a (Left x)
  | otherwise           = SCons b (Right (Cons a x'))
bubbleSort' :: Fix (ListF Int) -> Fix (SListF Int)
bubbleSort' = ana  (cata (fmap InF .  swap))
selectSort' :: Fix (ListF Int) -> Fix (SListF Int)
selectSort' = ana  (para (fmap (either id InF) . swop))
selectSort :: [Int] -> [Int]
selectSort  = sortBy selectSort'
sortBy :: Ord a => (List a -> SList a) -> [a] -> [a]
sortBy sorter = fromSList . sorter . toList
bubbleSort :: [Int] -> [Int]
bubbleSort = sortBy bubbleSort'
insertSort' :: Fix (ListF Int) -> Fix (SListF Int)
insertSort' = cata (apo  (swop . fmap (pair (id, outF))))
insertSort :: [Int] -> [Int]
insertSort = sortBy insertSort'
getInt :: IO [Int]
getInt = L.unfoldr f <$> BSC8.getLine
  where
    f s = do
      (n, s') <- BSC8.readInt s
      return (n, BSC8.dropWhile Char.isSpace s')
main :: IO ()
main= do
  l  <- readLn :: IO Int
  n  <- readLn :: IO Int
  xs <- getInt
  print $ length $ takeWhile (<= l)$ L.scanl1 (+) $ insertSort xs

yukicoder

結果

テストケース

コンパイルメッセージ

ソースコード