結果

問題 No.23 技の選択
コンテスト
ユーザー poapoa
提出日時 2020-07-31 10:40:24
言語 Haskell
(9.10.1)
結果
AC  
実行時間 10 ms / 5,000 ms
コード長 5,250 bytes
コンパイル時間 4,980 ms
コンパイル使用メモリ 204,556 KB
実行使用メモリ 7,936 KB
最終ジャッジ日時 2024-07-05 22:58:48
合計ジャッジ時間 6,046 ms
ジャッジサーバーID
（参考情報） 		judge4 / judge1
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
other AC * 33
権限があれば一括ダウンロードができます
コンパイルメッセージ
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 #
raw source code 

{-# LANGUAGE Rank2Types #-}
import qualified Control.Arrow         as Arrow
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.Vector.Unboxed   as VU
import Text.Printf

-- tree
data HPTree a
  = HPTree Int (Maybe a)
instance Functor HPTree where
  fmap f (HPTree a Nothing)  = HPTree a Nothing
  fmap f (HPTree a (Just b)) = HPTree a (Just (f b))

-- solver
solver :: Int -> Int -> Int -> Float
solver h a d = dyna phi psi $ h
  where
    psi 0 = HPTree 0 Nothing
    psi i = HPTree i (Just (i - 1))

    phi (HPTree _ Nothing)   = 0
    phi (HPTree i (Just cs)) = min (x1 + 1) (x2 + 1.5)
      where
        x1 = back a cs
        x2 = back d cs

    back 1 cs = extract cs
    back i cs = case sub cs of
      HPTree _ Nothing  -> 0
      HPTree _ (Just b) -> back (i - 1) b

-- main
main :: IO ()
main = do
  (h, a, d) <- getABC
  printf "%.4f\n" (solver h a d)

-- io
getI :: BSC8.ByteString -> Maybe (Int, BSC8.ByteString)
getI = fmap (Arrow.second BSC8.tail) . BSC8.readInt
getABC :: IO (Int, Int, Int)
getABC = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) . VU.unfoldrN 3 getI <$> BSC8.getLine

-- morphism
pair :: (a -> b, a -> c) -> a -> (b, c)
pair (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) }

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 = cata phi . ana psi

meta :: (Functor f, Functor g) => Algebra f a -> (a -> b) -> (CoAlgebra g b) -> (Fix f -> Fix g)
meta phi chi psi = ana psi . chi . cata phi 

prepro :: Functor f => (forall a. f a -> f a) -> Algebra f 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) -> CoAlgebra 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 => Algebra f b -> (f (b, a) -> a) -> (Fix f -> a)
zygo phi phi' = snd . cata (pair (phi . fmap fst, phi'))

cozygo :: Functor f => CoAlgebra 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) -> Algebra f a -> (Fix f -> b)
mutu chi phi = chi . cata phi

comutu :: Functor f => (b -> a) -> CoAlgebra 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 ap
  where
    ap   = CoFree
          . InF
          . fmap unCoFree
          . Hx
          . pair (phi, id)

futu :: Functor f => (t -> f (Free f t)) -> (t -> Fix 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)) -> (Fix f -> Fix f)
cochrono phi psi = futu psi . histo phi

dyna :: Functor f => (f (CoFree f b) -> b) -> CoAlgebra f a -> (a -> b)
dyna phi psi = chrono phi (fmap inject . psi)

codyna :: Functor f => Algebra f b -> (a -> f (Free f a)) -> (a -> b)
codyna phi = chrono (phi . fmap extract)

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
0