import Control.Monad

detect :: String -> Int
detect shape
    | shape == "Tetrahedron" = 4
    | shape == "Cube" = 6
    | shape == "Octahedron" = 8
    | shape == "Dodecahedron" = 12
    | shape == "Icosahedron" = 20

main:: IO()
main = do
    count <- readLn
    items <- replicateM count getLine
    let number = foldl (+) 0 $ (map detect items)
    putStrLn (show number)

main :: IO ()
main = print . solve . tail . words =<< getContents

solve :: [String] -> Int
solve [] = 0
solve (('T':_):sx) = 4 + solve sx
solve (('C':_):sx) = 6 + solve sx
solve (('O':_):sx) = 8 + solve sx
solve (('D':_):sx) = 12 + solve sx
solve (('I':_):sx) = 20 + solve sx

module Main where

main = do
  count <- read <$> getLine
  shapes <- sequence $ replicate count getLine
  print $ sum $ map countFaces shapes

countFaces :: String -> Int
countFaces "Tetrahedron" = 4
countFaces "Cube" = 6
countFaces "Octahedron" = 8
countFaces "Dodecahedron" = 12
countFaces "Icosahedron" = 20

import Control.Monad
import Control.Applicative

solve :: [String] -> Integer
solve [] = 0
solve ("Tetrahedron":xs)    = 4 + solve xs
solve ("Cube":xs)           = 6 + solve xs
solve ("Octahedron":xs)     = 8 + solve xs
solve ("Dodecahedron":xs)   = 12 + solve xs
solve ("Icosahedron":xs)    = 20 + solve xs
solve (_:xs)    = solve xs

main :: IO ()
main = print =<< solve <$> lines <$> getContents

import Control.Applicative
import Control.Monad

sideCount :: String -> Int
sideCount "Tetrahedron"  = 4
sideCount "Cube"         = 6
sideCount "Octahedron"   = 8
sideCount "Dodecahedron" = 12
sideCount "Icosahedron"  = 20

solve :: [String] -> Int
solve list = foldl (+) 0 (map sideCount list)

readListN :: Int -> IO [String]
readListN n = take n <$> words <$> getContents

getInteger :: IO Int
getInteger = (read :: String -> Int) <$> getLine

main :: IO ()
main = print =<< solve <$> (readListN =<< getInteger)

