After the lessons n groups of schoolchildren went outside and decided to visit Polycarpus to celebrate his birthday. We know that the i-th group consists of si friends (1 ≤ si ≤ 4), and they want to go to Polycarpus together. They decided to get there by taxi. Each car can carry at most four passengers. What minimum number of cars will the children need if all members of each group should ride in the same taxi (but one taxi can take more than one group)?

The first line contains integer n (1 ≤ n ≤ 105) — the number of groups of schoolchildren. The second line contains a sequence of integers s1, s2, ..., sn (1 ≤ si ≤ 4). The integers are separated by a space, si is the number of children in the i-th group.

Print the single number — the minimum number of taxis necessary to drive all children to Polycarpus.

NoteIn the first test we can sort the children into four cars like this:  the third group (consisting of four children),  the fourth group (consisting of three children),  the fifth group (consisting of three children),  the first and the second group (consisting of one and two children, correspondingly). There are other ways to sort the groups into four cars.

import IO
import Data.List
import Data.Maybe
import Debug.Trace

readMany :: Read a => IO [a]
readMany = fmap (map read . words) getLine

sign :: Int -> Int
sign num
    | num < 0  = -1
    | num == 0 = 0
    | num > 0  = 1

divUp :: Int -> Int -> Int
divUp x y = res
    where div_value = x `div` y
          mod_value = x `mod` y
          res = div_value + sign mod_value

count :: (Int -> Bool) -> [Int] -> Int
count pred = length . filter pred

countCars :: [Int] -> Int

countCars [a, b, c, d] = d + countCars [a, b, c]
countCars [a, b, c] = c + countCars [newA, b]
    where newA = max 0 (a - c)
countCars [a, b] = resB + countCars [newA]
    where newA = max 0 (a - 2 * (b `mod` 2))
          resB = divUp b 2
countCars [a] = divUp a 4

run :: [Int] -> Int
run numbers = countCars [count (==x) numbers | x <- [1..4]]

main = do
    getLine
    numbers <- readMany :: IO [Int]
    putStrLn $ show $ run numbers

import List
c n = length . filter (==n)
f l = let
    c1 = c 1 l;
    c3 = c 3 l;
    c2 = c 2 l
    in c 4 l + div c2 2 + c3 +
        if c3>=c1
           then rem c2 2
           else ((c1-c3+(2*rem c2 2)-1) `div` 4)+1
main = do
    n <- readLn :: IO Int
    res <- fmap (f . map read . words) getLine
    putStr (show res)

import Control.Applicative

main = do
  _ <- getLine
  s <- (map read . words) <$> getLine
  print $ solve s

solve xs = (cnt 4) + (cnt 3) + div (3 + maximum [(cnt 1)-(cnt 3), 0] + 2 * (cnt 2)) 4
  where cnt a = length $ filter (== a) xs

import Control.Applicative

main = do
  _ <- getLine
  s <- (map read . words) <$> getLine
  print $ solve s

--solve xs = (cnt 4) + (cnt 3) + div (3 + maximum [(cnt 1)-(cnt 3), 0] + 2 * (cnt 2)) 4
--  where cnt a = length $ filter (== a) xs

solve xs = (cnt!!3) + (cnt!!2) + div (3 + maximum [(cnt!!0)-(cnt!!2), 0] + 2 * (cnt!!1)) 4
  where cnt = [length $ filter (== a) xs | a <- [1..4]]

f [a, b, c, d] = d + c + (b * 2 + 3 + max 0 (a-c)) `div` 4

main = do
  _ <- getLine
  groups <- fmap (map read . words) getLine
  print $ f $ map (\x -> length $ filter (==x) groups) [1..4]

g l h = take (h - 1) l ++ [l!!(h - 1) + 1] ++ drop h l

f :: Int -> [Int] -> Int
f s [a, b] = s + ceiling ((fromIntegral b * 2 + fromIntegral a) / 4)
f s [a, b, c]
  | c >= a = f (s + c) [0, b]
  | otherwise = f (s + c) [a - c, b]
f s [a, b, c, d] = f (s + d) [a, b, c]

main = do
  _ <- getLine
  groups <- getLine
  print $ f 0 $ foldl g [0, 0, 0, 0] $ map (read::String -> Int) $ words groups

g (a, b, c, d) 1 = (a + 1, b, c, d)
g (a, b, c, d) 2 = (a, b + 1, c, d)
g (a, b, c, d) 3 = (a, b, c + 1, d)
g (a, b, c, d) 4 = (a, b, c, d + 1)

f (a, b, c, d) = d + c + ceiling ((fromIntegral b * 2 + fromIntegral x) / 4)
  where x = if c < a then a - c else 0

main = do
  _ <- getLine
  groups <- getLine
  print $ f $ foldl g (0, 0, 0, 0) $ map (read::String -> Int) $ words groups

g l h = take (h - 1) l ++ [l!!(h - 1) + 1] ++ drop h l

f [a, b, c, d] = d + c + ceiling ((fromIntegral b * 2 + fromIntegral x) / 4)
  where x = if c < a then a - c else 0

main = do
  _ <- getLine
  groups <- getLine
  print $ f $ foldl g [0, 0, 0, 0] $ map (read::String -> Int) $ words groups

g l h = take (h - 1) l ++ [l!!(h - 1) + 1] ++ drop h l

f :: Int -> [Int] -> Int
f s [a, b] = s + ceiling ((fromIntegral(b) * 2 + fromIntegral(a)) / 4)
f s [a, b, c]
  | c >= a = f (s + c) [0, b]
  | otherwise = f (s + c) [a - c, b]
f s [a, b, c, d] = f (s + d) [a, b, c]

main = do
  _ <- getLine
  groups <- getLine
  print $ f 0 $ foldl g [0, 0, 0, 0] $ map (read::String -> Int) $ words groups

g (a, b, c, d) h = case h of
  4 -> (a, b, c, d + 1)
  3 -> (a, b, c + 1, d)
  2 -> (a, b + 1, c, d)
  1 -> (a + 1, b, c, d)

f l = foldl g (0, 0, 0, 0) l

r :: Int -> (Int, Int, Int, Int) -> Int
r s (a, b, 0, 0) = s + ceiling ((fromIntegral(b) * 2 + fromIntegral(a)) / 4)
r s (a, b, c, 0)
  | c >= a = r (s + c) (0, b, 0, 0)
  | otherwise = r (s + c) (a - c, b, 0, 0)
r s (a, b, c, d) = r (s + d) (a, b, c, 0)

main = do
  _ <- getLine
  groups <- getLine

  print $ r 0 (f $ map (read :: String -> Int) $ words groups)

main = readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve2.solve.words. last. take 2.lines
solve xs = splitAt 2 $ map (\ x -> foldr (\ a b ->  case () of _ |(read a)==x  -> 1+b |otherwise  -> b ) 0 xs ) [1..4]
solve2::([Int],[Int])->Int
solve2 ([a,b],[c,d])= (ceiling $ (fromIntegral ((minus0 a c)+2*b)) / 4 )+ c+d
minus0 x y | x-y >=0 = x-y |otherwise = 0

import Data.List (sort)
-- 158B
-- this code kind of sucks

taxi :: [Int] -> Int
taxi ns = solve $ collect ns

solve :: (Int,Int,Int,Int) -> Int
solve (a,b,c,d)
	| d > 0 = 	d + solve(a,b,c,0)
	| c > 0 = 	if (a >= 1)
				then 1 + solve (a-1,b,c-1,d)
				else 1 + solve (a,b,c-1,d)
	| b > 0 = 	if (b >= 2)
				then 1 + solve (a,b-2,c,d)
				else
					case a of
						1 -> 1 + solve (a-1,b-1,c,d)
						0 -> 1 + solve (a,b-1,c,d)
						a -> 1 + solve (a-2,b-1,c,d)
	| a > 0	= ceiling ( (fromIntegral a) / 4 )
	| otherwise = 0

collect :: [Int] -> (Int,Int,Int,Int)
collect ns = foldl accumulate (0,0,0,0) ns

accumulate :: (Int,Int,Int,Int) -> Int -> (Int,Int,Int,Int)
accumulate (a,b,c,d) n
		| n == 1 = (a+1,b,c,d)
		| n == 2 = (a,b+1,c,d)
		| n == 3 = (a,b,c+1,d)
		| n == 4 = (a,b,c,d+1)

readIn :: IO [Int]
readIn = do
    contents <- getContents
    let n:is = lines contents
        x = read $ head $ words n
        xs = take x (map read (words $ head is))
    return xs

main :: IO()
main = do
    i <- readIn
    putStr $ show $ taxi i

-- -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
-- File Name : 0001A.hs
-- Creation Date : 17-10-2012
-- Last Modified : Fri 19 Oct 2012 06:27:10 PM EEST
-- Created By : Greg Liras <gregliras@gmail.com>
--_._._._._._._._._._._._._._._._._._._._._.

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.List (sort)

countBy ls cond= length $ filter cond ls

count ls k = countBy ls (\s -> s == k)

kth ls k = head $ drop k ls
remaining ls k =
    let
        limit = kth (sort ls) k
    in
        countBy ls (\s -> s >= limit && s > 0)

calcrem1s c3s c1s =
    if c3s >= c1s
        then
            0
        else
            c1s-c3s

posORZero num =
    if num >= 0
        then
            num
        else
            0

calc groups =
        let c2s     = count groups 2
            rem1s   = posORZero $ (count groups 1) - (count groups 3)
        in
            let
                rem2s = c2s `mod` 2
            in
                let
                    finalrem1s =
                        if rem2s == 1
                            then
                                posORZero $ rem1s - 2
                            else
                                rem1s
                in
                    (count groups 4) + (count groups 3) + (ceiling $ fromIntegral(c2s) / 2) + (ceiling $ fromIntegral(finalrem1s) / 4)

main :: IO ()
main =
    do
        all <- BS.getContents
        let Just (n, r1)    = readInt all
        let (groups, _)     = readMany readInt r1
        print $ calc groups
    where
        readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany readf s = case readf s of
            Just (x, r) ->  let
                                (xs, t) = readMany readf r
                            in
                                (x : xs, t)
            Nothing     ->  ([], s)

import Data.List
import qualified Data.Map as Map

get :: IO [Int]
get = fmap (map read . words) getLine

solve :: Int -> Int -> Int -> Int -> Int
solve 0  0  0  0  = 0
solve n1 0  0  0  = n1 `div` 4 + (if n1 `mod` 4 /= 0 then 1 else 0)
solve n1 n2 0  0  = n2 `div` 2 + n2 `mod` 2 + solve (if n2 `mod` 2 == 1 then max (n1 - 2) 0 else n1) 0 0 0
solve n1 n2 n3 0  = n3 + solve (max (n1 - n3) 0) n2 0 0
solve n1 n2 n3 n4 = n4 + solve n1 n2 n3 0

main = do
	_ <- get
	temp <- get
	let [n1, n2, n3, n4] = [length $ filter (==x) temp | x <- [1..4]]
	print $ solve n1 n2 n3 n4

