結果

問題 No.639 An Ordinary Sequence
コンテスト
ユーザー poapoa
提出日時 2020-08-18 08:11:19
言語 Haskell
(9.10.1)
結果
TLE  
実行時間 -
コード長 4,950 bytes
コンパイル時間 10,515 ms
コンパイル使用メモリ 193,664 KB
実行使用メモリ 270,056 KB
最終ジャッジ日時 2024-10-11 21:36:00
合計ジャッジ時間 14,788 ms
ジャッジサーバーID
（参考情報） 		judge1 / judge4
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample -- * 2
other TLE * 1 -- * 16
権限があれば一括ダウンロードができます
コンパイルメッセージ
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 DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}

import           Control.Monad.Fix
import qualified Data.Vector.Unboxed as VU

k :: Int
k = 10 ^ 6

main :: IO ()
main = do
  n <- readLn :: IO Int
  print $ solver (map solver' [0..k]) n

solver :: [Int] -> Int -> Int
solver xs = fix (\f x -> if x <= k then xs !! x else f (x `div` 3) + f (x `div` 5))

solver' :: Int -> Int
solver' = dyna phi psi
  where
    psi 0 = StreamF 0 Nothing
    psi i = StreamF i (Just (i - 1))

    phi (StreamF _ Nothing) = 1
    phi (StreamF i (Just t)) = back (i - (div i 3)) t + back (i - (div i 5)) t

    back 1 t = extract t
    back i t = case sub t of
      StreamF _ Nothing    -> 1
      StreamF c' (Just t') -> back (i - 1) t'

data StreamF a
  = StreamF Int (Maybe a)
  deriving (Functor)
type Stream = FixF StreamF






pair :: (a -> b, a -> c) -> a -> (b, c)
pair (f, g) x = (f x, g x)
newtype FixF f
  = InF { outF :: f (FixF f) }
cata :: Functor f => (f a -> a) -> (FixF f -> a)
cata phi = phi . fmap (cata phi) . outF
ana  :: Functor f => (a -> f a) -> (a -> FixF f)
ana psi  = InF . fmap (ana psi) . psi
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo phi psi = cata phi . ana psi
meta :: (Functor f, Functor g) => (f a -> a) -> (a -> b) -> (b -> g b) -> (FixF f -> FixF g)
meta phi chi psi = ana psi . chi . cata phi 
prepro :: Functor f => (forall a. f a -> f a) -> (f a -> a) -> (FixF 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 -> FixF f)
postpro chi psi = InF . fmap (ana (chi . outF) . postpro chi psi) . psi
para :: Functor f => (f (FixF f, a) -> a) -> (FixF f -> a)
para phi = phi . fmap ((,) <*> para phi) . outF
apo :: Functor f => (a -> f (Either (FixF f) a)) -> (a -> FixF f)
apo psi = InF . fmap (uncurry either (id, apo psi)) . psi
zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> (FixF f -> a)
zygo phi phi' = snd . cata (pair (phi . fmap fst, phi'))
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> (b -> FixF f)
cozygo psi psi' = ana (uncurry either (fmap Left . psi, psi')) . Right
mutu :: Functor f => (a -> b) -> (f a -> a) -> (FixF f -> b)
mutu chi phi = chi . cata phi
comutu :: Functor f => (b -> a) -> (a -> f a) -> (b -> FixF 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   :: FixF (Fx f a) }
newtype CoFree f a
  =     CoFree { unCoFree :: FixF (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) -> (FixF f -> t)
histo phi = extract . cata ap
  where
    ap = CoFree
        . InF
        . fmap unCoFree
        . Hx
        . pair (phi, id)
futu :: Functor f => (t -> f (Free f t)) -> (t -> FixF f)
futu psi = ana ap . inject
  where
    ap   = uncurry either (psi, id)
          . unFx
          . 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' = 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)) -> (FixF f -> FixF 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
mcata :: (forall b. (b -> a) -> f b -> a) -> (FixF f -> a)
mcata phi = phi (mcata phi) . outF
mana :: (forall b. (a -> b) -> a -> f b) -> (a -> FixF f)
mana psi = InF . psi (mana psi)
mhisto :: (forall b. (b -> a) -> (b -> f b) -> f b -> a) -> (FixF f -> a)
mhisto psi = psi (mhisto psi) outF . outF
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)
0