{-# LANGUAGE BlockArguments #-}

import Control.Arrow

main = do { x <- getLine; y <- solve 0 (read x); putStrLn $ show $ y }

sidesOf :: String -> Int
sidesOf "Icosahedron" = 20
sidesOf "Dodecahedron" = 12
sidesOf "Octahedron" = 8
sidesOf "Cube" = 6
sidesOf "Tetrahedron" = 4

solve :: Int -> Int -> IO Int
solve a 0 = return a
solve a n = do { x <- getLine; solve (a + sidesOf x) (n-1) }

import Data.List
import Data.Array
import Data.Ord
import Data.Char

extract (x:xs)=take (read x::Int) xs

f "Cube"=6
f "Tetrahedron"=4
f "Dodecahedron"=12
f "Octahedron"=8
f "Icosahedron"=20

main=interact$show.sum.map f.extract.lines

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>= \n -> (solve =<< forM [1..read n] ( \i -> C.getLine))
solve xs = print $ sum $ map  (\i-> if C.head i =='T' then 4 else if C.head i =='O' then 8 else if C.head i =='I' then 20 else if C.head i =='C' then 6 else 12) xs

import Data.Foldable

main = getLine
   >>= getLines . read
   >>= putStrLn . show . countFaces

getLines::Int -> IO [String]
getLines n = mapM (\_ -> getLine) [1..n]

countFaces::[String] -> Int
countFaces strs = foldr' (\str count -> getFaces str + count) 0 strs
  where getFaces "Tetrahedron" = 4
        getFaces "Cube" = 6
        getFaces "Octahedron" = 8
        getFaces "Dodecahedron" = 12
        getFaces _ = 20

main = getLine
   >>= getLines . read
   >>= putStrLn . show . countFaces

getLines::Int -> IO [String]
getLines n = mapM (\_ -> getLine) [1..n]

countFaces::[String] -> Int
countFaces strs = foldr (\str count -> getFaces str + count) 0 strs
  where getFaces "Tetrahedron" = 4
        getFaces "Cube" = 6
        getFaces "Octahedron" = 8
        getFaces "Dodecahedron" = 12
        getFaces _ = 20

import Text.Printf
import Data.List
import Data.Functor
import Control.Monad
import Prelude

readInt :: String -> Int
readInt = read

polyhedronFaces :: String -> Int
polyhedronFaces "Tetrahedron" = 4
polyhedronFaces "Cube" = 6
polyhedronFaces "Octahedron" = 8
polyhedronFaces "Dodecahedron" = 12
polyhedronFaces "Icosahedron" = 20

main :: IO ()
main = do
    n <- readInt <$> getLine
    polyhedrons <- sequence . replicate n $ getLine
    let answer = sum . map polyhedronFaces $ polyhedrons
    printf "%d" answer

import Control.Applicative
tr 'T' =4
tr 'C' =6
tr 'D' =12
tr 'I' =20
tr 'O' =8

main=do
  getLine
  x<-sum <$> map tr <$> map head <$> lines <$> getContents
  print x

import Data.Maybe
main = interact $ show . solve
solve = sum . mapMaybe (flip lookup ss . head) . tail . lines
ss = [('T',4),('C',6),('O',8),('D',12),('I',20)]

p 'T' = 4
p 'C' = 6
p 'O' = 8
p 'D' = 12
p 'I' = 20
main = interact $ show . sum . map (p . head) . tail . lines

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
main = do
    n_ <- readLn
    polyhedrons_ <- replicateM n_ getLine
    let
	face "Tetrahedron"  = 4
	face "Cube"	    = 6
	face "Octahedron"   = 8
	face "Dodecahedron" = 12
	face "Icosahedron"  = 20
    print . sum $ map face polyhedrons_

import Control.Monad

getFaceCount name
    | name == "Tetrahedron" = 4
    | name == "Cube" = 6
    | name == "Octahedron" = 8
    | name == "Dodecahedron" = 12
    | name == "Icosahedron" = 20

main :: IO()
main = do
    w <- getLine
    s <- forM [1..(read w :: Int)] $ \i -> getLine
    print $ sum (map getFaceCount s)

main = do
    contents <- getContents
    let a = tail . lines $ contents
    print (f a)

f :: [[Char]] -> Int
f []        = 0
f (x:xs)
    | x == "Tetrahedron"    = 4 + f xs
    | x == "Cube"           = 6 + f xs
    | x == "Octahedron"     = 8 + f xs
    | x == "Dodecahedron"   = 12 + f xs
    | x == "Icosahedron"    = 20 + f xs
    | otherwise             = error "no match"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import Control.Monad (forM_, forM)

face "Tetrahedron" = 4
face "Cube" = 6
face "Octahedron" = 8
face "Dodecahedron" = 12
face "Icosahedron" = 20

main = do
    (read -> t :: Int) <- getLine
    s <- forM [1..t] $ \i -> getLine
    putStrLn $ show $ sum (map face s)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

r "Cube" = 6
r "Icosahedron" = 20
r "Tetrahedron" = 4
r "Dodecahedron" = 12
r "Octahedron" = 8

main= do
		getLine

		a<-sum <$> map r <$> lines <$> getContents
		print a

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = getContents >>= print . sum . map faces . tail . lines

faces "Tetrahedron" = 4
faces "Cube" = 6
faces "Octahedron" = 8
faces "Dodecahedron" = 12
faces "Icosahedron" = 20

import qualified Data.Map as Map
import Control.Monad

g [] = 0
g (x : xs) = do
  case Map.lookup x (Map.fromList [("Tetrahedron", 4), ("Cube", 6), ("Octahedron", 8), ("Dodecahedron", 12), ("Icosahedron", 20)]) of
    Just y -> y + (g $ xs)
    Nothing -> g $ xs

main = do
  b <- readLn
  inputs <- replicateM b getLine
  putStrLn $ show $ g inputs

import           Control.Monad
faces s
    | head s == 'T' = 4
    | head s == 'C' = 6
    | head s == 'O' = 8
    | head s == 'D' = 12
    | head s == 'I' = 20
    | otherwise = 0

main :: IO ()
main = do
    n <- (read :: String -> Int ) <$> getLine
    print =<< sum . map faces <$> replicateM n getLine

import Control.Monad

main :: IO ()
main = do
    val <- getLine
    let n = read val :: Int
    xs <- forM [1..n] (\_ -> getLine)
    print (foldr (+) 0 $ map polyAnalysis xs)

polyAnalysis :: String -> Int
polyAnalysis str
    |str == "Tetrahedron" = 4
    |str == "Cube" = 6
    |str == "Octahedron" = 8
    |str == "Dodecahedron" = 12
    |str == "Icosahedron" = 20

--ghc 7.10

sides :: String -> Int
sides "Tetrahedron" = 4
sides "Cube" = 6
sides "Octahedron" = 8
sides "Dodecahedron" = 12
sides "Icosahedron" = 20
sides _ = 0

totalSides :: [String] -> Int
totalSides polyhedrons = sum . map sides $ polyhedrons

main = do
    line <- getLine
    contents <- getContents
    let polyhedrons = words contents
    print . totalSides $ polyhedrons

module Main where

import Control.Monad
import Data.IORef

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

main :: IO ()
main = do
  n <- readLn     :: IO Int
  x <- newIORef 0 :: IO (IORef Int)
  replicateM_ n $ do
    y <- getLine >>= return . conv . head
    modifyIORef x (+ y)
  readIORef x >>= putStrLn . show

module Main where
import qualified Data.ByteString.Char8 as B

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = B.getLine >>= addup (n-1) . (+ x) . conv . B.head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = getLine >>= addup (n-1) . (+ x) . conv . head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where
import qualified Data.ByteString as W

conv 84 = 4
conv 67 = 6
conv 79 = 8
conv 68 = 12
conv 73 = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = W.getLine >>= addup (n-1) . (+ x) . conv . W.head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where

import Data.Foldable

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO Int
addup x _ = getLine >>= return . (+ x) . conv . head

main :: IO ()
main = do
  n <- readLn     :: IO Int
  foldlM addup 0 [1..n] >>= putStrLn . show

import qualified Data.Map as M

main = do
    n <- getLine
    l <- mapM f [1..(read n :: Int)]
    putStrLn . show . sum $ l

f :: Int -> IO Int
f _ = do
    let m = M.fromList [("Tetrahedron", 4), ("Cube", 6), ("Octahedron", 8), ("Dodecahedron", 12), ("Icosahedron", 20)]
    pol <- getLine
    case M.lookup pol m of
        Just x -> return x

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

r "Cube" = 6
r "Icosahedron" = 20
r "Tetrahedron" = 4
r "Dodecahedron" = 12

main= do
		getLine
		print <$> sum <$> map r <$> lines <$> getContents


import Control.Monad
import Data.List (sort)

main = do
    t <- read <$> getLine
    forM_ [1..t] $ const solve

solve = do
    n <- read <$> getLine
    dirs <- let
        trans 'L' = 1
        trans _ = 0
        in (fmap . fmap) trans getLine
    let init = (\(i, d) -> i*d + (n-i-1)*(1-d)) <$> zip [0..] dirs
    let compl = (\(i, d) -> i*(1-d) + (n-i-1)*d) <$> zip [0..] dirs
    let diffs = reverse . sort $ (\(x, y) -> max 0 (y-x)) <$> zip init compl
    let res = (sum init +) <$> scanl1 (+) diffs
    putStrLn (unwords $ show <$> res)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import qualified Data.Set as S

import Data.Maybe
import Control.Monad

import Data.List

solve :: Integer -> String -> String
solve n s =
    let cur = foldr (\(el, idx) s -> s + calcCur el idx n) (toInteger 0) (zip s [0..])
    in unwords $ map show (solve1 0 cur (reverse $ sort $ getCan s n))

--solve1 :: Integer -> [Integer] -> [Integer]
solve1 _ _ [] = []
solve1 acc cur (x:xs) = (acc + x + cur) : (solve1 (acc + x) cur xs)

getCan :: String -> Integer -> [Integer]
getCan s n = [ calcMax el (toInteger idx) n - calcCur el (toInteger idx) n | (el, idx) <- zip s [0..] ]

calcMax :: Char -> Integer -> Integer -> Integer
calcMax el idx n = max idx (n - idx - 1)

calcCur :: Char -> Integer -> Integer -> Integer
calcCur el idx n
    | el == 'L' = toInteger idx
    | el == 'R' = toInteger n - idx - 1

work = do
    n <- getLine
    s <- getLine

    putStrLn $ solve (read n :: Integer) s

main = do
    t <- getLine

    replicateM_ (read t :: Int) work

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications, TupleSections #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List hiding (lookup)
import Debug.Trace
import Data.Char
import Data.Map (Map, fromListWith)
import qualified Data.Map as M
import Data.Int

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- getNext
  let
    sa = P.unpack a
    n = length sa
    f :: (Int, Char) -> Int64
    f (i, 'L') = fromIntegral i
    f (i, 'R') = fromIntegral $ n - i - 1

    swap 'L' = 'R'
    swap 'R' = 'L'

    basevals, opvals, swapvals :: [Int64]
    basevals = map f $ zip [0..] sa where
    opvals = map f . zip [0..] . map swap $ sa
    swapvals = zipWith (\a b -> max 0 (a - b)) opvals basevals
    baseval = sum basevals
    rawvals = take n . reverse . sort $ swapvals
    ans :: [Int64]
    ans = map ((+) baseval) $ scanl1 (+) rawvals
    strans :: [String]
    strans = map (show) ans
  fmap mconcat . pure . map str $ (map (\s -> s ++ " ") strans) ++ ["\n"]

import Control.Monad
import Data.List (sort)

main = do
    t <- read <$> getLine
    forM_ [1..t] $ const solve

solve = do
    n <- read <$> getLine
    dirs <- let
        trans 'L' = 1
        trans _ = 0
        in (fmap . fmap) trans getLine
    let init = (\(i, d) -> i*d + (n-i-1)*(1-d)) <$> zip [0..] dirs
    let compl = (\(i, d) -> i*(1-d) + (n-i-1)*d) <$> zip [0..] dirs
    let diffs = reverse . sort $ (\(x, y) -> max 0 (y-x)) <$> zip init compl
    let res = scanl (+) (sum init) diffs
    putStrLn (unwords $ show <$> res)


import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = scanl1 (+) . sort . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s'] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  let s = fromIntegral s' :: Int64
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    dgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==1) . fst) gs
    pgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==2) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= s
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        dis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==1) . fst . fst) $ zip gs [1..]
        pis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==2) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)

