{-# 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 (+) $ L.sort xs