結果

問題 No.5 数字のブロック
ユーザー poapoa
提出日時 2020-07-24 00:04:33
言語 Haskell
(9.10.1)
結果
AC  
実行時間 35 ms / 5,000 ms
コード長 6,151 bytes
コンパイル時間 3,528 ms
コンパイル使用メモリ 192,640 KB
実行使用メモリ 12,160 KB
最終ジャッジ日時 2024-06-23 23:21:13
合計ジャッジ時間 5,062 ms
ジャッジサーバーID
（参考情報） 		judge2 / judge4
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
other AC * 34
権限があれば一括ダウンロードができます
コンパイルメッセージ
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

ソースコード

diff # 

{-# 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'
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 (+) $ selectSort xs
0