main = do
  [n, m, k, s] <- (map read . words) `fmap` getLine
  ds <- (map read . words) `fmap` getLine
  ps <- (map read . words) `fmap` getLine

  gs <- (map ((\[a, b] -> (a, b)) . map read . words) . lines) `fmap` getContents

  let
    dgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==1) . fst) gs
    pgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==2) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= s
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        dis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==1) . fst . fst) $ zip gs [1..]
        pis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==2) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = sort . scanl1 (+) . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = l
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = sort . scanl1 (+) . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r


import Data.List
import Control.Monad

rd arg = map read $ words arg :: [Int]

eval :: [(Int, Int, Int)]->Int
eval [] = 0
eval [(a,b,_)] = (b - a) * 2
eval ((a,b,_):(c,d,_):xs) = if b >= c then eval ((a,max b d,0):xs) else (b-a) * 2 + (eval ((c,d,0):xs))

bs :: [Int]->Int->Int->[(Int, Int, Int)]->Int->Int
bs lst le ri trp t = if le + 1 == ri then le else if eval (filter (\(_,_,e)->(pt<e)) trp)<=t
then bs lst mi ri trp t else bs lst le mi trp t where mi = quot (le+ri) 2;pt=(lst!!(mi-1))

main=do
 st1<-getLine
 st2<-getLine
 let (m, n, k, t) = (\[m,n,k,t]->(m,n,k,t)) $ rd st1
 let sld = rd st2
 isl <- replicateM k getLine
 let trp = map ((\[a,b,c]->(a-1,b,c)) . rd) isl
 print $ bs (reverse (sort sld)) 0 (m+1) (sort trp) (t-n-1)

