提出 #18110373

---

ソースコード 拡げる

import Data.Array
import qualified Data.ByteString.Char8 as BS
import qualified Data.List as DL
import qualified Data.Char as DC
import qualified Control.Monad as CM

{- 関手 f について不動点を取る
  ここで、 inF  :: f (FixF f) -> FixF f
                 outF :: FixF f     -> f (FixF f)
  であり、inF . outF = id, outF . inF = id
  よって同型の定義より f について不動点を取れている。-}
newtype FixF f = InF { outF :: f (FixF f) }

-- Fx = A × F(X)
data Fx f a x = FCons a (f x)
instance Functor f => Functor (Fx f a) where
  fmap f (FCons x xs) = FCons x (fmap f xs)

-- Cofree の宣言
newtype Cofree f a = Cf { unCf :: FixF (Fx f a) }

-- Cofree が関手に成るための宣言
instance Functor f => Functor (Cofree f) where
  fmap f = Cf . ana (phi . outF) . unCf where
    phi (FCons a b) = FCons (f a) b

-- ノードの付加情報を取り出す
extract :: Functor f => Cofree f a -> a
extract cf = case (outF $ unCf cf) of
  FCons a _ -> a

-- ノードを取り出す
sub :: Functor f => Cofree f a -> f (Cofree f a)
sub cf = case (outF $ unCf cf) of
  FCons _ b -> fmap Cf b

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 x -> x) -> (y -> f y) -> (y -> x)
hylo phi psi = cata phi . ana psi

dyna :: Functor f => (f (Cofree f x) -> x) -> (y -> f y) -> (y -> x)
dyna phi psi = extract . hylo ap psi where
  ap a = Cf $ InF $ FCons (phi a) (fmap unCf a)


-- psi によって作られる中間データ構造、(Int, Int) のフィールドを持ち、dp[i][j] のインデックス i,j を表現している。
data KSTree a = KSTree (Int, Int) (Maybe a)
instance Functor KSTree where
  fmap f (KSTree a Nothing)  = KSTree a Nothing
  fmap f (KSTree a (Just b)) = KSTree a (Just (f b))

knapsack :: Int -> Int -> [(Int,Int)] -> Int
knapsack n c wvs = dyna phi psi $ (n,c) where
  wva = listArray (0, n-1) wvs

  psi (0,0) = KSTree (n,0) Nothing
  psi (0,j) = KSTree (n,j) (Just (n, j-1))
  psi (i,j) = KSTree (n-i,j) (Just (i-1, j))

  phi (KSTree _ Nothing) = 0
  phi (KSTree (i,j) (Just cs))
    | i == n      = 0
    | w <= j = max x1 x2
    | otherwise   = x1
    where
      (w, v) = wva ! i
      x1 = back 1 cs
      x2 = v + (back (1 + (n + 1) * w) cs)

  {- 過去の結果を遡って参照するための関数 -}
  back 1 cs = extract cs
  back i cs = case sub cs of
    (KSTree _ (Just b)) -> back (i - 1) b

getIntList = DL.unfoldr (BS.readInt .  BS.dropWhile DC.isSpace) <$> BS.getLine

main :: IO ()
main = do
  [n,maxW] <- getIntList
  items <- CM.replicateM n $ do
    [w,v] <- getIntList
    return (w,v)
  print $ knapsack n maxW items

提出情報

コンパイルエラー

Loaded package environment from /home/contestant/.ghc/x86_64-linux-8.8.3/environments/default

ジャッジ結果