Problem:
Score: 200 points

Problem Statement

M-kun has the following three cards:

A red card with the integer A.

A green card with the integer B.

A blue card with the integer C.

He is a genius magician who can do the following operation at most K times:

Choose one of the three cards and multiply the written integer by 2.

His magic is successful if both of the following conditions are satisfied after the operations:

The integer on the green card is strictly greater than the integer on the red card.

The integer on the blue card is strictly greater than the integer on the green card.

Determine whether the magic can be successful.

Constraints

1 \leq A, B, C \leq 7

1 \leq K \leq 7

All values in input are integers.

Input

Input is given from Standard Input in the following format:

A B C
K

Output

If the magic can be successful, print Yes; otherwise, print No.

Sample Input 1

7 2 5
3

Sample Output 1

Yes

The magic will be successful if, for example, he does the following operations:

First, choose the blue card. The integers on the red, green, and blue cards are now 7, 2, and 10, respectively.

Second, choose the green card. The integers on the red, green, and blue cards are now 7, 4, and 10, respectively.

Third, choose the green card. The integers on the red, green, and blue cards are now 7, 8, and 10, respectively.

Sample Input 2

7 4 2
3

Sample Output 2

No

He has no way to succeed in the magic with at most three operations.

Solution in Haskell (GHC 8.8.3) (judge verdict: Accepted)

{-# LANGUAGE MultiWayIf #-}

module Main where

import Control.Monad
import qualified Data.Array as A
import qualified Data.Array.IO as AIO
import qualified Data.Array.Unboxed as AU
--import qualified Data.Heap                     as H

import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC8
import Data.Char
import qualified Data.Graph.Inductive.Graph as G
import qualified Data.Graph.Inductive.PatriciaTree as G
import Data.Int
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Data.Ord
import qualified Data.Sequence as SQ
import qualified Data.Set as S
import qualified Data.Vector as V
import Data.Vector.Algorithms.Search
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Debug.Trace
import Prelude

main = do
  --aN       <- getI
  --[aA, aB] <- getIL
  --aS       <- getLine
  [aA, aB, aC] <- getIL
  aK <- getI
  let aaa = xxx aA aB
  let (ccc, aK2) = ((2 ^ aaa * aB), aK - aaa)
  let ddd = xxx ccc aC
  let (fff, ak3) = ((2 ^ ddd * aC), aK2 - ddd)
  if ak3 >= 0
    then putStrLn "Yes"
    else
      putStrLn
        "No"
  return 0

xxx a b = if a < b then 0 else 1 + xxx a (b * 2)

{-
hMaxPoint :: Int
hMaxPoint = 101
hMaximum :: H.Heap Int -> Int
hMaximum h = hMaxPoint - (H.minimum h)
hInsertMax :: Int -> H.Heap Int -> H.Heap Int
hInsertMax x = H.insert (hMaxPoint - x)
hDeleteMax :: H.Heap Int -> H.Heap Int
hDeleteMax = H.deleteMin
-}

{-
aroundSquare y x h w =
  [ aYX
  | aYX@(aY, aX) <- [(y - 1, x), (y, x - 1), (y + 1, x), (y, x + 1), (y, x)]
  , aY >= 0
  , aY <= (h - 1)
  , aX >= 0
  , aX <= (w - 1)
  ]
-}

splitReadBSC8 :: BSC8.ByteString -> [Int]
splitReadBSC8 bs =
  let (bs1, newBs) = BSC8.splitAt 1 bs
   in if newBs == BSC8.empty
        then [test $ BSC8.readInt bs1]
        else (test $ BSC8.readInt bs1) : (splitReadBSC8 newBs)
  where
    test (Just (i, _)) = i

read2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> IO Char
read2DimChar vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x

write2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> Char -> IO ()
write2DimChar vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

readTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> IO Int
readTwoDimVec vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x

writeTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> Int -> IO ()
writeTwoDimVec vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

getVUI :: IO (VU.Vector Int)
getVUI = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

getRepVUI :: Int -> IO (VU.Vector Int)
getRepVUI n =
  VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace)
    . BSC8.unlines
    <$> replicateM n BSC8.getLine

getVS :: IO (V.Vector Char)
getVS = V.fromList <$> getLine