import Data.List
import Control.Monad
w arg=map read$words arg::[Int]
o[]=0
o[(a,b,_)]=(b-a)*2
o((a,b,_):(c,d,_):x)=if b>=c then o((a,max b d,0):x)else(b-a)*2+(o((c,d,0):x))
b p l r y t=if l+1==r then l else if o (filter (\(_,_,e)->(k<e)) y)<=t
then b p m r y t else b p l m y t where m=quot (l+r) 2;k=(p!!(m-1))
main=do
 p<-getLine;q<-getLine;let (m,n,k,t)=(\[m,n,k,t]->(m,n,k,t))$w p;
 let s=w q
 i<-replicateM k getLine;let y=map ((\[a,b,c]->(a-1,b,c)).w) i
 print $b (reverse (sort s)) 0 (m+1) (sort y) (t-n-1)


module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)
import Data.Function ((&))

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

{-
(a2 - a1) * 2 >= a1 + a2
2 * a2 - 2 * a1 >= a1 + a2
a2 >= 3 * a1
a2 = 3 * a1
-}

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = floor (logBase 3 1e9) + 1
      ans = zipWith (flip (**)) [0..] (replicate m 3) <&> toInteger . floor
    if n <= m
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let a   = (1::Int) : map (*3) a
        max = length (takeWhile (<=10^9) a)
      in replicateM testCases (readLn >>= \x ->
        if x > max then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )

module Main where

import           Control.Monad
import           Data.List

main :: IO ()
main = do
    let l = takeWhile (<= 10^9) $ iterate (*3) 1
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        if n > length l
        then
            putStrLn "NO"
        else
            putStrLn $ ("YES\n" <>) . unwords . map show . take n $ l

module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)
import Data.Function ((&))

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

{-
(a2 - a1) * 2 >= a1 + a2
2 * a2 - 2 * a1 >= a1 + a2
a2 >= 3 * a1
a2 = 3 * a1
-}

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = floor (logBase 3 1e9)
      ans = zipWith (flip (**)) [0..] (replicate m 3) <&> toInteger . floor
    if n <= m + 1
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

module Main where
import Data.Functor ((<&>))
import Control.Monad (forM, replicateM, replicateM_)
import Data.Foldable (traverse_)
import GHC.Float.RealFracMethods (ceilingDoubleInt, floorDoubleInt)
import Data.List (group, sort)
import Data.Ratio ((%))
import Prelude hiding (floor)
import Control.Monad (forM_, replicateM_)

readInts :: IO [Int]
readInts = getLine <&> words <&> fmap read

readString :: IO String
readString = getLine

toDoubles :: (Functor f, Integral a) => f a -> f Double
toDoubles xs = (\x -> fromIntegral x :: Double) <$> xs

toDouble :: (Integral a) => a -> Double
toDouble = fromIntegral

ceil :: Double -> Int
ceil = ceilingDoubleInt

floor :: Double -> Int
floor = floorDoubleInt

