#542866 (Haskell) No.45 回転寿司

• 問題: No.45 回転寿司
• ユーザー: poapoa
• 提出日時: 2020-08-29 06:20:40
• 言語: Haskell (9.8.2)
• 結果: CE (最新)
  AC
  (最初)
• 実行時間: -
• コード長: 7,641 bytes
• コンパイル時間: 5,052 ms
• コンパイル使用メモリ: 156,288 KB
• 最終ジャッジ日時: 2024-11-14 23:43:46
• 合計ジャッジ時間: 5,590 ms
• ジャッジサーバーID （参考情報）: judge2 / judge1

コンパイルメッセージ

Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default

Main.hs:10:28: warning: [GHC-53692] [-Wdeprecated-flags]
    -XTypeInType is deprecated: use -XDataKinds and -XPolyKinds instead
   |
10 | {-# LANGUAGE TypeFamilies, TypeInType, UnboxedTuples, ViewPatterns  #-}
   |                            ^^^^^^^^^^
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:28:1: error: [GHC-87110]
    Could not load module ‘Data.IntMap.Strict’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
28 | import           Data.IntMap.Strict          (IntMap)
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Main.hs:29:1: error: [GHC-87110]
    Could not load module ‘Data.IntMap.Strict’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
29 | import qualified Data.IntMap.Strict          as IntMap
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Main.hs:30:1: error: [GHC-87110]
    Could not load module ‘Data.IntSet’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
30 | import           Data.IntSet                 (IntSet)
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Main.hs:31:1: error: [GHC-87110]
    Could not load module ‘Data.IntSet’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
31 | import qualified Data.IntSet                 as IntSet
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Main.hs:32:1: error: [GHC-87110]
    Could not load module ‘Data.Sequence’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
   |
32 | import qualified Data.Sequence               as Seq
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

ソースコード

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE DeriveFunctor                                          #-}
{-# 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 = do
  m <- parse1
  v <- parseM m
  print $ solver v m

solver :: VU.Vector Int -> Int -> Int
solver v m = dyna phi psi $ (m - 1)
  where
    psi 0 = NELF (v VU.! 0) Nothing
    psi i = NELF (v VU.! i) (Just (i - 1))

    phi (NELF j Nothing)       = j
    phi (NELF j (Just t)) = max f1 f2
      where
        f1 = extract t
        f2 = case sub t of
              NELF j' Nothing -> j
              NELF j' (Just t') -> extract t' +  j

data NELF a = NELF Int (Maybe a) deriving Functor
-----------
-- input --
-----------
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
--------------
-- morphism --
--------------
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