{-# 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