main :: IO ()
main = do
  t:_ <- readInts
  replicateM_ t $ do
    n:_ <- readInts
    let
      m = 29
      ans = zipWith (flip (**)) [0..] (replicate m 2) <&> toInteger . floor
    if n <= m
      then do
        putStrLn "YES"
        forM_ (take n ans) (\x -> do {putStr $ show x; putStr " "})
      else putStr "NO"
    putStr "\n"

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let max = 10^9
        a   = (1::Int) : map (*3) a
      in replicateM testCases (readLn >>= \x ->
        if x >= 18 then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )

import Data.List
import Control.Monad

main = do
    testCases <- readLn
    let max = 10^9
        a   = (1::Int) : map (*3) a
      in replicateM testCases (readLn >>= \x ->
        if x > 18 then putStrLn "NO"
        else do
            putStrLn "YES"
            putStrLn $ intercalate " " (map show (take x a))
        )


{-# LANGUAGE NPlusKPatterns #-}
module Main where

getInt :: IO Int
getInt = fmap read getLine

getWords :: IO [String]
getWords = fmap words getLine

type Contestant = (String, Int, Int)

getContestant :: IO Contestant
getContestant = do
    [name, before, after] <- getWords
    return (name, read before, read after)

main :: IO ()
main = do
    n <- getInt
    cts <- doMany n getContestant
    putStrLn $ showFlag $ any witness cts

doMany :: Int -> IO a -> IO [a]
doMany 0 _ = return []
doMany (n + 1) act = do
    a <- act
    as <- doMany n act
    return (a : as)

witness :: Contestant -> Bool
witness (_, before, after) = before >= 2400 && after > before

doManyTill :: Int -> IO a -> (a -> Bool) -> IO Bool
doManyTill 0 _ _ = return False
doManyTill (n + 1) act p = do
    a <- act
    if p a
        then return True
        else doManyTill n act p

showFlag :: Bool -> String
showFlag True = "YES"
showFlag False = "NO"

import Control.Applicative
import Data.List

main = do
	getLine
	y<- filter (\z-> head z < head (tail z)) . filter (\z-> head z >=2400) . map (map read ). map tail. map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ if y ==[] then "NO" else "YES"

process :: [(Int, Int)] -> Bool
process = any (\(s,t) -> s >= 2400 && s < t)

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    xs' <- fmap (map (map readInt.tail.words).lines) getContents
    let xs = map (\[s,t] -> (s,t)) xs'
    if process xs
        then putStrLn "YES"
        else putStrLn "NO"

main = interact $ (\b -> if b then "YES" else "NO") . not . null . filter (\[r1, r2] -> r1 >= 2400 && r2 > r1) . map (map read . tail . words) . tail . lines

main :: IO()
main = output . solve . tail . words =<< getContents

output :: Bool -> IO()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [String] -> Bool
solve [] = False
solve (s:sa:sb:x) = let a = read sa
                        b = read sb
                    in (a >= 2400 && b > a) || solve x

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n $ map read . tail . words <$> getLine

  let b = any (\[a, b] -> a >= 2400 && b > a) ls

  putStrLn $ if b then "YES" else "NO"

module Main where

main = do
  w <- getLine
  w0 <- getContents
  let pool = [niceForm x | x <- (lines w0)]
  let r = solution pool
  if elem True r
  then putStrLn "YES"
  else putStrLn "NO"

niceForm :: String -> (Int,Int)
niceForm w = (n0,n1)
  where [n0,n1] = map read (tail $ words w)

solution :: [(Int,Int)] -> [Bool]
solution [] = []
solution (x:xs) = (((fst x) >= 2400) && ((snd x) > (fst x))) : solution xs

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
--import qualified Data.Map as M
---import qualified Data.Vector as V
--import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  t <- fmap read getLine
  inp <- forM [1..t] $ \_ -> fmap words getLine
  if solve inp then putStrLn "YES" else putStrLn "NO"

solve :: [[String]] -> Bool
solve = any f
    where
      f [_, x, y] = read y > (read x :: Int) && read x >= 2400

main = do
  n <- getLine
  d <- sequence $ replicate (read n) getLine
  let a = map (map read . tail . words) d
  putStrLn $ if foldl (\acc [x, y] -> if 2400 <= x && x < y then True else acc
                      ) False a then "YES" else "NO"

import Data.List

f::String->Bool
f x=let (n:a:b:[])=words x
        a2=read a::Int
        b2=read b::Int
    in if a2>=2400 && b2>a2 then True else False

main=do
     e1<-getLine
     es<-getContents
     let xs=lines es
     putStrLn $ if any f xs then "YES" else "NO"

main = interact solve

solve input = answer
    where
    n_s:inputw = words input

    n::Int
    n = read n_s

    scores::[(Int,Int)]
    scores = by_two $ map read $ last_two_by_three inputw

    highers = filter (\(x,y) -> (y > x) && x >= 2400) scores

    answer
        | one_or_more highers = "YES"
        | otherwise = "NO"

last_two_by_three [] = []
last_two_by_three (x:y:z:xs) = y:z:(last_two_by_three xs)

by_two [] = []
by_two (x:y:xs) = (x,y):(by_two xs)

one_or_more [] = False
one_or_more (x:xs) = True

main = interact $ format . any qualifies . tail . lines
qualifies l = a >= 2400 && a < b where [a,b] = map read (tail (words l))
format True = "YES"
format False = "NO"

import Control.Monad
import Control.Applicative
import Data.List

main = do n <- readLn
          ls <- map ((map read) . tail . words) <$> replicateM n getLine
          putStrLn $ solve ls

solve [] = "NO"
solve ([b, a]:ls) = if 2400 <= b && b < a
                    then "YES"
                    else solve ls

import Control.Monad
import Control.Applicative
import Data.List

main = do
  n <- readLn
  [ns, bs, as] <- transpose . map words <$> replicateM n getLine
  putStrLn $ solve ns (map read bs) (map read as)

solve :: [String] -> [Int] -> [Int] -> String
solve [] [] [] = "NO"
solve (n:ns) (b:bs) (a:as) = if 2400 <= b && b < a then "YES" else solve ns bs as

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.Array.Unboxed
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  n <- readInt1 <$> BS.getLine
  ns <- map (readStrIntInt . toTriple . BS.words) <$> replicateM n BS.getLine
  putStrLn $ solve ns

readStrIntInt :: (BS.ByteString, BS.ByteString, BS.ByteString) -> (BS.ByteString, Int, Int)
readStrIntInt = applyTriple id (fst . fromJust . BS.readInt) (fst . fromJust . BS.readInt)

solve :: [(BS.ByteString,Int,Int)] -> String
solve ns = if any p ns then "YES" else "NO" where
  p = \(_,before,after) -> before>=2400 && before<after

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] =(x, y, z)

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