{-# LANGUAGE CPP, TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

module Main (
    main
) where

import Control.Monad (unless)
import Data.List (stripPrefix, sort, reverse)
import System.Exit (exitFailure)
import Data.Int
import Data.Maybe
import Data.Sequence as Seq
--import Debug.Trace

#ifdef MAIN_FUNCTION
import Test.Framework.TH
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2

import Test.QuickCheck
import Test.HUnit

import Data.List

#endif

maxCap = 4

maxLessThen :: Seq Int->Int->(Maybe Int, Seq Int)

maxLessThen s x
    | h<=x = (Just h, t)
    | l<=x = (Just l, t')
    | otherwise = (Nothing, s)
    where h  :< t = Seq.viewl s
          t' :> l = Seq.viewr s

count :: [Int]->Int
count l = countSeq $ Seq.fromList $ Data.List.reverse $ Data.List.sort l

countSeq :: Seq Int->Int
countSeq l = count' l maxCap

count' :: Seq Int->Int->Int
--count' l x | trace ("count' " ++ show l ++ " " ++ show x) False = undefined
count' (Seq.viewl -> EmptyL) 4 = 0
count' (Seq.viewl -> EmptyL) _ = 1
count' l x
    | m == Nothing = 1 + count' l maxCap
    | otherwise = count' l' (x - fromJust m)
    where
        (m, l') = maxLessThen l x

exeMain = do
    getLine
    groups <- (map read . words) `fmap` getLine
    print $ count groups

-- Tests --

#ifdef MAIN_FUNCTION
testMain = $(defaultMainGenerator)

case_1 = count [1, 2, 4, 3, 3] @?= 4

case_2 = count [2, 3, 4, 4, 2, 1, 3, 1] @?= 5

case_3 = count [4] @?= 1

case_4 = count [1] @?= 1

case_5 = count [3, 1] @?= 1

case_6 = count [3, 2] @?= 2

#endif

#ifndef MAIN_FUNCTION
#define MAIN_FUNCTION exeMain
#endif
main = MAIN_FUNCTION

import Data.Char

solve :: [Int] -> Int
solve xs =
    let one = count 1 xs
        two = count 2 xs
        three = count 3 xs
        four = count 4 xs
    in four + three + (quot two 2) + (rem two 2) +
        div (one + 3 - (min one (three + 2 * (rem two 2)))) 4
    where count x = length . filter (==x)

main = do
    getLine
    l <- getLine
    print . solve . map read $ words l

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Int] -> Int
solve xs  =  solve' (map (\m -> counts m xs) [1..4])
  where
    counts :: Int -> [Int] -> Int
    counts m xs  =  length (filter (== m) xs)

    solve' :: [Int] -> Int
    solve' [o, w, t, f]
      =  f + t + divUp w 2 + divUp (max 0 (o - t - 2 * mod w 2)) 4
      where
        divUp a b  =  div a b + if mod a b > 0 then 1 else 0

main :: IO ()
main  =  do
    getLine
    Main.reads >>= print . solve

-- Codeforces 158B

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= putStrLn . show . solve . map read . words where
        solve xs = d + c + (b * 2 + 3 + max 0 (a - c)) `div` 4 where
            [a, b, c, d] = map (\x -> length $ filter (== x) xs) [1 .. 4]

import Data.List (sort, group)

readInts :: IO [Int]
readInts = do
    line <- getLine
    let xs = map read . words $ line :: [Int]
    return xs

frequncy :: Ord a => [a] -> [(a, Int)]
frequncy = map (\ys -> (head ys, length ys)) . group . sort

lookupOr :: Eq a => b -> [(a, b)] -> a -> b
lookupOr d xs x = case lookup x xs of
    (Just a) -> a
    Nothing -> d

infixl 7 //
a // b = ceiling $ (fromIntegral a) / b

main = do
    getLine
    xs <- readInts
    let ys = frequncy xs
    let a:b:c:d:_ = map (lookupOr 0 ys) [1..4]
    let r = d + c + (max (a - c) 0 + b * 2) // 4
    print r

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Array.Unboxed
import Data.List (sort)

main = do
  n <- read <$> getLine
  ss <- map read . words <$> getLine
  let ar = listArray (1,n) . sort $ ss :: Array Int Int
  print $ reqCars ar 1 n 0 0

reqCars a !i !j !c !r
  | i > j     = c
  | a!i <= r  = reqCars a (i+1) j c (r-a!i)
  | otherwise = reqCars a i (j-1) (c+1) (4-a!j)

alloc :: [Int] -> Int -> Int -> Int -> Int -> Int
alloc [] o tw th f
  | ((mod tw 2) == 0) = f + th + (ceiling (fromIntegral tw/2)) + (ceiling (fromIntegral o/4))
  | (((mod tw 2) > 0) && (o<3)) = f + th + (ceiling (fromIntegral tw/2))
  | (((mod tw 2) > 0) && (o>2)) = f + th + (ceiling (fromIntegral tw/2)) + (ceiling (fromIntegral (o-2)/4))

alloc (4:xs) o tw th f = alloc xs o tw th (f+1)

alloc (3:xs) o tw th f
  | o>0 = alloc xs (o-1) tw th (f+1)
  | o == 0 = alloc xs o tw (th+1) f

alloc (2:xs) o tw th f
  | tw>0 = alloc xs o (tw-1) th (f+1)
  | tw == 0 = alloc xs o (tw+1) th f

alloc (1:xs) o tw th f
  | th>0 = alloc xs o tw (th-1) (f+1)
  | th == 0 = alloc xs (o+1) tw th f

main = do
  _ <- getLine
  groups <- getLine

  print $
    alloc (
      map (read :: String -> Int) $
      words groups
    ) 0 0 0 0

main = do
	n <- getLine
	args <- getList ' '
	putStrLn . show . calc . parseGroups $ args

getList::Char -> IO [String]
getList sep = do
	input <- getLine
	return $ split input sep

split::String -> Char -> [String]
split str sep = foldr (\curr acc -> if curr == sep then "":acc
									else (curr:(head acc)):(tail acc) ) [""] str

calc::[Int] -> Int
calc groups = do
	let fours = groups !! 3
	let threes = groups !! 2
	let twos = ceiling . (/ 2) . fromIntegral $ groups !! 1
	let ones = ceiling . (/ 4) . fromIntegral $ groups !! 0 - threes - (groups !! 1 `mod` 2 * 2)
	fours + threes + twos + if ones > 0 then ones else 0

parseGroups::[String] -> [Int]
parseGroups args = foldr (\curr acc -> if curr == "1" then [ acc !! 0 + 1, acc !! 1, acc !! 2, acc !! 3 ]
									 else if curr == "2" then [ acc !! 0, acc !! 1 + 1, acc !! 2, acc !! 3 ]
									 else if curr == "3" then [ acc !! 0, acc !! 1, acc !! 2 + 1, acc !! 3 ]
									 else [ acc !! 0, acc !! 1, acc !! 2, acc !! 3 + 1 ]) [0,0,0,0] args

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: [Int] -> Int
solve a = g4 + g3 + (g2 + 1) `div` 2 + max 0 (g1 - g3 - g2 `mod` 2 * 2 + 3) `div` 4
    where cnt = accumArray (+) 0 (1,4) $ zip a (repeat 1)
          g4 = cnt ! 4
          g3 = cnt ! 3
          g2 = cnt ! 2
          g1 = cnt ! 1

main :: IO ()
main = do
        _ <- getLine -- n
        a <- getIntList
        putStrLn . show $ solve a

-- import Data.Char
-- import Data.Int
-- import Data.List
-- import Control.Monad
getList :: Read a => IO [a]
getList = fmap (map read . words) getLine

solve :: [Int] -> Int
solve a = g4 + g3 + (g2 + 1) `div` 2 + max 0 (g1 - g3 - g2 `mod` 2 * 2 + 3) `div` 4
    where g4 = length . filter (== 4) $ a :: Int
          g3 = length . filter (== 3) $ a :: Int
          g2 = length . filter (== 2) $ a :: Int
          g1 = length . filter (== 1) $ a :: Int

main :: IO ()
main = do
        _ <- readLn :: IO Int
        a <- getList :: IO [Int]
        putStrLn . show $ solve a

solve [a, b, c, d] = d + c + (b * 2 + 3 + max 0 (a-c)) `div` 4

main = do
  _ <- getLine
  groups <- fmap(map read.words) getLine
  print $ solve $ map(\x -> length $ filter (==x) groups ) [1..4]

main = do
    num<-getLine
    s<-fmap(map read.words)getLine
    let [a,b,c,d] = map (\x -> length $ filter (==x) s ) [1..4]
    print $ d+c+(b*2+3+max 0 ( a-c))`div`4

import Data.List
import Data.Char
import Control.Applicative
import Data.Array

process a b | a<b = "-1"
            |a>b = "1"
            | otherwise = "0"

main::IO ()
main=do
    getLine
    a<-map read <$> words <$> getLine
    let b =accumArray (+) 0 (1,4) (zip a (repeat 1))
    let [c1,c2,c3,c4]= elems b
    let nc1 =  (max 0 (c1-c3-(if odd c2 then 2 else 0)))
    let nc2 = div nc1 4
    let nc3 = if mod nc1 4 ==0 then 0 else 1
    print $ c4 + c3 + (div c2 2) + (if (odd c2) then 1 else 0) + nc2 +nc3

module Main where

import Control.Arrow
import Control.Applicative

main = do
  n:ss <- (`fmap` getContents) $ words >>> map read
  let n1:n2:n3:n4:_ = map ((==) >>> (`filter` ss) >>> length) [1..]
  print $ n4 + n3 + (n2*2 + 3 + max 0 (n1-n3)) `div` 4

module Main where

import Control.Arrow
import Control.Applicative

import Data.ByteString.Char8 (getContents,words,readInt)
import Prelude hiding(getContents,words)
import Data.Maybe

main = do
  n:ss <- (`fmap` getContents) $ words >>> map (readInt >>> fromJust >>> fst)
  let n1:n2:n3:n4:_ = map ((==) >>> (`filter` ss) >>> length) [1..]
  print $ n4 + n3 + (n2*2 + 3 + max 0 (n1-n3)) `div` 4

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    s <- accumArray (+) 0 (1, 4) . flip zip (repeat 1) <$> replicateM n readInt :: State ByteString (UArray Int Int)
    return (elems s)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve [one, two, three, four] = four + three + solve2 (one - min three one) two

solve2 one two | two >= 2 = solve2 one (two `mod` 2) + two `div` 2
solve2 one 1 = solve2 (one - min one 2) 0 + 1
solve2 one 0 = (one + 3) `div` 4

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= print . solve . map (fst . fromJust . B.readInt) . B.words . (!!1) . B.lines

solve :: [Int] -> Int
solve = go . count (0, 0, 0, 0)
  where go (0, 0, 0, n) = (n + 3) `div` 4
        go (0, 0, n, k) = (n + 1) `div` 2 + go (0, 0, 0, max 0 (k - 2 * (n `mod` 2)))
        go (0, n, k, l) = n + go (0, 0, k, max 0 (l - n))
        go (n, k, l, m) = n + go (0, k, l, m)
        count (a, b, c, d) (4:ss) = count (a + 1, b, c, d) ss
        count (a, b, c, d) (3:ss) = count (a, b + 1, c, d) ss
        count (a, b, c, d) (2:ss) = count (a, b, c + 1, d) ss
        count (a, b, c, d) (1:ss) = count (a, b, c, d + 1) ss
        count x _ = x

{-# options_ghc -O2 #-}

import Prelude hiding (readList)
import Control.Monad
import Data.List

readList :: Read a => IO [a]
readList = fmap (fmap read . words) getLine

readList' :: Read a => a -> IO [a]
readList' _ = readList

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

countFreqs :: (Int,Int,Int,Int) -> Int -> (Int,Int,Int,Int)
countFreqs (a,b,c,d) 1 = (a+1,b,c,d)
countFreqs (a,b,c,d) 2 = (a,b+1,c,d)
countFreqs (a,b,c,d) 3 = (a,b,c+1,d)
countFreqs (a,b,c,d) 4 = (a,b,c,d+1)

main :: IO ()
main = do
  skipLine
  xs <- readList' (undefined::Int)
  let (n1,n2,n3,n4) = foldl' countFreqs (0,0,0,0) xs
      n1' = n1 - min n1 n3
      n1'' | odd n2    = max 0 (n1' - 2)
           | otherwise = n1'
  print $ n4 + n3 + (n2 `divUp` 2) + (n1'' `divUp` 4)

{-# options_ghc -O2 #-}

import Prelude hiding (readList)
import Control.Monad

readList :: Read a => IO [a]
readList = fmap (fmap read . words) getLine

readList' :: Read a => a -> IO [a]
readList' _ = readList

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

main :: IO ()
main = do
  skipLine
  xs <- readList' (undefined::Int)
  let n1 = count (==1) xs
      n2 = count (==2) xs
      n3 = count (==3) xs
      n4 = count (==4) xs
      n1' = n1 - min n1 n3
      n1'' | odd n2    = max 0 (n1' - 2)
           | otherwise = n1'
  print $ n4 + n3 + (n2 `divUp` 2) + (n1'' `divUp` 4)

import Data.List(foldl')

solve :: [Int] -> Int
solve xs = c4 + c3 + c2 `div` 2 + countRest c1 c2 c3 c4
           where
            (c1, c2, c3, c4) = foldl' (\acc x -> countNumbers acc x) (0,0,0,0) xs
            countNumbers (a1, a2, a3, a4) x | x == 1 = (a1 + 1, a2, a3, a4)
                                            | x == 2 = (a1, a2 + 1, a3, a4)
                                            | x == 3 = (a1, a2, a3 + 1, a4)
                                            | x == 4 = (a1, a2, a3, a4 + 1)
            countRest a1 a2 a3 a4 = let a1With3 = min a1 a3
                                        a1AfterSittingWith3 = a1 - a1With3
                                        a1With2 = if (a2 `mod` 2 == 1 && a1AfterSittingWith3 > 0) then min a1AfterSittingWith3 2 else 0
                                        a1AfterSittingWith2 = a1AfterSittingWith3 - a1With2
                                        a1With1 = a1AfterSittingWith2 - a1AfterSittingWith2 `mod` 4
                                        a1AfterSittingWith1 = a1AfterSittingWith2 - a1With1
                                    in a1With1 `div` 4 + (if (a1AfterSittingWith1 > 0) then 1 else 0) + (if (a2 `mod` 2 == 1) then 1 else 0)

main = do
    getLine
    xs <- fmap (map read . words) getLine
    print $ solve xs

taxi :: [Int] -> Int
taxi s = t4 + t31 + t3 + t2 + t21 + t1
  where t4 = count 4 s
        t31 = min c3 c1
        t3 = c3 - t31
        t2 = div c2 2
        t21 = rem c2 2
        t1 = (div (r1 - 1) 4) + 1
        r1 = max (c1 - t31 - t21 * 2) 0
        c1 = count 1 s
        c2 = count 2 s
        c3 = count 3 s
        count x = length . filter (==x)

main = do
  getLine
  s <- getLine
  print $ taxi $ map read $ words s

main = print . solve . map read . tail . words =<< getContents
solve ss = n4 + n3 + n2 `div` 2 + (if odd n2 then 1 else 0) + (n1'' + 3) `div` 4
    where n1 = length (filter (==1) ss)
          n2 = length (filter (==2) ss)
          n3 = length (filter (==3) ss)
          n4 = length (filter (==4) ss)
          n1' = max (n1 - n3) 0
          n1'' = if odd n2 then max (n1' - 2) 0 else n1'

count :: [Int] -> [Int]
count [] = [0, 0, 0, 0]
count (x:xs) = take (x-1) a ++ [ (a !! (x-1) ) + 1] ++ drop x a where a = count xs

solve' :: [Int] -> Int
solve' [x, y, z, w]
    | w>0 = solve' [x, y, z, w-1] + 1
    | (z>0) = solve' [max 0 x-1, y, z-1, w] +1
    | y>1 = solve' [x, y-2, z, w] +1
    | y==1 = solve' [max 0 x-2, y-1, z, w]+1
    | x>0 = solve' [max 0 x-4, y, z, w] +1
    | otherwise = 0

solve' _ = 0

solve :: [Int] -> Int
solve = solve' . count

readInt :: String -> Int
readInt = read

parse :: String -> String
parse x = show $ solve $ tail $ map readInt $ words x
main = interact parse

enc :: [Int] -> Int -> Int
enc s a = length $ filter (==a) s

taxis :: [Int] -> Int
taxis s = fours + threesOnes + twosTwos + onesTwos + leftOnes2 + fourOnes + (threes - threesOnes)
  where ones = enc s 1
        twos = enc s 2
        threes = enc s 3
        fours = enc s 4
        threesOnes = min ones threes
        twosTwos = twos `div` 2
        onesTwos = twos `mod` 2
        leftOnes = if onesTwos == 0 then (ones - threesOnes)
                   else if (ones - threesOnes) > 2 then (ones - threesOnes - 2)
                   else 0
        fourOnes = leftOnes `div` 4
        leftOnes2 = if leftOnes `mod` 4 > 0 then 1 else 0

main = do getLine
          numbers <- fmap (map read . words) getLine
          (putStrLn . show . taxis) numbers

module Main where

main = interact parse

parse :: String -> String
parse input = show $ work $ map read $ tail $ words $ input

countOf :: Int -> [Int] -> Int
countOf num list = length $ filter (== num) list

positive :: Int -> Int
positive i = if i > 0 then i else 0

work :: [Int] -> Int
work list = solve (countOf 1 list) (countOf 2 list) (countOf 3 list) (countOf 4 list)

solve :: Int -> Int -> Int -> Int -> Int
solve c1 c2 c3 c4 = c4 + div c2 2 + min c1 c3 + p31 + div p13 4 + if mod c2 2 == 0 then
																		if mod p13 4 == 0 then 0 else 1
																		else if mod p13 4 == 3 then 2 else 1
																		where
		p31 = positive (c3 - c1)
		p13 = positive (c1 - c3)

main = do
    _ <- getLine
    line <- getLine
    let groups = (map read . words) line :: [Int]
    putStrLn (show $ minCars groups)

minCars :: [Int] -> Int
minCars nums = let
    ofNum n = length . filter (n==) $ nums
    amounts = map ofNum [0..4]
    cars' = (amounts !! 4) + (amounts !! 3) + div (1 + amounts !! 2) 2
    free1s = (amounts !! 3) + 2 * (mod (amounts !! 2) 2)
    in if free1s >= (amounts !! 1) then cars'
    else cars' + div (3 - free1s + amounts !! 1) 4

module Main where

type Counts = (Int, Int, Int, Int)

countChildren :: Counts -> [Int] -> Counts
countChildren c [] = c
countChildren (on, tw, th, fo) (x: xs)
  | x == 1 = countChildren (on + 1, tw, th, fo) xs
  | x == 2 = countChildren (on, tw + 1, th, fo) xs
  | x == 3 = countChildren (on, tw, th + 1, fo) xs
  | x == 4 = countChildren (on, tw, th, fo + 1) xs
  | otherwise = (on, tw, th, fo)

main :: IO ()
main = do
  _ <- fmap read getLine :: IO Int
  inp <- fmap words getLine :: IO [String]
  let s = fmap read inp :: [Int]
      (ones, twos, threes, fours) = countChildren (0, 0, 0, 0) s
      (coupleTwos, loneTwos) = twos `quotRem` 2
      remOnesAfterThrees = max (ones - threes) 0
      (foursOnes, leftOnes) = remOnesAfterThrees `quotRem` 4
      (remCabs, remChild) = (loneTwos * 2 + leftOnes) `quotRem` 4
      res1 = fours +                     -- fours take a cab to themselves
        min ones threes +                -- combine threes and ones to one cab
        max (threes - ones) 0 +          -- remaining threes each take one cab
        coupleTwos +                     -- twos can combine with themselves
        foursOnes +                      -- group remaining ones into 4 per cab
        remCabs +                        -- fit any remaining twos and ones in a cab
        if remChild > 0 then 1 else 0    -- any children left can fit in last 1 cab

  print res1

-- Vicfred
-- https://codeforces.com/problemset/problem/158/B

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: [Int] -> Int
solve a = g4 + g3 + (g2 + 1) `div` 2 + max 0 (g1 - g3 - g2 `mod` 2 * 2 + 3) `div` 4
    where cnt = accumArray (+) 0 (1,4) $ zip a (repeat 1)
          g4 = cnt ! 4
          g3 = cnt ! 3
          g2 = cnt ! 2
          g1 = cnt ! 1

main :: IO ()
main = do
        _ <- getLine -- n
        a <- getIntList
        putStrLn . show $ solve a

count x = length . filter (x==)

divUp x y = div (x + y - 1) y

solve a = fours + threes + divUp ((max (ones - threes) 0) + twos * 2) 4
  where
    ones   = count 1 a
    twos   = count 2 a
    threes = count 3 a
    fours  = count 4 a

main =  print . solve . map read . words . last . lines =<< getContents

hist l = map (\x -> length $ filter (== x) l ) [1..4]
solve [a,b,c,d] = d + c + (2 * b + 3 + (max 0 (a - c))) `div` 4
main = interact $ show . solve . hist . map read . tail . words

main = do
  irrelevant <- getLine
  input <- getLine
  let list = map read (words input)
  let (a,b,c,d) = (countN list 1, countN list 2, countN list 3, countN list 4)
  let b2 = b `div` 2
  let c2 = if c>=a then c else c + (a-c) `div` 4
  let a2 | a>c && (a-c) `mod` 4 == 3 && odd b  = 2
         | a>c && (a-c) `mod` 4 == 3 && even b = 1
         | a>c && (a-c) `mod` 4 == 2 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 2 && even b = 1
         | a>c && (a-c) `mod` 4 == 1 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 1 && even b = 1
         | a>c && (a-c) `mod` 4 == 0 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 0 && even b = 0
         | odd b                               = 1
         | otherwise                           = 0
  let answer = d + b2 + c2 + a2
  putStrLn (show answer)

countN xs n = length (filter (\x -> x==n) xs)

module Main where
import Control.Applicative

main :: IO ()
main = do
    _ <- getLine
    xs <- map read . words <$> getLine
    putStrLn $ show . solve $ xs

solve :: [Int] -> Int
solve xs = cnt!!3 + cnt!!2 + (div (cnt!!1) 2) + rest (maximum[cnt!!0 - cnt!!2, 0], cnt!!1)
    where cnt = [length $ filter (==x) xs | x <- [1..4]]

rest :: (Int, Int) -> Int
rest (one, two)
    | two `mod` 2 == 1 = (div (one + 1) 4) + 1
    | otherwise = div (one + 3) 4

import Data.List

calc :: [Int] -> Int
calc xs = d + c + b' + a''
  where [a,b,c,d] = map (pred . length) . group . sort $ xs ++ [1,2,3,4]
        a' = max (a-c) 0
        (b',r) = b `divMod` 2
        a'' = (a' + r * 2 + 3 ) `div` 4
main = getLine >> getLine >>=
  putStrLn . show . calc . map read . words

main = do
        _ <- getLine
        l <- getLine
        putStrLn $ show $ solve $ map read $ words l

-- solve :: [Int] -> Int
-- solve gs = gof 4 gs + gof 3 gs + gof_2 + gof_1
            -- where
                -- gof_2 = let r = gof 2 gs in r `quot` 2 + r `rem` 2
                -- gof_1
                    -- | gof_3_1 < 0   = 0
                    -- | gof_3_2_1 < 0 = 0
                    -- | otherwise     = gof_3_2_1 `quot` 4 + (if gof_3_2_1 `rem` 4 > 0 then 1 else 0)
                      -- where gof_3_1   = gof 1 gs - gof 3 gs
                            -- gof_3_2_1 = gof_3_1 - (if odd gof 2 gs then 2 else 0)

count :: Int -> [Int] -> Int
count x xs = length $ filter (==x) xs

solve :: [Int] -> Int
solve xs = n_4 + n_3 + n_2 + n_1
            where n_4 = count 4 xs
                  n_3 = count 3 xs
                  n_2 = ceiling $ (fromIntegral $ count 2 xs) / 2.0 -- groups of 2 people fit into one more than the # of groupd div 2
                  leftover = (count 1 xs) - n_3 - ((count 2 xs) `mod` 2 * 2) -- get the number of single person groups left over after filling up the 3-cars and the odd 2 person car
                  n_1 =  if leftover > 0 then ceiling $ (fromIntegral leftover) / 4.0 else 0

main = do
  getLine
  gr <-getLine
  let
    groups = map read $ words gr
    n1 = length $ filter (==1) groups
    n2 = length $ filter (==2) groups
    n3 = length $ filter (==3) groups
    n4 = length $ filter (==4) groups
    n21 = (n2 + 1)`div`2
    n11 = if (n2 `mod` 2 /= 0) then
        n1 - n3 - 2
      else
        n1 - n3
    n12 = if (n11 > 0) then
        (n11+3) `div` 4
      else
        0
  putStrLn $ show (n4 + n3 + n21 + n12)

module Main where

--71A
--replicateM n x = sequence (replicate n x)

--processWord :: String -> String
--processWord word | length word > 10 = (head word) : (show (length word - 2)) ++ ((last word):[])--(word !! ((length word) - 1))
--                 | otherwise = word

--main = sequence [putStrLn $ show i | i <- [1..5]]
--main = getLine >>= \line -> replicateM (read line) (getLine) >>= \list -> sequence [putStrLn (processWord (list!!i)) | i <- [0..(length list) - 1]]

--118A
--import Data.Char
--isSylable :: Char -> Bool
--isSylable char = elem char "AOYEUIaoyeui"
--
--deleteSylabls::[Char] -> [Char]
--deleteSylabls [] = []
--deleteSylabls (x:xs) | isSylable x = deleteSylabls xs
--                     | otherwise = x:(deleteSylabls xs)
--
--addDots :: [Char] -> [Char]
--addDots [] = []
--addDots (x:xs) = '.' : x : (addDots xs)
--
--processWord :: String -> String
--processWord = addDots . deleteSylabls . (map toLower)
--
--main = getLine >>= putStrLn . processWord

--50A

--split :: Char -> String -> [String]
--split _ [] = [""]
--split c (x:xs) | x == c = "" : rest
--               | otherwise = (x : head rest): tail rest
--                where rest = split c xs
--
--calc :: Int -> Int -> Int
--calc  m n = m*n `div` 2
--
--main = getLine >>= \a -> let inp = (map read (split  ' ' a)) in putStrLn $ show $ calc (inp !! 0) (inp !! 1)

--231A

--split :: Char -> String -> [String]
--split _ [] = [""]
--split c (x:xs) | x == c = "" : rest
--               | otherwise = (x : head rest): tail rest
--                where rest = split c xs
--
--isGood :: [Int] -> Int
--isGood (a:b:c:[]) = if (a+b+c >= 2) then 1 else 0
--
--toIntList :: [[String]] -> [[Int]]
--toIntList strs = map (map read) strs
--
--main = getLine >>= \line -> sequence (replicate (read line) getLine) >>= \list -> putStrLn $ show $ sum $ map isGood (toIntList (map (split ' ') list))

--B158

split :: Char -> String -> [String]
split _ [] = [""]
split c (x:xs) | x == c = "" : rest
               | otherwise = (x : head rest): tail rest
                where rest = split c xs

countEntries :: [Int] -> Int -> Int
countEntries [] _ = 0
countEntries (x:xs) val | x == val = 1 + rest
                        | otherwise = rest
                            where rest = (countEntries xs val)

findSol :: [Int] -> Int
findSol groups = let
                    gr = countEntries groups
                    fours = gr 4
                    threes = gr 3
                    twos = gr 2
                    ones = gr 1
                    threeToOne = min threes ones
                    twosToTwos = twos `div` 2
                    unpairThrees = threes - threeToOne
                    unpairOnes = ones - threeToOne + ((twos  `mod` 2)*2)
                in
                    fours + threeToOne + twosToTwos + ((unpairOnes `div` 4) + (if unpairOnes `mod` 4 /= 0 then 1 else 0)) + unpairThrees

main = getLine >> getLine >>= \a -> let groups = (map  read  (split ' ' a) :: [Int]) in putStrLn $ show $ findSol groups

import Data.Sequence
import Data.Foldable

getGroups :: IO [Integer]
getGroups = do
    _groups <- getLine
    return $ map read (words _groups)

getAnswer :: [Integer] -> Integer
getAnswer groups = quantify $ count groups

count :: [Integer] -> [Integer]
count groups = _count groups [0, 0, 0, 0]

_count :: [Integer] -> [Integer] -> [Integer]
_count [] counter = counter
_count (first:rest) counter = _count rest $ toList $ update position ((counter !! position) + 1) $ fromList counter
    where position = fromIntegral first - 1

quantify :: [Integer] -> Integer
quantify counter = getQuarters + getTriplesAndOnes + getDoubles + getRest
    where ones = head counter
          twos = head $ tail counter
          threes = head $ tail $ tail counter
          fours = last counter
          getQuarters = fours
          getTriplesAndOnes = threes
          onesWithoutThrees = if ones > threes
                              then ones - threes
                              else 0
          (getDoubles, onesRest) = quantifyDoubles twos onesWithoutThrees
          getRest = onesRest `div` 4 + if onesRest `mod` 4 > 0
                                       then 1
                                       else 0

quantifyDoubles :: Integer -> Integer -> (Integer, Integer)
quantifyDoubles 0 ones = (0, ones)
quantifyDoubles twos ones = (countedTwos, onesRest)
    where countedTwos = twos `div` 2 + twos `mod` 2
          onesRest = if twos `mod` 2 == 1
                     then if ones >= 2
                          then ones - 2
                          else 0
                     else ones

main :: IO ()
main = do
    n <- getLine
    groups <- getGroups
    print $ getAnswer groups

import Data.List (sort)

pack [] _ _ = 0
pack (x:xs) oc2 oc1
  | x == 4 = 1 + pack xs oc2 oc1
  | x == 3 = 1 + pack xs oc2 (oc1+1)
  | x == 2 = if oc2 > 0 then pack xs (oc2-1) oc1 else 1 + pack xs (oc2+1) oc1
  | x == 1 = let free = 2*oc2 + oc1 in if free > 0 then pack xs 0 (free - 1) else 1 + pack xs 0 (free+3)

main = do
  getLine
  aa <- getLine
  let xs = reverse $ sort $ map read $ words aa :: [Int]
  print $ pack xs 0 0

{-
import Data.Array

main = interact $ show . solve . map read . words

solve :: [Int] -> Int
solve (_:xs) = fst . greedy1 . greedy2 . greedy3 . greedy4 . (,) 0 . count $ xs

foldl' f z []     = z
foldl' f z (x:xs) = let z' = f z x
                    in seq z' $ foldl' f z' xs

count :: [Int] -> Array Int Int
count = foldl' f (array (1, 4) (zip [1..4] (repeat 0)))
    where f arr i = arr//[(i, arr!i + 1)]

greedy4 :: (Int, Array Int Int) -> (Int, Array Int Int)
greedy4 (ans, arr) = (ans + arr!4, arr)

greedy3 :: (Int, Array Int Int) -> (Int, Array Int Int)
greedy3 (ans, arr) = (ans + arr!3, arr//[(1, max 0 (arr!1 - arr!3))])

greedy2 :: (Int, Array Int Int) -> (Int, Array Int Int)
greedy2 (ans, arr) = (ans + x, arr//[(1, new1)])
    where (x, new1) = if mod (arr!2) 2 == 1 then (arr!2 `div` 2 + 1, max 0 (arr!1 - 2)) else (arr!2 `div` 2, arr!1)

greedy1 :: (Int, Array Int Int) -> (Int, Array Int Int)
greedy1 (ans, arr) = (ans + ceil (arr!1) 4, arr)

ceil :: Int -> Int -> Int
ceil a b = if (a `mod` b == 0) then ans else ans + 1
    where ans = a `div` b

main = do
    n:ss <- (`fmap` getContents) $ words >>> map (readInt >>> fromJust >>> fst)
    let n1:n2:n3:n4:_ = map ((==) >>> (`filter` ss) >>> length) [1..]
        print $ n4 + n3 + (n2*2 + 3 + max 0 (n1-n3)) `div` 4

-}

main = do
    content <- getContents
    let n:ss = map read . words $ content
        n1:n2:n3:n4:_ = map (length . (\n -> filter (== n) ss)) [1..]
    print $ n4 + n3 + (n2*2 + 3 + max 0 (n1-n3)) `div` 4

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] = f + h + q + a + r + rest
    where (q,r) = divMod t 2
          rest1 = o - h - 2*r
          (a,b) = if rest1 > 0 then divMod rest1 4 else (0,0)
          rest  = if b > 0 then 1 else 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

module Main where
import System.IO
import Data.List
import Data.Maybe
import Debug.Trace

main = do s <- hGetContents stdin
          print $ solve $ map read $ words s

s :: (Show a) => String -> a -> a
-- s m x = trace (m ++ " = " ++ (show x)) x
s m x = x

solve :: [Int] -> Int
solve (n:xs) = fours + _31 + (threes - _31) + _22 + _21 + _11 + _11L
    where items = map (\x -> (head x, length x)) $ group $ sort xs
          ones = fromMaybe 0 $ fmap snd $ find ((1==).fst) items
          twos = fromMaybe 0 $ fmap snd $ find ((2==).fst) items
          threes = fromMaybe 0 $ fmap snd $ find ((3==).fst) items
          fours = fromMaybe 0 $ fmap snd $ find ((4==).fst) items
          _31 = s "_31" $ min threes ones
          _22 = s "_22" $ div twos 2
          _21 = s "_21" $ if twos - _22*2 > 0 then 1 else 0
          onesAfterComplete = s "onesAfterComplete" $ if _21 > 0 then max (ones - _31 - 2) 0 else ones - _31
          _11 = s "_11" $ div onesAfterComplete 4
          _11L = s "_11L" $ if onesAfterComplete - _11*4 > 0 then 1 else 0

import Data.Char

main = do
	line <- getLine
	groupLine <- getLine
	let groups = map ((+ 0) . read) $ words groupLine
	putStrLn $ show $ answer groups

answer :: [Integer] -> Int
answer a =
	let fours = length $ filter (\x -> x == 4) a;
		threes = length $ filter (\x -> x == 3) a;
		twos = length $ filter (\x -> x == 2) a;
		ones = length $ filter (\x -> x == 1) a;
		threeOne = min ones threes;
		twoPairs = twos `quot` 2;
		singleThrees = threes - threeOne;
		onesLeft = ones - threeOne;
		onePairs = quot onesLeft 2;
		twosLeft = twos - (twoPairs * 2);
		oneTwoPair = min twosLeft onePairs;
		singleTwo = twosLeft - (quot (oneTwoPair + 1) 2);
		onlyOneGroups = quot (3 + onesLeft - singleTwo - (oneTwoPair * 2)) 4
	in  fours + threeOne + twoPairs + singleThrees + oneTwoPair + singleTwo + onlyOneGroups

module Main where

import Data.Maybe
import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (show . solve . map read . words . (!! 1) . lines)

solve :: [Int] -> Int
solve groups = sum [four, threePlusOne, twoPlusTwo, three', twoPlusOnes, outsiders] where
    outsiders = (one'' + 3) `div` 4
    one'' = if two' == 1 then max 0 (one' - 2) else one'
    twoPlusOnes = if two' == 1 then 1 else 0
    (one', two', three') = (one - threePlusOne, two `mod` 2, three - threePlusOne)
    twoPlusTwo = two `div` 2
    threePlusOne = min three one
    [one, two, three, four] = [length (filter (== x) groups) | x <- [1..4]]

import Data.Array.IArray

-- Snippet: readItems
readItems = do
    line <- getLine
    return $ map read $ words line

main = do
    n <- getLine
    a <- readItems
    let b = accumArray (+) 0 (1, 4) [(i, 1) | i <- a]
    let [b1, b2, b3, b4] = elems (b :: Array Int Int)
    let answer1 = b4 + b3 + div (b2 + 1) 2
    let answer2 = div (3 + max 0 (b1 - (b3 + (mod b2 2) * 2))) 4
    putStrLn $ show $ answer1 + answer2

import Data.List
import Data.Function

counts :: [Int] -> [(Int, Int)]
counts [] = []
counts l = (x, length c) : counts r
    where
        x = head l
        (c, r) = partition (== x) l

main = do
    ns <- getLine
    ss <- getLine
    let s = map (read :: String -> Int) . words $ ss
    let [ones, twos, threes, fours] = map (\x -> length . filter (== x) $ s) [1..4]
    print (fours + threes + (twos * 2 + 3 + max 0 (ones - threes)) `div` 4)

import Data.Array
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as B

main = do
    getLine
    as <- fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

    let
        cs = accumArray (+) 0 (1, 4) $ zip as (repeat 1)
        c13 = min (cs!1) (cs!3)
        c3 = max (cs!3 - c13) 0
        c1 = max (cs!1 - c13) 0
        x = c1 `mod` 4 + (if even (cs!2) then 0 else 2)

    print $ cs!4 + c13 + c3 + (c1 `div` 4) + (cs!2 `div` 2) + ((x + 3) `div` 4)

main :: IO ()
main = do
    n <- fmap read getLine :: IO Integer
    si <- fmap (map read . words) getLine :: IO [Int]
    print $ fillCars $ groups $ si

fillCars :: [Int] -> Int
fillCars g = g4 +
    min g3 g1 +
    max (g3 - (min g3 g1)) 0 +
    div g2 2 + (mod g2 2) +
    div g1' 4 + if (mod g1' 4) > 0 then 1 else 0
    where
        g1 = g !! 0
        g2 = g !! 1
        g3 = g !! 2
        g4 = g !! 3
        g1' = max (g1 - (min g3 g1) - ((mod g2 2) * 2)) 0

groups :: [Int] -> [Int]
groups [] = [0,0,0,0]
groups (x:xs) = [b 1, b 2, b 3, b 4]
    where b = \i -> groups xs !! (i-1) + (if x == i then 1 else 0)

import Data.List

main :: IO()
main = interact $ show . solve . map (read) . words

solve :: [Int] -> Int
solve (n : xs) =
    d + cal a b c
    where
        (a : b : c : d:_) = map ((subtract 1) . length) . group . sort $ (1:2:3:4:xs)

cal :: Int -> Int -> Int -> Int
cal a b c
    | c > 0 =
        let
            k = min a c
        in
            c + cal (a - k) b 0
    | b > 0     =
        let
            k = min b (div a 2)
        in
            if k == b then k + cal (a - 2 * k) 0 0
                else k + (ceilDiv (b - k) 2) + cal (a - 2 * k - (mod (b - k) 2)) 0 0
    | a > 0     = (ceilDiv a 4)
    | otherwise = 0

ceilDiv a b = div (a + b - 1) b

import Data.Array
import Control.Monad

count list = accumArray (flip $ const (+1)) 0 (1, 4) (zip list (repeat undefined))

solve x4 x3 x2 x1 | x4 > 0            = solve 0 x3 x2 x1 + x4
solve 0  x3 x2 x1 | x3 > 0 && x1 > 0  = let x = min x1 x3 in solve 0 (x3-x) x2 (x1-x) + x
solve 0  x3 x2 x1 | x3 > 0            = solve 0 0 x2 x1 + x3
solve 0  0  x2 x1 | x2 > 1            = solve 0 0 (x2 `mod` 2) x1 + x2 `div` 2
solve 0  0  1  x1                     = solve 0 0 0 (max 0 (x1-2)) + 1
solve 0  0  0  x1                     = (x1 + 3) `div` 4

main = do
    _ <- getLine
    list <- liftM (map read . words) getLine

    let c = count list
    print $ solve (c!4) (c!3) (c!2) (c!1)

main :: IO ()
main = do
    n <- getLine
    inputs <- fmap (map read.words) getLine
    let [a,b,c,d] = map (\x -> length $ filter (==x) inputs) [1,2,3,4]
    print $ d + c + ((b*2 + 3 + (max 0 (a - c))) `div` 4)

import Data.List

main = do
    n <- getLine
    line <- getLine
    let nums = map toInt (words line)
    print $ process nums 0

process :: [Int] -> Int -> Int
process nums k
    | nums == [] = k
    | filter (==4) nums /= [] = process (filter (/=4) nums) (length (filter (==4) nums) + k)
    | filter (==3) nums /= [] && (filter (==1) nums == []) = process (drop (j) (filter (==3) nums) ++ filter (/=3) nums) (k + j)
    | filter (==3) nums /= [] && filter (==1) nums /= [] = process (drop h (filter (==3) nums) ++ drop h (filter (==1) nums) ++ (filter (==2) nums)) (k + h)
    | filter (==2) nums /= [] && (length (filter (==2) nums) >= 2) = process (drop (p * 2) (filter (==2) nums) ++ filter (/=2) nums) (k + p)
    | filter (==2) nums /= [] && (length (filter (==2) nums) == 2) = process (filter (/=2) nums) (k + 1)
    | filter (==2) nums /= [] && (length (filter (==2) nums) > 1) = process (drop 2 (filter (==2) nums) ++ filter (/=2) nums) (k + 1)
    | length (filter (==1) nums) > 1 && filter (==1) nums /= [] && filter (==2) nums /= [] = process (drop 1 (filter (==2) nums) ++ drop 2 (filter (==1) nums)) (k + 1)
    | filter (==1) nums /= [] && filter (==2) nums /= [] = process (drop 1 (filter (==2) nums) ++ drop 1 (filter (==1) nums)) (k + 1)
    | filter (==1) nums /= [] && (length (filter (==1) nums) >= 4) = process (drop (g * 4) (filter (==1) nums)) (k + g)
    | filter (==1) nums /= [] && (length (filter (==1) nums) > 1) = process (drop f nums) (k + 1)
    | otherwise = process (tail nums) (k + 1)
        where
            f = (length (filter (==1) nums))
            g = (length (filter (==1) nums)) `div` 4
            p = (length (filter (==2) nums)) `div` 2
            j = (length (filter (==3) nums))
            h = if length (filter (==3) nums) > length (filter (==1) nums) then length (filter (==1) nums) else length (filter (==3) nums)

toInt :: String -> Int
toInt = read

mycount :: [Int] -> Int -> Int
mycount [] k = 0
mycount (x:xs) k =
  if x == k
    then 1 + mycount xs k
    else mycount xs k

main = do
  str <- getContents
  let
    n:a = map read $ words str
    c = [mycount a x | x <- [1..4]]
    three = min (c!!0) (c!!2)
    ans = (c!!3) + (c!!2) + ((c!!1) * 2 + ((c!!0) - three) + 3) `div` 4
  putStrLn $ show ans

import Data.List

main = interact $ show . taxis . map (pred . length) . group . sort . (["1","2","3","4"]++) . tail . words

taxis [a,b,c,d] = d + c + b' + bm + a'
    where
        (b', bm) = quotRem b 2
        a' = (`quot` 4) . (+3) . max 0 $ (a - c - 2*bm)

import Data.List (foldl')
main :: IO ()
main = do
    _ <- getLine
    ss <- getLine
    let groups = map read $ words ss
    print $ taxiSplit groups
    return ()

taxiSplit :: [Int] -> Int
taxiSplit = countCabs . (foldl' (groupSize) (0,0,0,0))
  where groupSize (a,b,c,d) x = case x of
                                  1 -> (a + 1, b, c, d)
                                  2 -> (a, b + 1, c, d)
                                  3 -> (a, b, c + 1, d)
                                  4 -> (a, b, c, d + 1)

countCabs :: (Int, Int, Int, Int) -> Int
countCabs (0, 0, 0, 0) = 0
countCabs (a, 0, 0, 0) = (a `quot` 4) + (if a `rem` 4 > 0 then 1 else 0)
countCabs (0, b, c, 0) = let b' = quot b 2 in
  b' + c + (if odd b then 1 else 0)
countCabs (a, b, 0, 0) = let b' = quot b 2 in
  b' + (if even b then countCabs (a,0,0,0)
                  else if a < 3 then 1
                                else 1 + countCabs (a - 2, 0, 0, 0))
countCabs (a, b, c, 0) = let x = min a c in
  x + countCabs (a - x,b,c - x,0)
countCabs (a, b, c, d) = d + countCabs (a,b,c,0)

module Main (main) where

import System.Environment
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

getIntArray :: IO[Int]
getIntArray = fmap (map read.words) getLine

main = interact$show.s.map read.words

s :: [Int] -> Int
s (x:xs) = t n1 n2 n3 n4
           where n1 = length $ filter (== 1) xs
                 n2 = length $ filter (== 2) xs
                 n3 = length $ filter (== 3) xs
                 n4 = length $ filter (== 4) xs

upper :: Int -> Int -> Int
upper a b = ((a - 1) `div` b) + 1

t :: Int -> Int -> Int -> Int -> Int
t 0 0 0 0 = 0
t n1 n2 n3 n4
    | min13 > 0  = min13 + t (n1-min13) n2 (n3-min13) n4
    | n2pair > 0 = n2pair + t n1 (n2-n2pair*2) n3 n4
    | min12 > 0  = t (n1-min12) (n2-min12) (n3+min12) n4
    | n4 > 0 = n4 + t n1 n2 n3 0
    | n3 > 0 = n3 + t n1 n2 0 n4
    | n2 > 0 = (upper n2 2) + t n1 0 n3 n4
    | n1 > 0 = (upper n1 4) + t 0 n2 n3 n4
    | otherwise = 0
    where min13 = min n1 n3
          min12 = min n1 n2
          n2pair = n2 `div` 2

count_occurence xs n = length (filter (== n) xs)

one_rem :: (Integral a) => a -> a -> a -> a
one_rem a b c = if n < 0
                then 0
                else ceiling (fromIntegral n / 4)
                where n = a - (mod b 2) * 2 - c

main = do s <- getLine
          s <- getLine
          let ns = map (\x -> read x :: Int) (words s)
              [o1,o2,o3,o4] = map (count_occurence ns) [1..4]
              n = (one_rem o1 o2 o3) + ceiling (fromIntegral o2 / 2) + o3 + o4
          print n

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

t :: Int -> (Sum Int,Sum Int,Sum Int,Sum Int)
t 1 = (Sum 1,Sum 0,Sum 0,Sum 0)
t 2 = (Sum 0,Sum 1,Sum 0,Sum 0)
t 3 = (Sum 0,Sum 0,Sum 1,Sum 0)
t 4 = (Sum 0,Sum 0,Sum 0,Sum 1)

q4 x = (x + 3) `quot` 4

solve a1 a2 0 = q4 $ a1 + 2*a2
solve 0 a2 a3 = a3 + q4 (2*a2)
solve a1 a2 a3 = m + solve (a1-m) a2 (a3-m)
	where m = min a1 a3

main :: IO ()
main = do
	void getLine
	(Sum a1, Sum a2, Sum a3, Sum a4) <- fold . map t <$> inputInts
	print $ a4 + solve a1 a2 a3

read_int :: String -> Int
read_int = read

kill_threes :: ((Int, Int, Int, Int), Int) -> ((Int, Int, Int, Int), Int)
kill_threes ((a, b, c, d), s) = ((a-m, b, c-m, d), s+m)
  where m = min a c

kill_twos :: ((Int, Int, Int, Int), Int) -> ((Int, Int, Int, Int), Int)
kill_twos ((a, b, c, d), s) = ((a-2*m1, 0, c, d), s+m1+m2)
  where m1 = min b ((a+1) `quot` 2)
        m2 = (b-m1+1) `quot` 2

kill_ones :: ((Int, Int, Int, Int), Int) -> ((Int, Int, Int, Int), Int)
kill_ones ((a, b, c, d), s) = ((0, b, c, d), s+m)
  where m = (a+3) `quot` 4

sum_tup :: ((Int, Int, Int, Int), Int) -> Int
sum_tup ((a, b, c, d), s) = a+b+c+d+s

solve :: (Int, Int, Int, Int) -> Int
solve t = sum_tup . kill_ones . kill_twos . kill_threes $ (t,0)

add_tup :: (Int, Int, Int, Int) -> Int -> (Int, Int, Int, Int)
add_tup (a,b,c,d) 1 = (a+1,b,c,d)
add_tup (a,b,c,d) 2 = (a,b+1,c,d)
add_tup (a,b,c,d) 3 = (a,b,c+1,d)
add_tup (a,b,c,d) 4 = (a,b,c,d+1)

get_tup :: String -> (Int, Int, Int, Int)
get_tup str = foldl add_tup (0,0,0,0) $ map read_int $ words str

main = do
  getLine
  nums <- getLine
  print $ solve . get_tup $ nums

import Control.Applicative
import Data.Array
main= do
	getLine
	s<- map read. words <$> getLine:: IO [Int]
	let t = accumArray  (+) 0 (1,4) $ zip s (repeat 1)
	let u = t!4+ (div (t!2) 2) + t!3
        let a1= (mod (t!2) 2)
	let a2 = (max 0 (t!1-t!3-a1*2))
	let v = u+a1+div a2 4 + if ( mod a2 4 >0) then 1 else 0
	print v

{-
B. Taxi
=======
time limit per test 3 seconds
memory limit per test 256 megabytes
input standard input
output standard output

After the lessons n groups of schoolchildren went outside and decided to visit Polycarpus to celebrate his birthday. We know that the i-th group consists of si friends (1 ≤ si ≤ 4), and they want to go to Polycarpus together. They decided to get there by taxi. Each car can carry at most four passengers. What minimum number of cars will the children need if all members of each group should ride in the same taxi (but one taxi can take more than one group)?

Input
------
The first line contains integer n (1 ≤ n ≤ 10^  5) — the number of groups of schoolchildren. The second line contains a sequence of integers s1, s2, ..., sn (1 ≤ si ≤ 4). The integers are separated by a space, si is the number of children in the i-th group.

Output
-------
Print the single number — the minimum number of taxis necessary to drive all children to Polycarpus.

Sample test(s)
--------------
input
```
5
1 2 4 3 3
```
output
```
4
```
input
```
8
2 3 4 4 2 1 3 1
```
output
```
5
```
Note
In the first test we can sort the children into four cars like this:

- the third group (consisting of four children),
- the fourth group (consisting of three children),
- the fifth group (consisting of three children),
- the first and the second group (consisting of one and two children, correspondingly).
There are other ways to sort the groups into four cars.
-}

import Data.List (sort, group)

count :: Int -> [Int] -> Int
count k xs = length $ filter (== k) xs

taxiNumber :: [Int] -> Int
taxiNumber xs = n4 + n3 + ceiling (fromIntegral n2 / 2) + adjust
  where [n1, n2, n3, n4]  = map (`count` xs) [1,2,3,4]
        adjust = max 0 $ ceiling $ (fromIntegral (n1 - n3 - 2 * (n2 `mod` 2))) / 4

reader :: String -> [Int]
reader s = map read $ words second
  where [_, second] = lines s

main = do
  input <- getContents
  let xs = reader input
  print $ taxiNumber xs

main = do
  getLine
  t <- getLine
  let t2 = map read $ words t
  let p1 = length $ filter (== 1) t2
  let p2 = length $ filter (== 2) t2
  let p3 = length $ filter (== 3) t2
  let p4 = length $ filter (== 4) t2
  print $ cal p1 p2 p3 p4
cal :: Int -> Int -> Int -> Int -> Int
cal w x y z = max (z + y + (quot (x+1) 2)) (quot (w+2*x+3*y+4*z+3) 4)

main = do
  groups <- getLine >> getLine >>= return . (map read) . words
  let [a1, a2, a3, a4] = map countGroups [1..4]
                           where countGroups i = length $ filter (== i) groups
  let extra = if a3 > a1
                then mod a2 2
                else ceiling (fromIntegral (a1 - a3 + (mod a2 2) * 2) / 4)
  print (extra + a3 + div a2 2 + a4)

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

f :: Int -> Int -> Int -> Int -> Int
f 0 0 0 0 = 0
f a1 a2 a3 a4
 | a4 > 0 = a4 + f a1 a2 a3 0
 | a1 > 0 && a3 > 0 =
 	let
		mn = min a1 a3
	in
		mn + f (a1 - mn) a2 (a3 - mn) a4
 | a3 > 0 = a3 + f a1 a2 0 a4
 | a2 > 1 = (a2 `div` 2) + f a1 (a2 `mod` 2) a3 a4
 | a2 == 1 && a1 >= 2 = 1 + f (a1 - 2) 0 a3 a4
 | a2 <= 1 && a1 <= 2 = 1
 | a1 > 0 = a1 `div` 4 + (if a1 `mod` 4 > 0 then 1 else 0)
 | otherwise = error "hi, how are you!!!"

main :: IO ()
main = do
	_ <- getLine
	line <- getLine
	let
		arr = map (\x -> read x :: Int) . words $ line
		a1 = length . filter (== 1) $ arr
		a2 = length . filter (== 2) $ arr
		a3 = length . filter (== 3) $ arr
		a4 = length . filter (== 4) $ arr
	print $ f a1 a2 a3 a4

import List

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy _ [] = []
splitBy f list = first : splitBy f (dropWhile f rest)
	where
  		(first, rest) = break f list

toIList :: String -> [Int]
toIList str = (map read splitted) :: [Int]
	where
		splitted = splitBy (== ' ') str

minimumTaxis :: [Int] -> Int
minimumTaxis ppls = c4 + c3 + res2 + res1
	where
		count = map length $ group $ sort (ppls ++ [1, 2, 3, 4])
		c4 = count !! 3 - 1
		c3 = count !! 2 - 1
		c2 = count !! 1 - 1
		c1 = count !! 0 - 1
		left1 = if c1 - c3 > 0 then c1 - c3 else 0
		full2 = floor $ (fromIntegral c2)/2
		left2 = c2 `mod` 2
		res2 = full2 + left2
		res1 = if left1 - left2*2 > 0 then ceiling $ (fromIntegral (left1 - left2*2))/4 else 0

main = do
	line1 <- getLine
	line2 <- getLine
	let result = minimumTaxis $ toIList line2

	putStr $ show result

module Main where

import           Control.Arrow
import           Data.List

type Map = [(Int, Int)]

set :: Int -> Int -> Map -> Map
set i n = map (\ (a, b) -> if a == i
                           then (a, n)
                           else (a, b)
              )

substract :: Int -> Int -> Map -> Map
substract i n = map (\ (a, b) -> if a == i
                                 then (a, b - n)
                                 else (a, b)
                    )

remove :: Int -> Map -> Map
remove i = map (\ (a, b) -> if a == i
                            then (a, 0)
                            else (a, b)
               )

valueAt :: Int -> Map -> Int
valueAt _ [] = 0
valueAt i ((a, b):xs) = if a == i
                        then b
                        else valueAt i xs

f :: Map -> Int
f [] = 0
f (m:ms) = case m of
  (4, x) -> x + f ms
  (3, x) -> x + (f $ substract 1 k ms)
    where
      k = min x x1
      x1 = valueAt 1 ms
  (2, x) -> n + (f $ substract 1 k ms)
    where
      k = l * min 2 x1
      l = mod x 2
      x1 = valueAt 1 ms
      n = div x 2 + l
  (1, x) -> ceiling ((fromIntegral x) / 4)

frequency :: [Int] -> Map
frequency = map (head &&& length) . group . sort

main :: IO ()
main = do
  getLine
  xs <- (map read . words) `fmap` getLine :: IO [Int]
  putStrLn . show . f . reverse . frequency $ xs

import Data.List
import Control.Applicative

main = getLine >> getLine >>= putStrLn.show.solve.reverse.sort.map read.words

solve :: [Int] -> Int
solve a = s [0, 0, 0] a

s [o, 0, 0] []
  | o == 0     = 0
  | o <  4     = 1
  | otherwise  = (o `div` 4) + s [o `mod` 4, 0, 0] []
s [o, 1, 0] []
  | o < 3      = 1
  | otherwise  = succ $ s [o - 2, 0, 0] []
s [o, t, 0] [] = (t `div` 2) + s [o, t `mod` 2, 0] []
s [0, t, h] [] = h + s [0, t, 0] []
s [o, t, h] [] = succ $ s [pred o, t, pred h] []
s [3, t, 0] (1:x) = succ $ s [0, t, 0] x
s [o, t, 0] (1:x) = s [succ o, t, 0] x
s [o, t, h] (1:x) = succ $ s [o, t, pred h] x
s [o, 0, h] (2:x) = s [o, 1, h] x
s [o, 1, h] (2:x) = succ $ s [o, 0, h] x
s [0, t, h] (3:x) = s [0, t, succ h] x
s [o, t, h] (3:x) = succ $ s [pred o, t, h] x
s a (4:x) = succ $ s a x

fill :: [Int] -> (Int, [Int]) -> (Int, [Int])
fill cs (n, xs) = (n + n', xs')
    where
        n' = minimum $ zipWith (\x c -> if c == 0 then maxBound else x `div` c) xs cs
        xs' = zipWith (\x c -> x - n' * c) xs cs

process :: [Int] -> Int
process ss = fst $ foldr fill (0, xs) [
                                    [1,0,0,0],
                                    [2,0,0,0],
                                    [0,1,0,0],
                                    [3,0,0,0],
                                    [1,1,0,0],
                                    [0,0,1,0],
                                    [4,0,0,0],
                                    [2,1,0,0],
                                    [0,2,0,0],
                                    [1,0,1,0],
                                    [0,0,0,1]]
    where
        xs = [length (filter (==x) ss) | x <- [1..4]]

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

import Data.Char
import Data.List

under2 a 0 = (a+3)`div`4
under2 0 b = (b+1)`div`2
under2 a b
    | a==1&&b==1 = 1
    | a==1               = 1+under2 0 (b-1)
    | otherwise         = 1+under2 (a-2) (b-1)
under3 a b 0 = under2 a b
under3 0 b c  = c+under2 0 b
under3 a b c  = 1+under3 (a-1) b (c-1)

ans input = d + under3 a b c
    where (i,i1)=span (==1) input
          (j,i2)=span(==2) i1
          (k,i3)=span(==3) i2
          [a,b,c,d]=[length i,length j,length k,length i3]

main=do
    n<-getLine
    input<-getLine
    let inputed=sort $ map (\x->read x::Int) $ words input
    print $ ans inputed

increaseNth :: [Int] -> Int -> [Int]
increaseNth xs n = take n xs ++ [((xs !! n) + 1)] ++ drop (n + 1) xs

countArrAss :: [Int] -> [Int] -> [Int]
countArrAss [] after = after
countArrAss (x:pre) after = countArrAss pre (increaseNth  after (x - 1))

countArr :: [Int] -> [Int]
countArr da = countArrAss da [0, 0, 0, 0]

preProcess :: [Char] -> [Int]
preProcess s = countArr $ map read (words s)

sol :: [Int] -> Int
sol xs = prefix4th + prefix3th + prefix2th + prefix1th
    where prefix4th = (xs !! 3)
          prefix3th = (xs !! 2)
          prefix1sub3 = (xs !! 0) - (xs !! 2)
          prefix2remain = mod (xs !! 1) 2
          prefix2th = plu + (div (xs !! 1) 2)
            where plu = if prefix2remain > 0 then 1 else 0
          prefix1sub3sub2 = prefix1sub3 - 2 * prefix2remain
          prefix1th = if prefix1sub3sub2 > 0
                          then ceiling ((fromIntegral prefix1sub3sub2) / 4)
                          else 0

main = do
        n <- getLine
        groups <- getLine
        putStrLn $ show (sol (preProcess groups))

import System.IO
import Control.Applicative

main :: IO ()
main = print =<< minSolve . solve . map read . words <$> (getLine >> getLine)

solve :: [Integer] -> (Integer, Integer, Integer, Integer)
solve = foldl f (0,0,0,0) where
    f (a,b,c,d) 4 = (a+1,b,c,d)
    f (a,b,c,d) 3 = (a,b+1,c,d)
    f (a,b,c,d) 2 = (a,b,c+1,d)
    f (a,b,c,d) 1 = (a,b,c,d+1)

minSolve :: (Integral a) => (a, a, a, a) -> a
minSolve (0, 0, 0, r) = r `div` 4 + if r `mod` 4 == 0 then 0 else 1
minSolve (0, 0, e, r) = e `div` 2 +  if e `mod` 2 == 0 then minSolve (0,0,0,r) else 1 + minSolve(0,0,0,max (r-2) 0)
minSolve (q, w, e, r) = q + w + minSolve (0, 0, e, max 0 (r-w))

cars :: Int -> Int -> Int -> Int -> Int
cars n1  0  0  0 = n1 `divUp` 4
cars n1 n2  0  0 = n2 `divUp` 2 + cars newn1 0 0 0
    where newn1  = max (n1 - 2 * (n2 `rem` 2)) 0
cars n1 n2 n3  0 = n3 + cars newn1 n2 0 0
    where newn1  = max (n1 - n3) 0
cars n1 n2 n3 n4 = n4 + cars n1 n2 n3 0

divUp :: (Integral a) => a -> a -> a
divUp a b =  (a + b - 1) `div` b

work :: String -> String
work input = show $ cars n1 n2 n3 n4
    where
        gangs =  map read . words . last . lines $ input
        n1:n2:n3:n4:_ = [length . filter (==x) $ gangs | x <- [1..4]]

main :: IO ()
main = interact work

count x = length . filter (x==)

divUp x y = div (x + y - 1) y

solve a
    = fours + threes + divUp ((max (ones - threes) 0) + twos * 2) 4
  where
    ones   = count 1 a
    twos   = count 2 a
    threes = count 3 a
    fours  = count 4 a

main =  print . solve . map read . words . last . lines =<< getContents

main = do
    line <- getLine
    let n = read line :: Int
    line <- getLine
    let ss = take n $ map read $ words line :: [Int]
    putStrLn $ show $ solve ss

solve :: [Int] -> Int
solve ss = c4 + solve' c1 c2 c3
    where
        c1 = count (== 1) ss
        c2 = count (== 2) ss
        c3 = count (== 3) ss
        c4 = count (== 4) ss

count :: (a -> Bool) -> [a] -> Int
count p = length . filter p

solve' :: Int -> Int -> Int -> Int
solve' c1 0 0 = c1 `divUp` 4
solve' 0 c2 0 = c2 `divUp` 2
solve' 0 c2 c3 = c3 + solve' 0 c2 0
solve' c1 c2 0 | c1 >= 2 * c2  = c2 + solve' (c1 - 2 * c2) 0 0
               | otherwise     = c1 `divUp` 2 + solve' 0 (c2 - c1 `divUp` 2) 0
solve' c1 c2 c3 | c1 >= c3  = c3 + solve' (c1 - c3) c2 0
                | otherwise = c1 + solve' 0 c2 (c3 - c1)

divUp a b = (a - 1) `div` b + 1

g=getLine
main=do
 q<-g
 let n=read q
 q<-g
 let o=take n$map read$words q
 putStrLn$show$c(==4)o+r(c(==1)o)(c(==2)o)(c(==3)o)
c p=length.filter p
r a 0 0=s a 4
r 0 b 0=s b 2
r 0 b h=h+r 0 b 0
r a b 0|a<2*b=s a 2+r 0(b-s a 2)0
 |True=b+r(a-2*b)0 0
r a b h|a<h=a+r 0 b(h-a)
 |True=h+r(a-h)b 0
s a b=(a-1)`div`b+1

import Data.List
import Control.Monad

count l =
    let groups = group $ sort ([1,2,3,4] ++ l)
    in [length x - 1 | x <- groups]

ssolve l =
    let [one, two, three, four] = count l
    in solve one two three four

solve :: Int -> Int -> Int -> Int -> Int
solve one 0 0 0          = one `div` 4 + (if one `mod` 4 /= 0 then 1 else 0)
solve one two 0 0
      | two > 1          = (two `div` 2) + solve one (two `mod` 2) 0 0
      | otherwise        = solve (one + 2 * two) 0 0 0
solve one two three 0    = three + solve (max 0 (one - three)) two 0 0
solve one two three four = four + solve one two three 0

main = do
  _ <- getLine >>= return . (read :: String -> Int)
  ppl <- getLine >>= (return . map (read::String->Int) . words)
  print $ ssolve ppl

import Data.Char
main = do
    n <- getLine
    xs <- getLine
    let ys = [read x::Int | x <- words(xs)]
    print $ f $ [length $ filter (==i) ys | i <- [1..4]]

f xs = a4 + a3 + div (a2 + 1) 2 + div (max 0 (a1 - a3 - 2 * mod a2 2 + 3)) 4
    where
    a4 = xs !! 3
    a3 = xs !! 2
    a2 = xs !! 1
    a1 = xs !! 0

import Data.List (sortBy)

taxi :: [Int] -> Int
taxi = taxiGrouper 0 [] . sortBy (flip compare)

taxiGrouper :: Int -> [Int] -> [Int] -> Int
taxiGrouper groups fall@(f:fs) (p:ps)
	| f > p = taxiGrouper groups (insert (f-p) fs) ps
	| f == p = taxiGrouper groups fs ps
	| otherwise = taxiGrouper (groups + 1) (insert (4-p) fall) ps
taxiGrouper groups _ (p:ps) = taxiGrouper (groups + 1) (insert (4-p) []) ps
taxiGrouper groups _ _ = groups

insert :: Int -> [Int] -> [Int]
insert x (y:ys) = if x < y then y : (insert x ys) else x:y:ys
insert x _ = [x]

main = do
	getLine
	getLine >>= print . taxi . (map read) . words

main = interact $ show . solve . map read . words
solve (_ : k : xs) = length . takeWhile (>= xs !! (k - 1)) . filter (> 0) $ xs

import Data.Char

main = do
	line <- getLine
	groupLine <- getLine
	let groups = map ((+ 0) . read) $ words groupLine
	putStrLn $ show $ answer groups

answer :: [Integer] -> Int
answer a =
	let fours = length $ filter (\x -> x == 4) a;
		threes = length $ filter (\x -> x == 3) a;
		twos = length $ filter (\x -> x == 2) a;
		ones = length $ filter (\x -> x == 1) a;
		threeOne = min ones threes;
		twoPairs = twos `quot` 2;
		onesLeft = ones - threeOne;
		onePairs = quot onesLeft 2;
		twosLeft = twos - (twoPairs * 2);
		oneTwoPair = min twosLeft onePairs;
		onlyOneGroups = quot (3 + onesLeft - (oneTwoPair * 2)) 4
	in  fours + threeOne + twoPairs + (threes - threeOne) + oneTwoPair + (twosLeft - (quot (oneTwoPair + 1) 2)) + onlyOneGroups

module Main
    where

import Data.List (sort, group)

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)
    where count = map (pred . length) . group . sort . ([1..4]++) . map read . words
          numTaxi [o,t,h,f] = let (q,r) = divMod t 2
                               in f + q + r + abs (o - h) + min o h

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          ok = if b > 0 && h /= 0 then 1 else 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = do
    line <- getLine
    let groups = (map read . words) line :: [Int]
    putStrLn (show $ minCars groups)

minCars :: [Int] -> Int
minCars nums = let
    ofNum n = length . filter (n==) $ nums
    amounts = map ofNum [0..4]
    cars' = (amounts !! 4) + (amounts !! 3) + div (1 + amounts !! 2) 2
    free1s = (amounts !! 3) + 2 * (mod (amounts !! 2) 2)
    in if free1s >= (amounts !! 1) then cars'
    else cars' + div (3 - free1s + amounts !! 1) 4

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + bWith3 + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          bWith3 = if h == 0 then 0 else abs $ b - h
          ok   | r > 0 || b > 0 = 1
               | otherwise      = 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

import Data.List

main = do
    n <- getLine
    line <- getLine
    let nums = map toInt (words line)
    print $ process nums 0

process :: [Int] -> Int -> Int
process nums k
    | nums == [] = k
    | filter (==4) nums /= [] = process (filter (/=4) nums) (length (filter (==4) nums) + k)
    | filter (==3) nums /= [] && filter (==1) nums /= [] = process (drop p (filter (==3) nums) ++ drop p (filter (==1) nums) ++ (filter (==2) nums)) (k + p)
    | filter (==2) nums /= [] && (length (filter (==2) nums) == 2) = process (filter (/=2) nums) (k + 1)
    | filter (==2) nums /= [] && (length (filter (==2) nums) > 1) = process (drop l (filter (==2) nums) ++ (filter (==1) nums)++ (filter (==3) nums)) (k + l)
    | filter (==1) nums /= [] && filter (==2) nums /= [] = process (drop z (filter (==2) nums) ++ drop z (filter (==1) nums) ++ (filter (==3) nums)) (k + z)
    | filter (==1) nums /= [] && (length (filter (==1) nums) >= 4) = process (drop 4 (filter (==1) nums)) (k + 1)
    | filter (==1) nums /= [] && (length (filter (==1) nums) > 1) = process (drop f nums) (k + 1)
    | otherwise = process (tail nums) (k + 1)
        where
            p = equalResult (filter (==3) nums) (filter (==1) nums)
            l = (length (filter (==2) nums)) `div` 2
            z = equalResult (filter (==2) nums) (filter (==1) nums)
            f = (length (filter (==1) nums))

equalResult :: [Int] -> [Int] -> Int
equalResult a b
    | a < b = length a
    | otherwise = length b

toInt :: String -> Int
toInt = read

main = do
  getLine
  gr <-getLine
  let
    groups = map read $ words gr
    n1 = length $ filter (==1) groups
    n2 = length $ filter (==2) groups
    n3 = length $ filter (==3) groups
    n4 = length $ filter (==4) groups
    n21 = (n2 + 1)`div`2
    n11 = if (n2 `mod` 2 /= 0) then
        n1 - n3 - 1
      else
        n1 - n3
    n12 = if (n11 > 0) then
        (n11+3) `div` 4
      else
        0
  putStrLn $ show (n4 + n3 + n21 + n12)

import Data.List

main :: IO()
main = interact $ show . solve . map (read) . words

solve :: [Int] -> Int
solve (n : xs) =
    d + cal a b c
    where
        (a : b : c : d:_) = map ((subtract 1) . length) . group . sort $ (1:2:3:4:xs)

cal :: Int -> Int -> Int -> Int
cal a b c
    | c > 0 =
        let
            k = min a c
        in
            c + cal (a - k) b 0
    | b > 0 =
        let
            k = min b (div a 2)
        in
            k + (ceilDiv (b - k) 2) + cal (a - 2 * k) 0 0
    | a > 0 =
            (ceilDiv a 4)
    | otherwise = 0

ceilDiv a b = div (a + b - 1) b

main = do
    line <- getLine
    let groups = (map read . words) line :: [Int]
    putStrLn (show $ minCars groups)

minCars :: [Int] -> Int
minCars nums = let
    ofNum n = length . filter (n==) $ nums
    amounts = map ofNum [0..4]
    cars' = (amounts !! 4) + (amounts !! 3) + div (1 + amounts !! 2) 2
    free1s = (amounts !! 3) + 2 * (mod (amounts !! 2) 2)
    in if (amounts !! 1) > free1s then cars'
    else cars' + div (3 - free1s + amounts !! 1) 4

module Main where
import System.IO
import Data.List
import Data.Maybe
import Debug.Trace

main = do s <- hGetContents stdin
          print $ solve $ map read $ words s

s :: (Show a) => String -> a -> a
s m x = x

solve :: [Int] -> Int
solve (n:xs) = fours + _31 + (threes - _31) + _22 + _21 + _11 + _11L
    where items = map (\x -> (head x, length x)) $ group $ sort xs
          ones = fromMaybe 0 $ fmap snd $ find ((1==).fst) items
          twos = fromMaybe 0 $ fmap snd $ find ((2==).fst) items
          threes = fromMaybe 0 $ fmap snd $ find ((3==).fst) items
          fours = fromMaybe 0 $ fmap snd $ find ((4==).fst) items
          _31 = s "_31" $ max threes ones
          _22 = s "_22" $ div twos 2
          _21 = s "_21" $ if twos - _22*2 > 0 then 1 else 0
          _11 = s "_11" $ div (if _21 > 0 then max (ones - _31 - 2) 0 else (ones - _31)) 4
          _11L = s "_11L" $ if ones - _31 - _11*4 > 0 then 1 else 0

enc :: [Int] -> Int -> Int
enc s a = length $ filter (==a) s

taxis :: [Int] -> Int
taxis s = fours + threesOnes + twosTwos + onesTwos + leftOnes2 + fourOnes + (threes - threesOnes)
  where ones = enc s 1
        twos = enc s 2
        threes = enc s 3
        fours = enc s 4
        threesOnes = min ones threes
        twosTwos = twos `div` 2
        onesTwos = twos `mod` 2
        leftOnes = if (ones - threesOnes) > 2 then (ones - threesOnes - 2) else 0
        fourOnes = leftOnes `div` 4
        leftOnes2 = if leftOnes `mod` 4 > 0 then 1 else 0

main = do getLine
          numbers <- fmap (map read . words) getLine
          (putStrLn . show . taxis) numbers

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min b h + rest3 + rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          rest1 = b - min b h
          rest3 = max 0 $ h - min b h
          rest | rest1 > 0 || r > 0 = 1 + (rest1 + 2*r) `div` 4
               | otherwise          = 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = print . solve . map read . tail . words =<< getContents
solve ss = n4 + n3 + n2 `div` 2 + if odd n2 then 1 else 0 + (n1'' + 3) `div` 4
    where n1 = length (filter (==1) ss)
          n2 = length (filter (==2) ss)
          n3 = length (filter (==3) ss)
          n4 = length (filter (==4) ss)
          n1' = max (n1 - n3) 0
          n1'' = if odd n2 then max (n1' -2) 0 else n1'

main = do
    line <- getLine
    let groups = (map read . words) line :: [Int]
    putStrLn (show $ minCars groups)

minCars :: [Int] -> Int
minCars nums = let
    ofNum n = length . filter (n==) $ nums
    amounts = map ofNum [0..4]
    cars' = (amounts !! 4) + (amounts !! 3) + div (1 + amounts !! 2) 2
    free1s = (amounts !! 3) + 2 * (mod (amounts !! 2) 2)
    in if free1s > (amounts !! 1) then cars'
    else cars' + div (3 - free1s + amounts !! 1) 4

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          ok = if b > 0 then 1 else 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)
    where count = map (pred . length) . group . sort . ([1..4]++) . map read . words

import Data.List (foldl')
main :: IO ()
main = do
    _ <- getLine
    ss <- getLine
    let groups = map read $ words ss
    print $ taxiSplit groups
    return ()

taxiSplit :: [Int] -> Int
taxiSplit = countCabs . (foldl' (groupSize) (0,0,0,0))
  where groupSize (a,b,c,d) x = case x of
                                  1 -> (a + 1, b, c, d)
                                  2 -> (a, b + 1, c, d)
                                  3 -> (a, b, c + 1, d)
                                  4 -> (a, b, c, d + 1)

countCabs :: (Int, Int, Int, Int) -> Int
countCabs (0, 0, 0, 0) = 0
countCabs (a, 0, 0, 0) = (a `quot` 4) + (if a `rem` 4 > 0 then 1 else 0)
countCabs (0, b, c, 0) = let b' = quot b 2 in
  b' + c + (if odd b then 1 else 0)
countCabs (a, b, 0, 0) = let b' = quot b 2 in
  b' + (if even b then a else if a < 3 then 1 else countCabs (a - 2, 0, 0, 0))
countCabs (a, b, c, 0) = let x = min a c in
  x + countCabs (a - x,b,c - x,0)
countCabs (a, b, c, d) = d + countCabs (a,b,c,0)

import Data.List (sort, group)

readInts :: IO [Int]
readInts = fmap (map read . words) getLine

frequency :: Ord a => [a] -> [(a, Int)]
frequency xs = map (\ys -> (head ys, length ys)) $ group . sort $ xs

lookupOr :: Eq a => b -> [(a, b)] -> a -> b
lookupOr d xs x = case lookup x xs of
    (Just y) -> y
    Nothing -> d

infixl 7 //
a // b = (ceiling $ (fromIntegral a) / b)

main :: IO ()
main = do
    getLine
    xs <- readInts
    let ys = frequency xs
    let a : b : c : d : [] = map (lookupOr 0 ys) [1..4]
    let t = a - c
    let h = d + c + if t < 0 then b // 2 else
           if b > t then
               t + (b - t) // 2
           else
               b + (t - b) // 4
    print h

main :: IO ()
main = do
    n <- getLine
    inputs <- fmap (map read.words) getLine
    let [a,b,c,d] = map (\x -> length $ filter (==x) inputs) [1,2,3,4]
    print $ d + c + (b*2 + 3 + (max 0 (a - c)) `div` 4)

import Data.List (foldl')
main :: IO ()
main = do
    _ <- getLine
    ss <- getLine
    let groups = map read $ words ss
    print $ taxiSplit groups
    return ()

taxiSplit :: [Int] -> Int
taxiSplit = countCabs . (foldl' (groupSize) (0,0,0,0))
  where groupSize (a,b,c,d) x = case x of
                                  1 -> (a + 1, b, c, d)
                                  2 -> (a, b + 1, c, d)
                                  3 -> (a, b, c + 1, d)
                                  4 -> (a, b, c, d + 1)

countCabs :: (Int, Int, Int, Int) -> Int
countCabs (0, 0, 0, 0) = 0
countCabs (a, 0, 0, 0) = (a `quot` 4) + (if a `rem` 4 > 1 then 1 else 0)
countCabs (0, b, c, 0) = let b' = quot b 2 in
  b' + c + (if odd b then 1 else 0)
countCabs (a, b, 0, 0) = let b' = quot b 2 in
  b' + (if even b then a else if a < 3 then 1 else a - 2)
countCabs (a, b, c, 0) = let x = min a c in
  x + countCabs (a - x,b,c - x,0)
countCabs (a, b, c, d) = d + countCabs (a,b,c,0)

-- -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
-- File Name : 0001A.hs
-- Creation Date : 17-10-2012
-- Last Modified : Fri 19 Oct 2012 06:25:57 PM EEST
-- Created By : Greg Liras <gregliras@gmail.com>
--_._._._._._._._._._._._._._._._._._._._._.

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.List (sort)

countBy ls cond= length $ filter cond ls

count ls k = countBy ls (\s -> s == k)

kth ls k = head $ drop k ls
remaining ls k =
    let
        limit = kth (sort ls) k
    in
        countBy ls (\s -> s >= limit && s > 0)

calcrem1s c3s c1s =
    if c3s >= c1s
        then
            0
        else
            c1s-c3s

posORZero num =
    if num >= 0
        then
            num
        else
            0

calc groups =
        let c2s     = count groups 2
            rem1s   = posORZero $ (count groups 1) - (count groups 3)
        in
            let
                rem2s = c2s `mod` 2
            in
                let
                    finalrem1s =
                        if rem2s == 1
                            then
                                posORZero $ rem1s - 2
                            else
                                rem1s
                in
                    (count groups 4) + (count groups 3) + (ceiling $ fromIntegral(c2s) / 2) + (ceiling $ fromIntegral(finalrem1s) / 4)

main :: IO ()
main =
    do
        all <- BS.getContents
        let Just (n, r1)    = readInt all
        let (groups, _)     = readMany readInt r1
        print groups
        print $ calc groups
    where
        readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany readf s = case readf s of
            Just (x, r) ->  let
                                (xs, t) = readMany readf r
                            in
                                (x : xs, t)
            Nothing     ->  ([], s)

main = do
	n <- getLine
	args <- getList ' '
	putStrLn $ show $ calc . parseGroups $ args

getList::Char -> IO [String]
getList sep = do
	input <- getLine
	return $ split input sep

split::String -> Char -> [String]
split str sep = foldr (\curr acc -> if curr == sep then "":acc
									else (curr:(head acc)):(tail acc) ) [""] str

calc::[Int] -> Int
calc groups = do
	let fours = groups !! 3
	let threes = groups !! 2
	let twos = ceiling . (/ 2) . fromIntegral $ groups !! 1
	let ones = ceiling . (/ 4) . fromIntegral $ groups !! 0 - threes - (twos `mod` 2 * 2)
	fours + threes + twos + if ones > 0 then ones else 0

parseGroups::[String] -> [Int]
parseGroups args = foldr (\curr acc -> if curr == "1" then [ acc !! 0 + 1, acc !! 1, acc !! 2, acc !! 3 ]
									 else if curr == "2" then [ acc !! 0, acc !! 1 + 1, acc !! 2, acc !! 3 ]
									 else if curr == "3" then [ acc !! 0, acc !! 1, acc !! 2 + 1, acc !! 3 ]
									 else [ acc !! 0, acc !! 1, acc !! 2, acc !! 3 + 1 ]) [0,0,0,0] args

-- Codeforces 158A

main :: IO()
main = interact $ show . solve . map read . words

{-- interact:
 - interact :: (String -> String) -> IO()
 - The interact function takes a function of type String->String as its argument.
 - The entire input from the standard input device is passed to this function as
 - its argument, and the resulting string is output on the standard output device.
--}

solve :: [Int] -> Int
solve (_:k:x) = sum[1 | i <- x, x!!(k-1) <= i, i > 0]

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] = f + h + q + a + r + rest
    where (q,r) = divMod t 2
          rest1 = o - h - 2*r
          (a,b) = divMod rest1 4
          rest  = if b > 0 then 1 else 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = do
  irrelevant <- getLine
  input <- getLine
  let list = map read (words input)
  let (a,b,c,d) = (countN list 1, countN list 2, countN list 3, countN list 4)
  let b2 = b `div` 2
  let c2 = if c>=a then c else c + a `div` 4
  let a2 | a>c && (a-c) `mod` 4 == 3 && odd b  = 2
         | a>c && (a-c) `mod` 4 == 3 && even b = 1
         | a>c                                 = 1
         | odd b                               = 1
         | otherwise                           = 0
  let answer = d + b2 + c2 + a2
  putStrLn (show answer)

countN xs n = length (filter (\x -> x==n) xs)

module Main where

type Counts = (Int, Int, Int, Int)

countChildren :: Counts -> [Int] -> Counts
countChildren c [] = c
countChildren (on, tw, th, fo) (x: xs)
  | x == 1 = countChildren (on + 1, tw, th, fo) xs
  | x == 2 = countChildren (on, tw + 1, th, fo) xs
  | x == 3 = countChildren (on, tw, th + 1, fo) xs
  | x == 4 = countChildren (on, tw, th, fo + 1) xs
  | otherwise = (on, tw, th, fo)

main :: IO ()
main = do
  _ <- fmap read getLine :: IO Int
  inp <- fmap words getLine :: IO [String]
  let s = fmap read inp :: [Int]
      (ones, twos, threes, fours) = countChildren (0, 0, 0, 0) s
      (coupleTwos, loneTwos) = twos `quotRem` 2
      (coupleOnes, loneOnes) = max (ones - threes) 0 `quotRem` 2
      (foursOnes, leftOnes) = (max (coupleOnes - loneTwos) 0 * 2 + loneOnes) `quotRem` 4
      (remCabs, remChild) = (loneTwos * 2 + leftOnes ) `quotRem` 4
      res1 = fours +                     -- fours take a cab to themselves
        min ones threes +                -- combine threes and ones to one cab
        max (threes - ones) 0 +          -- remaining threes each take one cab
        coupleTwos +                     -- twos can combine with themselves
        min coupleOnes loneTwos +        -- combine remaining twos with couples of ones
        foursOnes +                      -- group remaining ones into 4 per cab
        remCabs +                        -- fit any remaining twos and ones in a cab
        if remChild > 0 then 1 else 0    -- any children left can fit in last 1 cab

  print res1

import Data.List

solve :: [Int] -> Int
solve xs = c4 + c3 + c2 `div` 2 + countRest c1 c2 c3 c4
           where
            (c1, c2, c3, c4) = foldl' (\acc x -> countNumbers acc x) (0,0,0,0) xs
            countNumbers (a1, a2, a3, a4) x | x == 1 = (a1 + 1, a2, a3, a4)
                                            | x == 2 = (a1, a2 + 1, a3, a4)
                                            | x == 3 = (a1, a2, a3 + 1, a4)
                                            | x == 4 = (a1, a2, a3, a4 + 1)
            countRest a1 a2 a3 a4 = let a1With3 = if (a3 > a1) then a1 else a3
                                        a1AfterSittingWith3 = a1 - a1With3
                                        a1With2 = if (a2 `mod` 2 == 1 && a1AfterSittingWith3 > 0) then min a1AfterSittingWith3 2 else 0
                                        a1AfterSittingWith2 = a1AfterSittingWith3 - a1With2
                                        a1With1 = a1AfterSittingWith2 - a1AfterSittingWith2 `mod` 4
                                        a1AfterSittingWith1 = a1AfterSittingWith2 - a1With1
                                    in a1With1 `div` 4 + (if (a1AfterSittingWith1 > 0) then 1 else 0) + (if (a1With2 == 0 && a2 `mod` 2 == 1) then 1 else 0)

main = do
    getLine
    xs <- fmap (map read . words) getLine
    print $ solve xs

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          ok   | b > 0 && h /= 0  = 1
               | b == 0 && h == 0 = 1
               | otherwise        = 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = do
    line <- getLine
    let groups = (map read . words) line :: [Int]
    putStrLn (show $ minCars groups)

minCars :: [Int] -> Int
minCars nums = let
    ofNum n = length . filter (n==) $ nums
    amounts = map ofNum [0..4]
    cars' = (amounts !! 4) + (amounts !! 3) + div (1 + amounts !! 2) 2
    free1s = (amounts !! 3) + 2 * (mod (amounts !! 2) 2)
    in if free1s >= (amounts !! 1) then cars'
    else cars' + div (3 - free1s + amounts !! 1) 4

main = do
  irrelevant <- getLine
  input <- getLine
  let list = map read (words input)
  let (a,b,c,d) = (countN list 1, countN list 2, countN list 3, countN list 4)
  let b2 = b `div` 2
  let c2 = if c>=a then c else c + a `div` 4
  let a2 | a>c && (a-c) `mod` 4 == 3 && odd b  = 2
         | a>c && (a-c) `mod` 4 == 3 && even b = 1
         | a>c && (a-c) `mod` 4 == 2 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 2 && even b = 1
         | a>c && (a-c) `mod` 4 == 1 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 1 && even b = 1
         | a>c && (a-c) `mod` 4 == 0 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 0 && even b = 0
         | odd b                               = 1
         | otherwise                           = 0
  let answer = d + b2 + c2 + a2
  putStrLn (show answer)

countN xs n = length (filter (\x -> x==n) xs)

module Main
    where

import Data.List (sort, group)

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)
    where count = map (pred . length) . group . sort . ([1..4]++) . map read . words
          numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
            where (q,r) = divMod t 2
                  (a,b) = divMod o 4
                  ok = if b > 0 then 1 else 0
                  rest = if b - h > 0 && b + 2*r <= 4
                            then 1
                            else 2

import Data.List

main = do
    n <- getLine
    line <- getLine
    let nums = map toInt (words line)
    print $ process nums 0

process :: [Int] -> Int -> Int
process nums k
    | nums == [] = k
    | filter (==4) nums /= [] = process (filter (/=4) nums) (length (filter (==4) nums) + k)
    | filter (==3) nums /= [] && filter (==1) nums /= [] = process (drop p (filter (==3) nums) ++ drop p (filter (==1) nums) ++ (filter (==2) nums)) (k + p)
    | filter (==2) nums /= [] && (length (filter (==2) nums) == 2) = process (filter (/=2) nums) (k + 1)
    | filter (==2) nums /= [] && (length (filter (==2) nums) > 1) = process (drop l (filter (==2) nums) ++ (filter (==1) nums)++ (filter (==3) nums)) (k + l)
    | filter (==1) nums /= [] && filter (==2) nums /= [] = process (drop z (filter (==2) nums) ++ drop z (filter (==1) nums) ++ (filter (==3) nums)) (k + z)
    | filter (==1) nums /= [] && (length (filter (==1) nums) >= 4) = process (drop d (filter (==1) nums)) (k + l)
    | filter (==1) nums /= [] && (length (filter (==1) nums) > 1) = process (drop f nums) (k + 1)
    | otherwise = process (tail nums) (k + 1)
        where
            p = equalResult (filter (==3) nums) (filter (==1) nums)
            l = (length (filter (==2) nums)) `div` 2
            z = equalResult (filter (==2) nums) (filter (==1) nums)
            d = (length (filter (==1) nums)) `div` 4
            f = (length (filter (==1) nums))

equalResult :: [Int] -> [Int] -> Int
equalResult a b
    | a < b = length a
    | otherwise = length b

toInt :: String -> Int
toInt = read

main = do
    n <- getLine
    xs <- getLine
    let ys = [read x::Int | x <- words(xs)]
    print $ f $ [length $ filter (==i) ys | i <- [1..4]]

f xs = a4 + a3 + div (a2 + 1) 2 + div (max 0 (a1 - a4 - 2 * mod a2 2 + 3)) 4
    where
    a4 = xs !! 3
    a3 = xs !! 2
    a2 = xs !! 1
    a1 = xs !! 0

main = do
  _ <- getLine
  groups <- getLine

  print $ (show :: Int -> String) 4

import Data.List (sortBy)

taxi :: [Int] -> Int
taxi = taxiGrouper 0 [] -- . sortBy (flip compare)

taxiGrouper :: Int -> [Int] -> [Int] -> Int
taxiGrouper groups fall@(f:fs) (p:ps)
	| f >= p = taxiGrouper groups (insert (f-p) fs) ps
	| otherwise = taxiGrouper (groups + 1) (insert (4-p) fall) ps
taxiGrouper groups _ (p:ps) = taxiGrouper (groups + 1) (insert (4-p) []) ps
taxiGrouper groups _ _ = groups

insert :: Int -> [Int] -> [Int]
insert x (y:ys) = if x < y then y : (insert x ys) else x:y:ys
insert x _ = [x]

main = do
	getLine
	getLine >>= print . taxi . (map read) . words

module Main where

import Data.Maybe
import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (show . solve . map read . words . (!! 1) . lines)

solve :: [Int] -> Int
solve groups = sum [four, threePlusOne, twoPlusTwo, three', twoPlusOnes, one''] where
    one'' = if two' == 1 then max 0 (one' - 2) else one'
    twoPlusOnes = if two' == 1 then 1 else 0
    (one', two', three') = (one - threePlusOne, two `mod` 2, three - threePlusOne)
    twoPlusTwo = two `div` 2
    threePlusOne = min three one
    [one, two, three, four] = [length (filter (== x) groups) | x <- [1..4]]

import Data.List (sort, group)

readInts :: IO [Int]
readInts = fmap (map read . words) getLine

frequency :: Ord a => [a] -> [(a, Int)]
frequency xs = map (\ys -> (head ys, length ys)) $ group . sort $ xs

lookupOr :: Eq a => b -> [(a, b)] -> a -> b
lookupOr d xs x = case lookup x xs of
    (Just y) -> y
    Nothing -> d

main :: IO ()
main = do
    getLine
    xs <- readInts
    let ys = frequency xs
    let f = lookupOr 0 ys
    let a : b : c : d : [] = map f [1..4]
    print $ d + c + max (ceiling $ (fromIntegral $ a - c) / 4) (ceiling $ (fromIntegral b) / 2)

import Data.Sequence
import Data.Foldable

getGroups :: IO [Integer]
getGroups = do
    _groups <- getLine
    return $ map read (words _groups)

getAnswer :: [Integer] -> Integer
getAnswer groups = quantify $ count groups

count :: [Integer] -> [Integer]
count groups = _count groups [0, 0, 0, 0]

_count :: [Integer] -> [Integer] -> [Integer]
_count [] counter = counter
_count (first:rest) counter = _count rest $ toList $ update position ((counter !! position) + 1) $ fromList counter
    where position = fromIntegral first - 1

quantify :: [Integer] -> Integer
quantify counter = getQuarters + getTriplesAndOnes + getDoubles + getRest
    where ones = head counter
          twos = head $ tail counter
          threes = head $ tail $ tail counter
          fours = last counter
          getQuarters = fours
          getTriplesAndOnes = threes
          onesWithoutThrees = if ones > threes
                              then ones - threes
                              else 0
          (getDoubles, onesRest) = quantifyDoubles twos onesWithoutThrees
          getRest = onesRest `div` 4 + if onesRest `mod` 4 > 0
                                       then 1
                                       else 0

quantifyDoubles :: Integer -> Integer -> (Integer, Integer)
quantifyDouble 0 ones = (0, ones)
quantifyDoubles twos ones = (countedTwos, onesRest)
    where countedTwos = twos `div` 2 + twos `mod` 2
          onesRest = if ones >= 2
                     then ones - 1
                     else 0

main :: IO ()
main = do
    n <- getLine
    groups <- getGroups
    print $ getAnswer groups

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

getIntArray :: IO[Int]
getIntArray = fmap ((map read).words) getLine

main = interact$show.s.(map read).words

s :: [Int] -> Int
s (x:xs) = ((sum xs) - 1) `div` 4 + 1

main = do
  getLine
  aa <- getLine
  let xs = map read $ words aa :: [Int]
  print $ ceiling $ fromIntegral (length xs) / 4

main :: IO ()
main = do
    n <- fmap read getLine :: IO Integer
    si <- fmap (map read . words) getLine :: IO [Int]
    print $ fillCars $ groups $ si

fillCars :: [Int] -> Int
fillCars g = g4 +
    min g3 g1 +
    max (g3 - (min g3 g1)) 0 +
    div g2 2 + (mod g2 2) +
    div g1' 4 + (mod g1' 4)
    where
        g1 = g !! 0
        g2 = g !! 1
        g3 = g !! 2
        g4 = g !! 3
        g1' = max (g1 - (min g3 g1) - ((mod g2 2) * 2)) 0

groups :: [Int] -> [Int]
groups [] = [0,0,0,0]
groups (x:xs) = [b 1, b 2, b 3, b 4]
    where b = \i -> groups xs !! (i-1) + (if x == i then 1 else 0)

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min b h + rest3 + rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          rest1 = b - min b h
          rest3 = max 0 $ h - min b h
          rest = 1 + (rest1 + 2*r) `div` 4

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = interact $ show . solve . map read . words
solve (_ : k : xs) = length . takeWhile (>= xs !! (k - 1)) . filter (> 0) $ xs

increaseNth :: [Int] -> Int -> [Int]
increaseNth xs n = take n xs ++ [((xs !! n) + 1)] ++ drop (n + 1) xs

countArrAss :: [Int] -> [Int] -> [Int]
countArrAss [] after = after
countArrAss (x:pre) after = countArrAss pre (increaseNth  after (x - 1))

countArr :: [Int] -> [Int]
countArr da = countArrAss da [0, 0, 0, 0]

preProcess :: [Char] -> [Int]
preProcess s = countArr $ map read (words s)

sol :: [Int] -> Int
sol xs = prefix4th + prefix3th + prefix2th + prefix1th
    where prefix4th = (xs !! 3)
          prefix3th = (xs !! 2)
          prefix1sub3 = (xs !! 0) - (xs !! 2)
          prefix2th = div (xs !! 1) 2
          prefix2remain = mod (xs !! 1) 2
          prefix1sub3sub2 = prefix1sub3 - 2 * prefix2remain
          prefix1th = ceiling ((fromIntegral prefix1sub3sub2) / 4)

main = do
        n <- getLine
        groups <- getLine
        putStrLn $ show (sol (preProcess groups))

main = do
  irrelevant <- getLine
  input <- getLine
  let list = map read (words input)
  let (a,b,c,d) = (countN list 1, countN list 2, countN list 3, countN list 4)
  let b2 = b `div` 2
  let c2 = if c>=a then c else c + a `div` 4
  let a2 | a>c && (a-c) `mod` 4 == 3 && odd b  = 2
         | a>c && (a-c) `mod` 4 == 3 && even b = 1
         | a>c && (a-c) `mod` 4 == 2 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 2 && even b = 1
         | a>c && (a-c) `mod` 4 == 1 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 1 && even b = 1
         | a>c && (a-c) `mod` 4 == 0 && odd b  = 1
         | a>c && (a-c) `mod` 4 == 0 && even b = 0
         | odd b                               = 1
         | otherwise                           = 0
  let answer = d + b2 + c2 + a2
  putStrLn (show answer)

countN xs n = length (filter (\x -> x==n) xs)

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] = f + h + q + a + r + rest
    where (q,r) = divMod t 2
          rest1 = o - h - 2*r
          (a,b) = divMod rest1 4
          rest  = if b > 0 then 1 else 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min o h + rest3 + rest
    where (q,r) = divMod t 2
          rest1 = max 0 $ o - min o h
          rest3 = max 0 $ h - min o h
          (a,b) = divMod rest1 4
          rest | b > 0 || r > 0 = 1 + (a + 2*r) `div` 4
               | otherwise          = 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

import Data.Sequence
import Data.Foldable

getGroups :: IO [Integer]
getGroups = do
    _groups <- getLine
    return $ map read (words _groups)

getAnswer :: [Integer] -> Integer
getAnswer groups = quantify $ count groups

count :: [Integer] -> [Integer]
count groups = _count groups [0, 0, 0, 0]

_count :: [Integer] -> [Integer] -> [Integer]
_count [] counter = counter
_count (first:rest) counter = _count rest $ toList $ update position ((counter !! position) + 1) $ fromList counter
    where position = fromIntegral first - 1

quantify :: [Integer] -> Integer
quantify counter = getQuarters + getTriplesAndOnes + getDoubles + getRest
    where ones = head counter
          twos = head $ tail counter
          threes = head $ tail $ tail counter
          fours = last counter
          getQuarters = fours
          getTriplesAndOnes = threes
          onesWithoutThrees = if ones > threes
                              then ones - threes
                              else 0
          (getDoubles, onesRest) = quantifyDoubles twos onesWithoutThrees
          getRest = onesRest `div` 4 + if onesRest `mod` 4 > 0
                                       then 1
                                       else 0

quantifyDoubles :: Integer -> Integer -> (Integer, Integer)
quantifyDoubles 0 ones = (0, ones)
quantifyDoubles twos ones = (countedTwos, onesRest)
    where countedTwos = twos `div` 2 + twos `mod` 2
          onesRest = if ones >= 2 && twos `mod` 2 == 1
                     then ones - 2
                     else ones

main :: IO ()
main = do
    n <- getLine
    groups <- getGroups
    print $ getAnswer groups

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + bWith3 + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          bWith3 = if h == 0 then 0 else abs $ b - h
          rest3 = b - min b h
          ok   | r > 0 || b > 0 = 1
               | otherwise      = 0
          rest | rest3 - h == 0   = r
               | rest3 + 2*r <= 4 = 1
               | otherwise        = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

import Data.List (sort, group)

readInts :: IO [Int]
readInts = fmap (map read . words) getLine

frequency :: Ord a => [a] -> [(a, Int)]
frequency xs = map (\ys -> (head ys, length ys)) $ group . sort $ xs

lookupOr :: Eq a => b -> [(a, b)] -> a -> b
lookupOr d xs x = case lookup x xs of
    (Just y) -> y
    Nothing -> d

infixl 7 //
a // b =   (ceiling $ (fromIntegral a) / b)

main :: IO ()
main = do
    getLine
    xs <- readInts
    let ys = frequency xs
    let a : b : c : d : [] = map (lookupOr 0 ys) [1..4]
    print $ d + c + b // 2 + if a > c then (a - c) // 4 else 0

import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= print . solve . map (fst . fromJust . B.readInt) . B.words . (!!1) . B.lines

solve :: [Int] -> Int
solve = go . count (0, 0, 0, 0)
  where go (0, 0, 0, n) = (n + 3) `div` 4
        go (0, 0, n, k) = (n + 1) `div` 2 + go (0, 0, 0, max 0 (k - n `mod` 2))
        go (0, n, k, l) = n + go (0, 0, k, max 0 (l - n))
        go (n, k, l, m) = n + go (0, k, l, m)
        count (a, b, c, d) (4:ss) = count (a + 1, b, c, d) ss
        count (a, b, c, d) (3:ss) = count (a, b + 1, c, d) ss
        count (a, b, c, d) (2:ss) = count (a, b, c + 1, d) ss
        count (a, b, c, d) (1:ss) = count (a, b, c, d + 1) ss
        count x _ = x

taxi :: [Int] -> Int
taxi s = t4 + t31 + t3 + t2 + t21 + t1
  where t4 = count 4 s
        t31 = min c3 c1
        t3 = c3 - t31
        t2 = div c2 2
        t21 = rem c2 2
        t1 = max (c1 - t31 - t21 * 2) 0
        c1 = count 1 s
        c2 = count 2 s
        c3 = count 3 s
        count x = length . filter (==x)

main = do
  getLine
  s <- getLine
  print $ taxi $ map read $ words s

{-
B. Taxi
=======
time limit per test 3 seconds
memory limit per test 256 megabytes
input standard input
output standard output

After the lessons n groups of schoolchildren went outside and decided to visit Polycarpus to celebrate his birthday. We know that the i-th group consists of si friends (1 ≤ si ≤ 4), and they want to go to Polycarpus together. They decided to get there by taxi. Each car can carry at most four passengers. What minimum number of cars will the children need if all members of each group should ride in the same taxi (but one taxi can take more than one group)?

Input
------
The first line contains integer n (1 ≤ n ≤ 10^  5) — the number of groups of schoolchildren. The second line contains a sequence of integers s1, s2, ..., sn (1 ≤ si ≤ 4). The integers are separated by a space, si is the number of children in the i-th group.

Output
-------
Print the single number — the minimum number of taxis necessary to drive all children to Polycarpus.

Sample test(s)
--------------
input
```
5
1 2 4 3 3
```
output
```
4
```
input
```
8
2 3 4 4 2 1 3 1
```
output
```
5
```
Note
In the first test we can sort the children into four cars like this:

- the third group (consisting of four children),
- the fourth group (consisting of three children),
- the fifth group (consisting of three children),
- the first and the second group (consisting of one and two children, correspondingly).
There are other ways to sort the groups into four cars.
-}

import Data.List (sort, group)

count :: Int -> [Int] -> Int
count k xs = length $ filter (== k) xs

taxiNumber :: [Int] -> Int
taxiNumber xs = n4 + n3 + ceiling (fromIntegral n2 / 2) + max 0 (n1 - n3 - 2 * (n2 `mod` 2)) `div` 4
  where [n1, n2, n3, n4] = map (`count` xs) [1,2,3,4]

reader :: String -> [Int]
reader s = map read $ words second
  where [_, second] = lines s

main = do
  input <- getContents
  let xs = reader input
  print $ taxiNumber xs

import Data.List (sort)

taxi :: [Int] -> Int
taxi xs = taxiGrouper 0 sorted $ reverse sorted
	where sorted = sort xs

taxiGrouper :: Int -> [Int] -> [Int] -> Int
taxiGrouper groups [x] [y] = groups + 1
taxiGrouper groups xall@(x:xs) yall@(y:ys) = taxiGrouper (groups + 1) newxs newys
	where (newxs, newys)
		| x + y <= 4 = (init xs, init ys)
		| x == 4 || x > y = (xs, init yall)
		| otherwise = (init xall, ys)
taxiGrouper groups _ _ = groups

main = do
	getLine
	getLine >>= print . taxi . (map read) . words

import Data.List (sort, group)

readInts :: IO [Int]
readInts = fmap (map read . words) getLine

frequency :: Ord a => [a] -> [(a, Int)]
frequency xs = map (\ys -> (head ys, length ys)) $ group . sort $ xs

lookupOr :: Eq a => b -> [(a, b)] -> a -> b
lookupOr d xs x = case lookup x xs of
    (Just y) -> y
    Nothing -> d

main :: IO ()
main = do
    getLine
    xs <- readInts
    let ys = frequency xs
    let f = lookupOr 0 ys
    let a : b : c : d : [] = map f [1..4]
    print $ d + c + max (a - c) (ceiling $ (fromIntegral b) / 2)

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min o h + rest3 + rest
    where (q,r) = divMod t 2
          rest1 = max 0 $ o - min o h
          rest3 = max 0 $ h - min o h
          (a,b) = divMod rest1 4
          rest | b > 0 || r > 0 = 1 + (a + 2*r) `div` 4
               | otherwise          = 0

numTaxi2 :: [Int] -> Int
numTaxi2 [o,t,h,f] = f + q + a + min b h + rest3 + rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          rest1 = max 0 $ b - min b h
          rest3 = max 0 $ h - min b h
          rest | rest1 > 0 || r > 0 = 1 + (a + 2*r) `div` 4
               | otherwise          = 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . num . count =<< (getLine >> getLine)
    where num xs = min (numTaxi xs) (numTaxi2 xs)

main = do
    line <- getLine
    let n = read line :: Int
    line <- getLine
    let ss = take n $ map read $ words line :: [Int]
    putStrLn $ show $ solve ss

solve :: [Int] -> Int
solve ss = c4 + solve' c1 c2 c3
    where
        c1 = count (== 1) ss
        c2 = count (== 2) ss
        c3 = count (== 3) ss
        c4 = count (== 4) ss

solve' :: Int -> Int -> Int -> Int
solve' 0 c2 0 = c2 `divUp` 2
solve' 0 c2 c3 = c2 + c3
solve' c1 0 0 = c1 `divUp` 4
solve' c1 c2 0 | c1 >= 2 * c2  = c2 + solve' (c1 - 2 * c2) 0 0
               | otherwise     = c1 `divUp` 2 + solve' 0 (c2 - c1 `divUp` 2) 0
solve' c1 c2 c3 | c1 >= c3  = c3 + solve' (c1 - c3) c2 0
                | otherwise = c1 + solve' 0 c2 (c3 - c1)

divUp a b = (a - 1) `div` b + 1

count :: (a -> Bool) -> [a] -> Int
count p = length . filter p

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          ok   | b > 0 && h /= 0  = 1
               | b == 0 && h == 0 = 1
               | otherwise        = 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

import Data.List

main = do
    n <- getLine
    line <- getLine
    let nums = map toInt (words line)
    print $ process nums 0

process :: [Int] -> Int -> Int
process nums k
    | nums == [] = k
    | filter (==4) nums /= [] = process (filter (/=4) nums) (length (filter (==4) nums) + k)
    | filter (==3) nums /= [] && filter (==1) nums /= [] = process (drop p (filter (==3) nums) ++ drop p (filter (==1) nums) ++ (filter (==2) nums)) (k + p)
    | filter (==2) nums /= [] && (length (filter (==2) nums) == 2) = process (filter (/=2) nums) (k + 1)
    | filter (==2) nums /= [] && (length (filter (==2) nums) > 1) = process (drop l (filter (==2) nums) ++ (filter (==1) nums)++ (filter (==3) nums)) (k + l)
    | filter (==1) nums /= [] && filter (==2) nums /= [] = process (drop 1 (filter (==2) nums) ++ drop z (filter (==1) nums)) (k + 1)
    | filter (==1) nums /= [] && (length (filter (==1) nums) >= 4) = process (drop 4 (filter (==1) nums)) (k + 1)
    | filter (==1) nums /= [] && (length (filter (==1) nums) > 1) = process (drop f nums) (k + 1)
    | otherwise = process (tail nums) (k + 1)
        where
            p = equalResult (filter (==3) nums) (filter (==1) nums)
            l = (length (filter (==2) nums)) `div` 2
            z = if length (filter (==1) nums) >= 1 && length (filter (==1) nums) < 3 then (length (filter (==1) nums)) else 0
            f = (length (filter (==1) nums))

equalResult :: [Int] -> [Int] -> Int
equalResult a b
    | a < b = length a
    | otherwise = length b

toInt :: String -> Int
toInt = read

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min b h + rest3 + rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          rest1 = b - min b h
          rest3 = max 0 $ h - min b h
          rest | rest1 > 0 || r > 0 = 1 + (rest1 + 2*r) `div` 4
               | otherwise          = 0

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

-- Codeforces 158A

main :: IO()
main = interact $ show . solve . map read . words

{-- interact:
 - interact :: (String -> String) -> IO()
 - The interact function takes a function of type String->String as its argument.
 - The entire input from the standard input device is passed to this function as
 - its argument, and the resulting string is output on the standard output device.
--}

solve :: [Int] -> Int
solve (_:k:x) = sum[1 | i <- x, x!!(k-1) <= i, i > 0]

main = do
        _ <- getLine
        l <- getLine
        putStrLn $ show $ solve $ map read $ words l

-- solve :: [Int] -> Int
-- solve gs = gof 4 gs + gof 3 gs + gof_2 + gof_1
            -- where
                -- gof_2 = let r = gof 2 gs in r `quot` 2 + r `rem` 2
                -- gof_1
                    -- | gof_3_1 < 0   = 0
                    -- | gof_3_2_1 < 0 = 0
                    -- | otherwise     = gof_3_2_1 `quot` 4 + (if gof_3_2_1 `rem` 4 > 0 then 1 else 0)
                      -- where gof_3_1   = gof 1 gs - gof 3 gs
                            -- gof_3_2_1 = gof_3_1 - (if odd gof 2 gs then 2 else 0)

count :: Int -> [Int] -> Int
count x xs = length $ filter (==x) xs

solve :: [Int] -> Int
solve xs = n_4 + n_3 + n_2 + n_1
            where n_4 = count 4 xs
                  n_3 = count 3 xs
                  n_2 = ceiling $ (fromIntegral $ count 2 xs) / 2.0 -- groups of 2 people fit into one more than the # of groupd div 2
                  leftover = (count 1 xs) - n_3 - (n_2 `mod` 2 * 2) -- get the number of single person groups left over after filling up the 3-cars and the odd 2 person car
                  n_1 =  if leftover > 0 then ceiling $ (fromIntegral leftover) / 4.0 else 0

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + min b h + rest3 + rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          rest1 = b - min b h
          rest3 = max 0 $ h - min b h
          rest = 1 + (rest1 + 2*r) `div` 4

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

{-
B. Taxi
=======
time limit per test 3 seconds
memory limit per test 256 megabytes
input standard input
output standard output

After the lessons n groups of schoolchildren went outside and decided to visit Polycarpus to celebrate his birthday. We know that the i-th group consists of si friends (1 ≤ si ≤ 4), and they want to go to Polycarpus together. They decided to get there by taxi. Each car can carry at most four passengers. What minimum number of cars will the children need if all members of each group should ride in the same taxi (but one taxi can take more than one group)?

Input
------
The first line contains integer n (1 ≤ n ≤ 10^  5) — the number of groups of schoolchildren. The second line contains a sequence of integers s1, s2, ..., sn (1 ≤ si ≤ 4). The integers are separated by a space, si is the number of children in the i-th group.

Output
-------
Print the single number — the minimum number of taxis necessary to drive all children to Polycarpus.

Sample test(s)
--------------
input
```
5
1 2 4 3 3
```
output
```
4
```
input
```
8
2 3 4 4 2 1 3 1
```
output
```
5
```
Note
In the first test we can sort the children into four cars like this:

- the third group (consisting of four children),
- the fourth group (consisting of three children),
- the fifth group (consisting of three children),
- the first and the second group (consisting of one and two children, correspondingly).
There are other ways to sort the groups into four cars.
-}

import Data.List (sort, group)

count :: Int -> [Int] -> Int
count k xs = length $ filter (== k) xs

taxiNumber :: [Int] -> Int
taxiNumber xs = n4 + n3 + ceiling (fromIntegral n2 / 2) + max 0 (n1 - n3 - 2 * (n2 `mod` 2))
  where [n1, n2, n3, n4] = map (`count` xs) [1,2,3,4]

reader :: String -> [Int]
reader s = map read $ words second
  where [_, second] = lines s

main = do
  input <- getContents
  let xs = reader input
  print $ taxiNumber xs

import Data.Sequence
import Data.Foldable

getGroups :: IO [Integer]
getGroups = do
    _groups <- getLine
    return $ map read (words _groups)

getAnswer :: [Integer] -> Integer
getAnswer groups = quantify $ count groups

count :: [Integer] -> [Integer]
count groups = _count groups [0, 0, 0, 0]

_count :: [Integer] -> [Integer] -> [Integer]
_count [] counter = counter
_count (first:rest) counter = _count rest $ toList $ update position ((counter !! position) + 1) $ fromList counter
    where position = fromIntegral first - 1

quantify :: [Integer] -> Integer
quantify counter = getQuarters + getTriplesAndOnes + getDoubles + getRest
    where ones = head counter
          twos = head $ tail counter
          threes = head $ tail $ tail counter
          fours = last counter
          getQuarters = fours
          getTriplesAndOnes = threes
          onesWithoutThrees = if ones > threes
                              then ones - threes
                              else 0
          (getDoubles, onesRest) = quantifyDoubles twos onesWithoutThrees
          getRest = onesRest `div` 4 + if onesRest `mod` 4 > 0
                                       then 1
                                       else 0

quantifyDoubles :: Integer -> Integer -> (Integer, Integer)
quantifyDoubles 0 ones = (0, ones)
quantifyDoubles twos ones = (countedTwos, onesRest)
    where countedTwos = twos `div` 2 + twos `mod` 2
          onesRest = if ones >= 2
                     then ones - 1
                     else 0

main :: IO ()
main = do
    n <- getLine
    groups <- getGroups
    print $ getAnswer groups

module Main
    where

import Data.List (sort, group)

numTaxi :: [Int] -> Int
numTaxi [o,t,h,f] | o + 2*t + 3*h + 4*f <= 4 = 1
numTaxi [o,t,h,f] = f + q + a + abs (b - h) + min b h + ok * rest
    where (q,r) = divMod t 2
          (a,b) = divMod o 4
          ok   | r > 0     = 1
               | otherwise = 0
          rest | b - h == 0   = r
               | b + 2*r <= 4 = 1
               | otherwise    = 2

count :: String -> [Int]
count = map (pred . length) . group . sort . ([1..4]++) . map read . words

main :: IO ()
main = print . numTaxi . count =<< (getLine >> getLine)

main = do
  irrelevant <- getLine
  input <- getLine
  let list = map read (words input)
  let (a,b,c,d) = (countN list 1, countN list 2, countN list 3, countN list 4)
  let b2 = b `div` 2
  let c2 = if c>=a then c else c + a `div` 4
  let a2 | a>c && (a-c) `mod` 4 == 3 && odd b  = 2
         | a>c && (a-c) `mod` 4 == 3 && even b = 1
         | a>c                                 = 1
         | odd b                               = 1
         | otherwise                           = 0
  let answer = d + b2 + c2 + a2
  putStrLn (show answer)

countN xs n = length (filter (\x -> x==n) xs)

process :: [Int] -> Int
process xs = n4 + n13 + n22 + n112 + n1111 + n01 + n02 + n03
    where
        [n1,n2,n3,n4] = [length (filter (==x) xs) | x <- [1..4]]
        n13 = min n1 n3
        n1' = n1 - n13
        n3' = n3 - n13
        n22 = n2 `div` 2
        n2' = n2 - n22 * 2
        n112 = min (n1' `div` 2) n2'
        n1'' = n1' - n112 * 2
        n2'' = n2' - n112
        n1111 = n1'' `div` 4
        n1''' = n1'' - n1111 * 4
        n01 = if n1''' > 0 then 1 else 0
        n02 = n2''
        n03 = n3'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    print $ process xs

taxi :: [Int] -> Int
taxi s = t4 + t31 + t3 + t2 + t21 + t1
  where t4 = count 4 s
        t31 = min c3 c1
        t3 = c3 - t31
        t2 = div c2 2
        t21 = rem c2 2
        t1 = max (c1 - t31 - t21 * 2) 0
        c1 = count 1 s
        c2 = count 2 s
        c3 = count 3 s
        count x = length . filter (==x)

main = do
  getLine
  s <- getLine
  print $ taxi $ map read $ words s