getVUC :: IO (VU.Vector Char)
getVUC = VU.fromList <$> getLine

readI :: BSC8.ByteString -> Int
readI = fst . fromJust . BSC8.readInt

readIL :: BSC8.ByteString -> [Int]
readIL = map readI . BSC8.words

readIT2 :: BSC8.ByteString -> (Int, Int)
readIT2 bs =
  let words = BSC8.words bs in (readI $ head words, readI $ last words)

getI :: IO Int
getI = readI <$> BSC8.getLine

getIL :: IO [Int]
getIL = readIL <$> BSC8.getLine

getIT2 :: IO (Int, Int)
getIT2 = readIT2 <$> BSC8.getLine

getIT2Order :: IO (Int, Int)
getIT2Order =
  getIL
    >>= \x@[xz, xo] -> if xz > xo then return (xo, xz) else return (xz, xo)

getNIS :: Int -> IO [(Int, BSC8.ByteString)]
getNIS 0 = return []
getNIS n = do
  [aFst, aSnd] <- BSC8.words <$> BSC8.getLine
  next <- getNIS (n - 1)
  return ((readI aFst, aSnd) : next)

il2Words :: [Int] -> String
il2Words = unwords . map show

il2Lines :: [Int] -> String
il2Lines = unlines . map show

p :: Int -> Int
p x = x - 1

--modNum = 10 ^ 9 + 7
--modulus = 1000000007
modulus = 2019

newtype MInt = M Int

instance Num MInt where
  (M a) + (M b) = M $ mod (a + b) modulus

  (M a) - (M b) = M $ mod (a - b) modulus

  (M a) * (M b) = M $ mod (a * b) modulus

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = M $ abs a

  signum (M a) = M $ signum a

instance Show MInt where
  show (M a) = show (mod a modulus)

int2MInt :: Int -> MInt
int2MInt a = M (mod a modulus)

mInt2Int :: MInt -> Int
mInt2Int (M a) = a

{-
factsMod :: V.Vector MInt
factsMod = V.scanl (\acc x -> M x * acc) 1 $ V.generate 2000000 (+ 1)

factMod :: Int -> MInt
factMod = (factsMod V.!)
-}

factMod :: Int -> MInt
factMod n
  | n == 0 = 1
  | n == 1 = 1
  | otherwise = M n * (factMod (n - 1))

factDivMod :: Int -> Int -> MInt
factDivMod n k
  | n == k = M 1
  | otherwise = M n * (factDivMod (n - 1) k)

powMod :: MInt -> MInt -> MInt
powMod n mK@(M k)
  | k == 0 = M 1
  | k == 1 = n
  | mod k 2 == 0 = powMod (n ^ 2) (M (div k 2))
  | otherwise = n * powMod (n ^ 2) (M (div k 2))

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x = powMod x (M (modulus - 2))

{-
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | otherwise = factMod n * invMod (factMod (n - k)) * invMod (factMod k)
-}
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | k > n - k = factDivMod n k * invMod (factMod (n - k))
  | otherwise = factDivMod n (n - k) * invMod (factMod k)

combi :: Int -> Int -> Int
combi n k
  | n < 0 || k < 0 || k > n = 0
  | k == n = 1
  | otherwise = div (div (fact n) (fact (n - k))) (fact k)

{-w
primes :: Integral a => [a]
primes = map fromIntegral $ [2, 3] ++ primes'
 where
  primes' = [5] ++ f 1 7 primes'
  f m s (p : ps) = [ n | n <- ns, gcd m n == 1 ] ++ f (m * p) (p * p) ps
    where ns = [ x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4] ]

prime n = primes !! n
primes = sieve [2 ..]
sieve (p : xs) = p : sieve [ x | x <- xs, x `mod` p /= 0 ]
-}
fact :: Int -> Int
fact 0 = 1
fact n | n > 0 = n * fact (n - 1)

knappsackWDP :: Int -> [(Int, Int)] -> VU.Vector Int
knappsackWDP maxW [] = VU.replicate (maxW + 1) 0
knappsackWDP maxW ((w, v) : xs) =
  let tailDP = knappsackWDP maxW xs
   in VU.generate (maxW + 1) $ \i ->
        if w <= i
          then max (tailDP VU.! i) (tailDP VU.! (i - w) + v)
          else tailDP VU.! i