fromTriple :: (a, a, a) -> [a]
fromTriple (x, y, z) = [x, y, z]

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

module Main where

main = do
  w <- getLine
  w0 <- getContents
  let pool = [niceForm x | x <- (lines w0)]
  let r = solution pool
  if elem True r
  then print "YES"
  else print "NO"

niceForm :: String -> (Int,Int)
niceForm w = (n0,n1)
  where [n0,n1] = map read (tail $ words w)

solution :: [(Int,Int)] -> [Bool]
solution [] = []
solution (x:xs) = (((fst x) >= 2400) && ((snd x) > (fst x))) : solution xs


{-# LANGUAGE BangPatterns #-}
import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' !((k, a):[]) = if a <= 4
        then k + 1
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' !((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else if a1 >= 4
            then solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs
            else solve' $ (k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n getInts

  let
    f [k, a] = fromIntegral k + v
      where
        v :: Int64 = ceiling $ if a == 1 then 1 else logBase 4 (fromIntegral a :: Double)
  print $ maximum $ map f ls

import Control.Monad (liftM, replicateM)
import Prelude hiding (reads)

reads :: Read a => IO (a, a)
reads  =  liftM (pack . map read . words) getLine
  where
    pack [a, b]  =  (a, b)

solve :: [(Int, Int)] -> Int
solve  =  maximum . map solve'
  where
    solve' (a, b)  =  (+) a $ max 1 $ length $ takeWhile (< b) [2^(2*x) | x <- [0..]]

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  replicateM n reads
    print $ solve xs

import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C

main = do
	input <- C.getContents
	let
		(n:xs)  = map (fst.fromJust.C.readInt) $ C.words input
		toTuple [] = []
		toTuple (a:b:rest) = (a,b) : (toTuple rest)
		boxes = toTuple xs
	print $ solve $ sortBy (\(a,b) (c,d) -> a `compare` c) boxes

solve :: [(Int,Int)] -> Int
solve ((a,b):[]) = a + max 1 (div_four b)
		where
			div_four x
				| x == 1 = 0
				| otherwise = 1 + div_four (((x-1) `div` 4)+1)

solve ((a,b):(c,d):rest) = solve ((c, cnt) : rest )
		where
			 cnt = max d (div_four (c-a) b)
			 div_four ti x
					| x == 1 || ti == 0 = x
					| otherwise = div_four (ti-1) (((x-1) `div` 4)+1)

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Data.Int
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- replicateM n (B.getLine >>= return . map readInt . B.words)
    print $ solve n l

solve :: Int ->[[Int]] -> Int
solve n l = binarySearch judge 0 maxBound
    where
        judge :: Int -> Bool
        judge n = and $ fmap (contain n) l
        contain :: Int -> [Int] -> Bool
        contain n [k,a]
            | k >= n    = False
            | otherwise = contain1 n k a
        contain1 n k a
            | k > n  = False
            | a > 4 && a `mod` 4 == 0 = contain1 n (k+1) (a `div` 4)
            | a > 4 = contain1 n (k+1) (a `div` 4 + 1)
            | otherwise = k < n || a == 1

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch judge = sub
    where
        sub a b
            |b == a+1  = b
            |judge m   = sub a m
            |otherwise = sub m b
            where
                m = (a+b) `div` 2

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = if n == 1
                       then (s + 1)
                       else getMinSide' s n
  where getMinSide' s n
          | n == 1    = s
          | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = getMinSide' s n
  where getMinSide' s n | n == 1    = s
                        | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

module Main (main) where

import Control.Monad (liftM, replicateM)

data Box = Box { side :: Int
               , number :: Int }
           deriving (Show)

readBox :: String -> Box
readBox line = Box { side = s, number = n }
  where (s:n:_) = map read $ words line

getMinSide :: Box -> Int
getMinSide (Box s n) = if n == 1
                       then s
                       else getMinSide' s n
  where getMinSide' s n
          | n == 1    = s
          | otherwise = getMinSide' (s + 1) (div (n + 3) 4)

main = do
  n <- liftM read getLine
  boxes <- replicateM n $ liftM readBox getLine
  let answer = maximum $ map getMinSide boxes
  print answer

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (if a == 0 then 1 else logBase 4 (fromIntegral a))) ls

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (if a == 1 then 1 else logBase 4 (fromIntegral a))) ls

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n getInts

  let
    f [k, a] = fromIntegral k + v
      where
        v :: Int32 = ceiling $ if a == 1 then 1 else logBase 4 (fromIntegral a :: Float)
  print $ maximum $ map f ls

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  ls <- replicateM n getInts

  print $ maximum $ map (\[k, a] -> k + ceiling (logBase 4 (fromIntegral a))) ls

