{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
import           Data.Maybe
import           Data.Int
import           Data.List hiding (insert)
import           Data.Char
-- import qualified Data.Vector.Unboxing as VU
import qualified Data.Array.IO as A
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import           Data.List (scanl')
import           Data.IORef
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Control.Applicative
import           Debug.Trace
import           Text.Printf


readInt = BS.readInt . BS.dropWhile isSpace
getVector f = VU.unfoldr f <$> BS.getLine
getIntVector = getVector readInt
getBSVector = getVector BS.uncons
getInt = readLn :: IO Int
getInt2Tuple = (\vec -> (vec VU.! 0, vec VU.! 1)) <$> getIntVector
getInt3Tuple = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) <$> getIntVector


main = do
  (n,m) <- getInt2Tuple
  as <- fromList =<< map read . words <$> getLine :: IO (Heap Int)
  forM_ [1..m] $ \_ ->
    oneOperatin as
  print . VU.sum =<< heapToVector as
  -- print 1

heapToVector :: Heap Int -> IO (VU.Vector Int)
heapToVector (Heap _ _ vec) = VU.freeze vec

solveHelp as = VU.modify (\vec -> VUM.modify vec (\n -> n `div` 2) maxIndex) as
  where
    maxIndex = VU.maxIndex as

oneOperatin :: Heap Int -> IO ()
oneOperatin as = do
  maxA <- deleteMax as
  let newA = maxA `div` 2
  insert as newA



compItemVec buff i j = liftM2 (compare) (VUM.read buff i) (VUM.read buff j)
swapItemVec buff i j = do
  VUM.swap buff i j

upHeapMaxVec buff n = upHeapVec buff n LT

upHeapVec buff n ordering = do
  when (n > 0) $ do
    let p = (n - 1) `div` 2
    t <- compItemVec buff p n
    when (t == ordering) $ do
      swapItemVec buff p n
      upHeapVec buff p ordering

downMaxHeapVec buff n h = downHeapVec buff n h LT

downHeapVec buff n h ordering = iter n h
  where
    selectChild c1 h = do
      let c2 = c1 + 1
      if c2 > h
        then return c1
        else do
        t <- compItemVec buff c1 c2
        if t == ordering
          then return c2
          else return c1
    iter n h = do
      let c1 = 2*n + 1
      when (c1 <= h) $ do
        c <- selectChild c1 h
        t <- compItemVec buff n c
        when (t == ordering) $ do
          swapItemVec buff n c
          iter c h


data Heap a = Heap Int (VUM.IOVector Int) (VUM.IOVector Int)

makeHeapVec :: Int -> IO (Heap Int)
makeHeapVec n = do
  a <- VUM.new n
  b <- VUM.replicate 1 0
  return (Heap n b a)

fromList :: [Int] -> IO (Heap Int)
fromList xs = do
  let n = length xs
      m = n `div` 2 - 1
  a <- VU.thaw $ VU.fromList xs
  b <- VUM.replicate 1 n
  mapM_ (\x -> downMaxHeapVec a x (n - 1)) [m,m-1..0]
  return (Heap n b a)

insert :: Heap Int -> Int -> IO ()
insert (Heap size cnt buff) x = do
  c <- VUM.read cnt 0
  if c >= size
    then error "Full Heap"
    else do
    VUM.write buff c x
    VUM.modify cnt (\n -> n+1) 0
    upHeapMaxVec buff c


deleteMin = undefined
deleteMax :: Heap Int -> IO Int
deleteMax (Heap _ cnt buff) = do
  c <- VUM.read cnt 0
  if c <= 0
    then error "Empty Heap"
    else do
    x <- VUM.read buff 0
    let c1 = c - 1
    VUM.write cnt 0 c1
    when (c1 > 0) $ do
      swapItemVec buff 0 c1
      downMaxHeapVec buff 0 (c1 - 1)
    return x
findMin = undefined
findMax = undefined
isEmpty = undefined
isFull = undefined

testVec = do
  a <- VU.thaw $ VU.fromList [5,6,4,7,3,8,2,9,1,0] :: IO (VUM.IOVector Int)
  mapM_ (\x -> downMaxHeapVec a x 9) $ reverse [0..4]
  b <- makeHeapVec 8 :: IO (Heap Int)
  mapM_ (insert b) [7,6..0]
  print =<< deleteMax b
  print =<< deleteMax b
  print =<< deleteMax b
  print =<< deleteMax b



-- compItem buff i j = liftM2 (compare) (A.readArray buff i) (A.readArray buff j)

-- swapItem buff i j = do
--   a <- A.readArray buff i
--   b <- A.readArray buff j
--   A.writeArray buff i b
--   A.writeArray buff j a

-- upheap buff n = heap GT buff n

-- heap ordering buff n = do
--   when (n > 0) $ do
--     let p = (n-1) `div` 2
--     t <- compItem buff p n
--     when (t == ordering) $ do
--       swapItem buff p n
--       heap ordering buff p

-- downheap buff n h = iter n h
--   where
--     selectChild c1 h = do
--       let c2 = c1 + 1
--       if c2 > h
--         then return c1
--         else do
--         t <- compItem buff c1 c2
--         if t == GT
--           then return c2
--           else return c1
--     iter n h = do
--       let c1 = 2 * n + 1
--       when (c1 <= h) $ do
--         c <- selectChild c1 h
--         t <- compItem buff n c
--         when (t == GT) $ do
--           swapItem buff n c
--           iter c h

-- test = do
--   a <- A.newListArray (0,9) [5,6,4,7,3,8,2,9,1,0] :: IO (A.IOArray Int Int)
--   mapM_ (upheap a) [1..9]
--   print =<< A.getElems a



Measured memory_bytes: 38268