{-# LANGUAGE BangPatterns, BinaryLiterals, CPP, DerivingStrategies #-} {-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, LambdaCase #-} {-# LANGUAGE MagicHash, MultiParamTypeClasses, MultiWayIf #-} {-# LANGUAGE NumericUnderscores, OverloadedStrings, PatternSynonyms #-} {-# LANGUAGE RankNTypes, RecordWildCards, ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving, TupleSections, TypeApplications #-} {-# LANGUAGE TypeFamilies, TypeInType, UnboxedTuples, ViewPatterns #-} {- base -} import qualified Control.Arrow as Arrow import Control.Monad import Control.Monad.ST import qualified Data.Bits as Bits import qualified Data.Char as Char import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified Data.Word as Word import GHC.Exts import Foreign hiding (void) import Unsafe.Coerce {- bytestring -} import qualified Data.ByteString.Char8 as BSC8 {- containers -} import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import qualified Data.Sequence as Seq {- mtl -} import Control.Monad.State.Strict {- transformers -} import Control.Monad.Reader {- vector -} import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Mutable as VUM main :: IO () main = parse1 >>= print . solver solver :: Int -> Int solver = dyna phi psi where psi 0 = NonEmptyListF 0 Nothing psi i = NonEmptyListF i (Just (i - 1)) phi (NonEmptyListF _ Nothing) = 1 phi (NonEmptyListF i (Just t)) | i == 1 = 1 | otherwise = f1 + f2 where f1 = back 1 t f2 = back 2 t back 1 cs = extract cs back i cs = case sub cs of NonEmptyListF b (Just t) -> back (i - 1) t data NonEmptyListF a = NonEmptyListF Int (Maybe a) instance Functor NonEmptyListF where fmap f (NonEmptyListF x Nothing) = NonEmptyListF x Nothing fmap f (NonEmptyListF x (Just xs)) = NonEmptyListF x (Just (f xs)) -- newtype Fix f = InF { outF :: f (Fix f) } pair :: (a -> b, a -> c) -> a -> (b, c) pair (f, g) x = (f x, g x) cata :: Functor f => (f a -> a) -> (Fix f -> a) cata phi = phi . fmap (cata phi) . outF ana :: Functor f => (a -> f a) -> (a -> Fix f) ana psi = InF . fmap (ana psi) . psi hylo :: Functor f => (f a -> a) -> (b -> f b) -> (b -> a) hylo phi psi = phi . fmap (hylo phi psi) . psi -- cata phi . ana psi meta :: (Functor f, Functor g) => (f a -> a) -> (a -> b) -> (b -> g b) -> (Fix f -> Fix g) meta phi chi psi = ana psi . chi . cata phi prepro :: Functor f => (forall a. f a -> f a) -> (f a -> a) -> (Fix f -> a) prepro chi phi = phi . fmap (prepro chi phi . cata (InF . chi)) . outF postpro :: Functor f => (forall a. f a -> f a) -> (a -> f a) -> (a -> Fix f) postpro chi psi = InF . fmap (ana (chi . outF) . postpro chi psi) . psi para :: Functor f => (f (Fix f, a) -> a) -> (Fix f -> a) para phi = phi . fmap ((,) <*> para phi) . outF apo :: Functor f => (a -> f (Either (Fix f) a)) -> (a -> Fix f) apo psi = InF . fmap (uncurry either (id, apo psi)) . psi zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> (Fix f -> a) zygo phi phi' = snd . cata (pair (phi . fmap fst, phi')) cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> (b -> Fix f) cozygo psi psi' = ana (uncurry either (fmap Left . psi, psi')) . Right mutu :: Functor f => (a -> b) -> (f a -> a) -> (Fix f -> b) mutu chi phi = chi . cata phi comutu :: Functor f => (b -> a) -> (a -> f a) -> (b -> Fix f) comutu chi psi = ana psi . chi data Fx f a x = Fx { unFx :: Either a (f x) } data Hx f a x = Hx { unHx :: (a, f x) } instance Functor f => Functor (Fx f a) where fmap f (Fx (Left x)) = Fx (Left x) fmap f (Fx (Right x)) = Fx (Right (fmap f x)) instance Functor f => Functor (Hx f a) where fmap f (Hx (x, y)) = Hx (x, fmap f y) 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 histo :: Functor f => (f (CoFree f t) -> t) -> (Fix f -> t) histo phi = extract . cata (CoFree . InF . fmap unCoFree . Hx . pair (phi, id)) futu :: Functor f => (t -> f (Free f t)) -> (t -> Fix f) futu psi = ana (uncurry either (psi, id) . unFx . fmap Free . outF . unFree) . inject 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' = CoFree . InF . fmap unCoFree . Hx . pair (phi, id) psi' = uncurry either (psi, id) . unFx . 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 . histo phi dyna :: Functor f => (f (CoFree f b) -> b) -> (a -> f a) -> (a -> b) dyna phi psi = chrono phi (fmap inject . psi) codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> (a -> b) codyna phi psi = cata phi . futu psi exo :: Functor h => (m b -> b, b -> n b) -> (h b -> m b) -> (h a -> h (g a)) -> (f a -> a, g a -> h a) -> (g a -> b) exo c f g d = hylo (fst c . f) (g . snd d) mcata :: (forall b. (b -> a) -> f b -> a) -> (Fix f -> a) mcata phi = phi (mcata phi) . outF mana :: (forall b. (a -> b) -> a -> f b) -> (a -> Fix f) mana psi = InF . psi (mana psi) mhisto :: (forall b. (b -> a) -> (b -> f b) -> f b -> a) -> (Fix f -> a) mhisto psi = psi (mhisto psi) outF . outF -- type Parser a = BSC8.ByteString -> Maybe (a, BSC8.ByteString) parseInt :: Parser Int parseInt = fmap (Arrow.second BSC8.tail) . BSC8.readInt parseChar :: [Char] -> VU.Vector Char parseChar = VU.fromList pint :: StateT BSC8.ByteString Maybe Int pint = coerce $ BSC8.readInt . BSC8.dropWhile Char.isSpace parse1 :: IO Int parse1 = readLn parse2 :: IO (Int, Int) parse2 = (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldrN 2 parseInt <$> BSC8.getLine parse3 :: IO (Int, Int, Int) parse3 = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) . VU.unfoldrN 3 parseInt <$> BSC8.getLine parse4 :: IO (Int, Int, Int, Int) parse4 = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2, vec VU.! 3)) . VU.unfoldrN 4 parseInt <$> BSC8.getLine parseM :: Int -> IO (VU.Vector Int) parseM m = VU.unfoldrN m parseInt <$> BSC8.getLine parseN :: Int -> IO (VU.Vector Int) parseN n = VU.replicateM n parse1 parseNM :: Int -> Int -> IO (V.Vector (VU.Vector Int)) parseNM n m = V.replicateM n $ VU.unfoldrN m parseInt <$> BSC8.getLine parseANBN :: Int -> IO (VU.Vector Int, VU.Vector Int) parseANBN n = VU.unzip . VU.unfoldrN n (runStateT $ (,) <$> pint <*> pint) <$> BSC8.getContents parseANBNCN :: Int -> IO (VU.Vector Int, VU.Vector Int, VU.Vector Int) parseANBNCN n = VU.unzip3 . VU.unfoldrN n (runStateT $ (,,) <$> pint <*> pint <*> pint) <$> BSC8.getContents