import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C

main = do
	input <- C.getContents
	let
		(n:xs)  = map (fst.fromJust.C.readInt) $ C.words input
		toTuple [] = []
		toTuple (a:b:rest) = (a,b) : (toTuple rest)
		boxes = toTuple xs
	print $ solve $ sortBy (\(a,b) (c,d) -> a `compare` c) boxes

solve :: [(Int,Int)] -> Int
solve ((a,b):[]) = a + (div_four b)
		where
			div_four x
				| x == 1 = 0
				| otherwise = 1 + div_four (((x-1) `div` 4)+1)

solve ((a,b):(c,d):rest) = solve ((c, cnt) : rest )
		where
			 cnt = max d (div_four (c-a) b)
			 div_four ti x
					| x == 1 || ti == 0 = x
					| otherwise = div_four (ti-1) (((x-1) `div` 4)+1)

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Data.Int
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- replicateM n (B.getLine >>= return . map readInt . B.words)
    print $ solve n l

solve :: Int ->[[Int]] -> Int
solve n l =
    if n == 1 && l == [[0,0]] then
        0
    else
        binarySearch judge 0 maxBound
    where
        judge :: Int -> Bool
        judge n = and $ fmap (contain n) l
        contain :: Int -> [Int] -> Bool
        contain n [k,a]
            | k > n = False
            | a > 4 && a `mod` 4 == 0 = contain n [k+1,a `div` 4]
            | a > 4 = contain n [k+1,a `div` 4 + 1]
            | otherwise = k < n || a == 1

binarySearch :: (Int -> Bool) -> Int -> Int -> Int
binarySearch judge = sub
    where
        sub a b
            |b == a+1  = b
            |judge m   = sub a m
            |otherwise = sub m b
            where
                m = (a+b) `div` 2

import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' ((k, a):[]) = if a == 1
        then k
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' ((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else if a1 >= 4
            then solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs
            else solve' $ (k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a

import Data.List

toPair :: Read a => [String] -> (a, a)
toPair [a, b] = (read a, read b)

solve :: [(Int, Int)] -> Int
solve a' = solve' a where
    a = sort a'
    solve' ((k, a):[]) = if a == 1
        then k
        else solve' $ (k + 1, (a + 3) `div` 4):[]
    solve' ((k, a1):(k2, a2):xs) = if k + 1 == k2
        then solve' $ (k2, max ((a1 + 3) `div` 4) a2):xs
        else solve' $ (k + 1, (a1 + 3) `div` 4):(k2, a2):xs

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ toPair `fmap` words `fmap` getLine
    print $ solve a


import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Array

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let [n, d] = map (fst . fromJust . C.readInt) . C.words $ head input
	let as = map (fst . fromJust . C.readInt) . C.words $ head $ tail input
	let ass = array (0, n-1) [ (i, as !! i) | i <- [0..n-1] ]
	print $ 2 * (length $ filter (\(x,y) -> abs (x-y) <= d) [ (ass ! i, ass ! j) | i <- [0..n-1], j <- [i+1..n-1] ])

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

main = do
	[n, d] <- getA
	a <- getA
	putStr $ show $ sum [1 | i <- a, j <- a, abs(i-j) <= d] - n