knappsackVDP :: Int -> Int -> Int -> [(Int, Int)] -> VU.Vector Int
knappsackVDP maxW maxV n [] = VU.cons 0 $ VU.replicate (n * maxV) maxW
knappsackVDP maxW maxV n ((w, v) : xs) =
  let tailDP = knappsackVDP maxW maxV n xs
   in VU.generate (n * maxV + 1) $ \i ->
        if v <= i
          then min (tailDP VU.! i) (tailDP VU.! (i - v) + w)
          else tailDP VU.! i

knappsackMinVol ::
  AIO.IOArray (Int, Int) Int ->
  VU.Vector Int ->
  VU.Vector Int ->
  Int ->
  Int ->
  IO Int
knappsackMinVol dp volumeVec valueVec dpSize maxVolume = do
  mapM_
    ( \i ->
        mapM_
          ( \v -> do
              let volume = volumeVec VU.! i
                  value = valueVec VU.! i
              newdp <-
                if (v + value) > dpSize
                  then AIO.readArray dp (i, v)
                  else do
                    dpIVm <- AIO.readArray dp (i, v + value)
                    dpIV <- AIO.readArray dp (i, v)
                    return (min (dpIVm - volume) dpIV)
              AIO.writeArray dp (i + 1, v) newdp
          )
          (reverse [0 .. dpSize])
    )
    [0 .. VU.length valueVec - 1]
  foldM
    ( \acc x -> do
        num <- AIO.readArray dp (VU.length volumeVec, x)
        return $ if num <= maxVolume then x else acc
    )
    0
    [0 .. dpSize]

lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (VU.Vector Int)
lcsTable xs ys = V.scanl step (VU.replicate (m + 1) 0) xs'
  where
    n = BS.length xs
    m = BS.length ys
    xs' = V.generate n $ BSC8.index xs :: V.Vector Char
    ys' = VU.generate m $ BSC8.index ys :: VU.Vector Char
    step :: VU.Vector Int -> Char -> VU.Vector Int
    step v x = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
      where
        innerStep :: Int -> (Int, Int, Char) -> Int
        innerStep a (b, c, y)
          | x == y = 1 + b
          | otherwise = max a c

{-
main = do
xs <- BS.getLine
ys <- BS.getLine
print $ VU.last $ V.last $ lcsTable xs ys
-}

myFilter :: (a -> Bool) -> [a] -> ([a], [a])
myFilter _pred [] = ([], [])
myFilter pred (x : xs)
  | pred x = let (l, r) = myFilter pred xs in (x : l, r)
  | otherwise = let (l, r) = myFilter pred xs in (l, x : r)

--UnionFindデータ構造

type UF_PARENT = VUM.IOVector Int

type UF_RANK = VUM.IOVector Int

type UF = (UF_PARENT, UF_RANK)

uf_makeSet :: Int -> IO UF
uf_makeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank <- VUM.replicate n 0
  return (parent, rank)

uf_union :: UF -> Int -> Int -> IO ()
uf_union unionFind@(parents, ranks) x y = do
  xRoot <- uf_find unionFind x
  yRoot <- uf_find unionFind y

  xRootRank <- VUM.read ranks xRoot
  yRootRank <- VUM.read ranks yRoot
  if
      | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
      | xRootRank < yRootRank -> VUM.write parents xRoot yRoot
      | xRoot /= yRoot -> do
        VUM.write parents yRoot xRoot
        VUM.write ranks xRoot (xRootRank + 1)
      | otherwise -> return ()

uf_find :: UF -> Int -> IO Int
uf_find unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- uf_find unionFind xParent
      VUM.write parents x xRootParent
      return xRootParent

--UnDirectedGraph(無向グラフ)データ構造

type UDG = M.Map Int [Int]

list2UDG :: [(Int, Int)] -> M.Map Int [Int]
list2UDG =
  foldl
    ( \acc x ->
        let lr = M.insertWith (++) (fst x) [snd x] acc
         in M.insertWith (++) (snd x) [fst x] lr
    )
    M.empty