pairnum heights diff = sum (map length (pairs heights []))
    where pairs [] _    = []
          pairs (x:t) h = (filter (\n -> (abs (x - n)) <= diff) (t ++ h)) : (pairs t (x:h))

main :: IO ()
main = do
  [_, max_diff] <- fmap (map read . words) getLine
  heights <- fmap (map read . words) getLine
  print (pairnum heights max_diff)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, d] <- getInts
  xs <- getInts

  print $ length [(x, y) | x <- xs, y <- xs, abs (x-y) <= d] - n

import Array
import Monad (liftM)

solve :: Int -> Array Int Int -> Int
solve d array  =  2 * length [(i,j) | i <- [1..n], j <- [i+1..n], abs (array ! i - array ! j) <= d]
  where
    n  =  snd $ bounds array

main :: IO ()
main  =  do
    [n, d]  <-  liftM (map read . words) getLine
    xs  <-  liftM (map read . words) getLine
    print $ solve d $ listArray (1,n) xs

import Data.List

f::Integer->[(Integer,Integer)]->[(Integer,Integer)]->Integer
f _ _ []=0
f d xs2@((p1,x):xs) ys2@((p2,y):ys)
    |y-x<=d=(p2-p1)*2 + f d xs2 ys
    |otherwise=f d xs ys2

main =do
      e<-getLine
      es<-getLine
      let (n:d:[])=map read (words e)::[Integer]
          xs=map read (words es)::[Integer]
          ys=zip [1..n] (sort xs)
      print $ f d ys ys

import Data.List
import Data.Char
import Control.Monad
main = do
  [n, d] <- fmap (map read . words) getLine
  a <- fmap (map read . words) getLine
  let k = length([1 | i <- a, j <- a, abs(i - j) <= d]) - n
      in print k

import Data.List
import Data.Char
import Control.Monad
main = do
  [n, d] <- fmap (map read . words) getLine
  a <- fmap (map read . words) getLine
  let k = [1 | i <- a, j <- a, abs(i - j) <= d]
      count = length(k) - length(a)
      in print count

import Prelude
import List
import Char

main = interact func

func = q1.lines

q1::[String]->String
q1 (a:b:xs) = (solve ((toInt.head.tail.words) a) ((map toInt.words) b))
              ++ "\n" ++ (q1 xs)
q1 []       = ""

toInt::String->Int
toInt = read
--toInt = foldl step 0
--    where step a b = a*10+(digitToInt b)

solve::Int->[Int]->String
solve a b = show (left a b)

left::Int->[Int]->Int
left a (b:xs) = (right a b xs)*2 + (left a xs)
left _ []     = 0

right a b (c:xs) | (abs (b-c)) <= a = 1 + (right a b xs)
                 | otherwise        = right a b xs
right _ _ []                        = 0

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : d : _ <- readData
  xs <- take n <$> readData
  let answer = sum $ do
        (i, x) <- zip [1 .. ] xs
        (j, y) <- zip [1 .. ] xs
        guard $ i /= j
        guard $ abs (x - y) <= d
        return (1 :: Int)
  printf "%d\n" $ answer

main = interact (ans)
dif x = read(last (words (head (lines x))))::Int
hei x = zip (map (read::String -> Int) (words (last(lines x)))) [1..]
pair x = [(y,z)|y<-hei x,z<-hei x,y/=z,fst y-fst z<= dif x,fst z-fst y<= dif x]
ans x = show(length(pair x))

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

process m k x = (+ (-1)) $ length $ filter (<=x+m) $ filter (>=x-m) k

main = do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		k<-sort <$> map read <$> words <$>getLine ::IO [Int]
		print $ sum $ map (process m k) k

module Main (
    main
) where

parse :: String -> (Int, Int, [Int])
parse str = (n, d, hs)
    where lns = lines str
          [n,d] = map read $ words $ head lns
          hs = map read $ words $ lns !! 1

solve :: (Int, Int, [Int]) -> Int
solve (n, d, hs) = length [(i,j) | i <- hs, j <- hs, abs (i - j) <= d ] - n

output :: Int -> String
output n = show n

main = interact $ output . solve . parse

process :: Integral a => a -> [a] -> a
process d xs = sum [if abs(i-j) <= d then 1 else 0 | i <- xs, j <- xs] - fromIntegral(length xs)

readInt :: String -> Integer
readInt = read

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

pairnum heights diff = sum (map length (pairs [] heights diff))
    where pairs [] _ _    = []
          pairs (x:t) h d = (filter (\n -> abs (x - n) <= d) (t ++ h)) : (pairs t (x:h) d)

main :: IO ()
main = do
  [_, max_diff] <- fmap (map read . words) getLine
  heights <- fmap (map read . words) getLine
  print (pairnum heights max_diff)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

main = do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		k<-sort <$> map read <$> words <$>getLine ::IO [Int]
		let z= length $ filter (<=m) $ zipWith (subtract) k (tail k)
		print $ z+z