import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Array((!))
import Control.Monad(replicateM)

import Data.Maybe

makeOcc (x:xs) = let m = makeOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
makeOcc [] = M.empty

solve :: Integer -> Integer -> [[Integer]] -> [[Integer]]
solve n m b = aux b' where
	b' = fmap makeOcc b

	aux :: [M.Map Integer Integer] -> [[Integer]]
	aux mL | null $ mL !! 0 = []
	aux mL = let (mL', l) = generatePatch mL in l : aux mL'

	generatePatch :: [M.Map Integer Integer] -> ([M.Map Integer Integer], [Integer])
	generatePatch mL = (fmap delete $ zip mL choice, choice) where
		minBy = zip [0..] $ fmap (fst . M.findMin) mL
		maxBy = zip [0..] $ fmap (fst . M.findMax) mL

		iMin = fromJust $ foldr aux Nothing minBy where
			aux (i, v) Nothing = Just (i, v)
			aux (i, v) (Just (i', v'))
				| v > v' = Just (i', v')
				| otherwise = Just (i, v)

		choice = aux maxBy where
			aux ((i, v):l)
				| i == fst iMin = snd iMin : aux l
				| otherwise = v : aux l
			aux [] = []

		delete (set, v) = case M.lookup v set of
			Just 1 -> M.delete v set
			Just i -> M.insert v (i-1) set

showR :: [[Integer]] -> String
showR list | length (head list) == 0 = ""
showR list = foldr (\i l -> show i++" "++l) "\n" (fmap head list) ++ showR (fmap tail list)

main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n, m] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		b <- replicateM (fromInteger n) (getLine >>= return . (fmap read) . words) :: IO [[Integer]]
		putStr $ showR $ solve n m b

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

putInts :: [Int] -> Builder
putInts xs = (mconcat $ intersperse (charUtf8 ' ') $ map intDec xs) `mappend` (charUtf8 '\n')

translate :: Int -> [(Int, Int)] -> [[Int]]
translate n pairs = elems $ accumArray (flip (:)) [] (1, n) $ map (\(a, b) -> (b, a)) pairs

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m] <- getInts
    let getRow i = flip zip (repeat i) <$> getInts
    (targets, rests) <- splitAt m . sort . concat <$> forM [1..n] getRow
    let [ts, rs] = map (translate n) [targets, rests]
        posTargets = flip zip ts $ scanl' (+) 0 $ map length ts
        merge (pos, xs) ys = as ++ xs ++ bs
          where (as, bs) = splitAt pos ys
        results = zipWith merge posTargets rs
    return $ mconcat $ map putInts results
  hPutBuilder stdout output


import Control.Monad
import Data.List

solve (x, y) = if y `rem` x == 0 then (1, y `quot` x) else (0, 0)

main = do
  t <- readInt
  lines <- replicateM t getLine
  let cases = map decodeLine lines
  putStrLn $ intercalate "\n" $ map (\x -> encodeLine $ solve x) cases

-- Just IO
readInt = do
  line <- getLine
  return (read line :: Int)

decodeLine line = (read x :: Int, read y :: Int)
  where (x, y) = break (==' ') line

encodeLine (x, y) = show x ++ " " ++ show y

isInt x = x == fromInteger (round x)

test2 :: Double -> Double -> String
test2 n0 n1
  | isInt (n1 / n0) = "1 " ++ (show.floor) (n1 / n0)
  | 0<1 = "0 0"

test :: [Double] -> String
test [] = ""
test ints =
  let n0 = head ints
      n1 = head $ tail ints
    in test2 n0 n1 ++ "\n" ++ (test ((tail.tail) ints))
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in putStrLn $ test ints


import Data.List

main = getContents >>= putStrLn . show . solve . tail . lines

solve :: [String] -> Int
solve = foldl1 max . map length . group . sort

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

main :: IO ()
main = print =<< sol . lines <$> (getLine *> getContents)

sol :: [String] -> Int
sol xs = length $ filter (==mx) xs
  where
  cnt x = length . filter (==True) $ map (==x) xs
  mx = maximumBy (comparing cnt) xs

import Data.List

solve :: [String] -> Int
solve = maximum . map length . group . sort

main = do
    n <- fmap read getLine
    ss <- mapM (\_ -> getLine) [1..n]
    print $ solve ss

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

main = do
  n <- read <$> getLine
  cols <- transpose . map (map (== '1')) <$> replicateM n getLine
  print $ maxClean cols

multiFilter (True:xs) xss = zipWith (:) (map head xss) (multiFilter xs (map tail xss))
multiFilter (False:xs) xss = multiFilter xs (map tail xss)
multiFilter [] _ = repeat []

maxClean ([]:_) = 0
maxClean [xs] = let k = length . filter id $ xs in max k (length xs - k)
maxClean (xs:xss) = max (maxClean (multiFilter xs xss)) (maxClean (multiFilter (map not xs) xss))
maxClean [] = 0

import Data.List
main = interact $ show . solve . tail . lines
solve = maximum . map length . group . sort

import Data.List (group, sort)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)

main = read <$> getLine >>= (flip replicateM) getLine >>= print . f
    where f = (last . sort) . (map length) . (group . sort)

import Data.List (group, sort)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)

main = read <$> getLine >>= (flip replicateM) getLine >>= print . f
    where f = last . sort . map length . group . sort

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

main :: IO ()
main = print =<< sol . lines <$> (getLine *> getContents)

sol :: [String] -> Int
sol xs = length . filter (=='1') $ maximumBy (comparing f) xs
  where
  f x = foldr (\y ac -> ac+if x==y then 1 else 0) 0 xs


import Data.Int (Int64)

main = do
  getLine
  as <- fmap (map read . words) getLine :: IO [Int64]

  let
    f [a] = [a]
    f (a:b:as)
      | gcd a b == 1 = a:(f (b:as))
      | otherwise = a:d:(f (b:as))
        where d = head [d | d <- [1..], gcd a d == 1, gcd d b == 1]

    as' = f as

  print $ length as' - length as
  putStrLn $ unwords $ map show as'

import Data.Char

main = do
	line <- getLine
	let (n:xs) = getInts 1 line
	line <- getLine
	let ps = getInts n line
	let answer = ans ps []
	let k = length answer - n
	putStrLn $ show k
	putStrLn $ foldr1 (\ x st -> st ++ " " ++ x) $ map (show) $ answer

getInts :: Int -> String -> [Int]

getInts 0 _ = []
getInts _ [] = []
getInts x str = map stringToInt $ take x $ words str

stringToInt :: String -> Int

stringToInt str = read str :: Int

ans :: (Integral a) => [a] -> [a] -> [a]

ans [] ret = ret
ans (f:fs) [] = ans fs [f]
ans (f:fs) ret@(s:retms)
	| gcd f s == 1 = ans fs (f:ret)
	| otherwise = ans fs (f:1:ret)

{-# 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.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.Array.ST
-- import           Data.Array.Unsafe
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

out = stdout

main = do
  _ <- readInt1 <$> BS.getLine
  ns <- readIntN <$> BS.getLine
  putAns out . makeTable $ solve ns

solve :: [Int] -> (Int,[Int])
solve ns = go 0 [] ns where
  go :: Int -> [Int] -> [Int] -> (Int,[Int])
  go c ms [y] = (c,reverse (y:ms))
  go c ms (x:y:ns) = if coPrime x y
    then go c (x:ms) (y:ns)
    else go (c+1) (1:x:ms) (y:ns)

coPrime :: Int -> Int -> Bool
coPrime m n = if m >= n then coprime m n else coprime n m where
  coprime m 0 = m == 1
  coprime m n = coprime n (m`mod`n)

makeTable :: (Int,[Int]) -> Table
makeTable (c,ns) = [OneR (IntC c), ListR (map (\s -> IntC s) ns)]

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

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

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)

-- output functions

data Cell  = ByteStringC BL.ByteString
           | IntC Int
           | Int64C Int64
           deriving( Eq, Ord, Show )

data Row   = ListR [Cell]
           | OneR Cell
           | TupleR (Cell,Cell)
           | TripleR (Cell,Cell,Cell)
           deriving( Eq, Ord, Show )

type Table = [Row]

infixr 4 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

putAns :: Handle -> Table -> IO ()
putAns o = hPutBuilder o . renderTable

renderTable :: Table -> Builder
renderTable rs = mconcat [renderRow r <> char8 '\n' | r <- rs]

renderRow :: Row -> Builder
renderRow (ListR []) = mempty
renderRow (ListR (c:cs)) = renderCell c <> mconcat [ char8 ' ' <> renderCell c' | c' <- cs ]
renderRow (OneR x) = renderCell x
renderRow (TupleR (x,y)) = renderCell x <> char8 ' ' <> renderCell y
renderRow (TripleR (x,y,z)) = renderCell x <> char8 ' ' <> renderCell y <> char8 ' ' <> renderCell z

renderCell :: Cell -> Builder
renderCell (ByteStringC cs) = lazyByteString cs
renderCell (IntC i) = intDec i
renderCell (Int64C i) = int64Dec i

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b >1 = a:1:(process (b:c))
		| otherwise = a:(process (b:c))

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x - (length n)
	putStrLn $ intercalate " " $ map show x

import Data.List

make_prime::[Int] -> [Int]
make_prime (x:y:xy) =
    if (gcd x y) /= 1
        then x:1:(make_prime (y:xy))
        else x:(make_prime (y:xy))

make_prime [] = []
make_prime (x:[]) = [x]

main = do
    n <- readInt
    numbers <- (map (\x -> (read x)::Int)) <$> (words) <$> (getLine)
    let ans = map show (make_prime numbers)
    print (length ans - n)
    putStrLn (unwords ans)

readToken :: IO String
readToken = do
    x <- getChar
    if x == ' ' || x == '\n'
        then return ""
        else (x:) <$> readToken

readInt :: IO Int
readInt = do
    x <- readToken
    return ((read x)::Int)

main :: IO ()
main = do
  c <- getContents
  let l = (map (read :: String -> Int) . tail . words) c
  let (a,b) = f l
  putStrLn . show $ a
  putStrLn . unwords. map show $ b

f :: [Int] -> (Int, [Int])
f q@([])     = (0,q)
f q@(x:[])   = (0,q)
f (x1:x2:xs) = if gcd x1 x2 == 1 then (a, x1:b) else (a+1, x1:1:b) where (a,b) = f (x2:xs)

import Data.Functor

main :: IO()
main = do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    let b = solve a
    print $ (length b) - n
    putStrLn $ unwords $ map show b

solve :: [Int] -> [Int]
solve [] = []
solve [a] = [a]
solve (a:b:s) | gcd a b > 1 = a:1:solve (b:s)
              | otherwise = a:solve (b:s)

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let ans = solve a
    print $ (length ans - n)
    putStrLn . unwords . map show $ ans

solve :: [Int] -> [Int]
solve [x] = [x]
solve (x:y:xs)
 |gcd x y == 1 = x:solve (y:xs)
 |otherwise = x:1:solve (y:xs)

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let ans = solve a
    print . length $ a
    putStrLn . unwords . map show $ ans

solve :: [Int] -> [Int]
solve [x] = [x]
solve (x:y:xs)
 |gcd x y == 1 = x:solve (y:xs)
 |otherwise = x:1:solve (y:xs)

main = do
  getLine
  as <- fmap (map read . words) getLine

  let
    f [a] = [a]
    f (a:b:as)
      | gcd a b == 1 = a:(f (b:as))
      | otherwise = a:d:(f (b:as))
      where d = head [d | d <- [1..], a `mod` d /= 0, b `mod` d /= 0]

    as' = f as

  print $ length as' - length as
  putStrLn $ unwords $ map show as'

import Data.Char

main = do
	line <- getLine
	let (n:xs) = getInts 1 line
	line <- getLine
	let ps = getInts n line
	putStrLn $ foldr1 (\ x st -> st ++ " " ++ x) $ map (show) $ ans ps []

getInts :: Int -> String -> [Int]

getInts 0 _ = []
getInts _ [] = []
getInts x str = map stringToInt $ take x $ words str

stringToInt :: String -> Int

stringToInt str = read str :: Int

ans :: (Integral a) => [a] -> [a] -> [a]

ans [] ret = ret
ans (f:fs) [] = ans fs [f]
ans (f:fs) ret@(s:retms)
	| gcd f s == 1 = ans fs (f:ret)
	| otherwise = ans fs (f:1:ret)

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

main=do
	getLine
	n<-    map read.words <$>getLine ::IO [Int]
	print 1
	putStrLn $ intercalate " "$ map show $ [head n , ((head n)+1)] ++ (tail n)

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b ==1 = a:1:(process (b:c))
		| otherwise = process (b:c)

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x
	putStrLn $ intercalate " " $ map show x

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b ==1 = a:1:(process (b:c))
		| otherwise = a:(process (b:c))

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x - (length n)
	putStrLn $ intercalate " " $ map show x

import Data.List

make_prime::[Int] -> [Int]
make_prime (x:y:xy) =
    if (gcd x y) /= 1
        then x:1:(make_prime (y:xy))
        else x:(make_prime (y:xy))

make_prime [] = []
make_prime (x:[]) = [x]

main = do
    n <- readInt
    numbers <- (map (\x -> (read x)::Int)) <$> (words) <$> (getLine)
    let ans = map show (make_prime numbers)
    print (length ans - n)
    print (unwords ans)

readToken :: IO String
readToken = do
    x <- getChar
    if x == ' ' || x == '\n'
        then return ""
        else (x:) <$> readToken

readInt :: IO Int
readInt = do
    x <- readToken
    return ((read x)::Int)


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

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ reverse $ sort $ map length $ group $ sort s
	putStrLn $ if odd ls then (if  (2*k-2<=ls) then "YES" else "NO") else (if (2*k-1<=ls) then "YES" else "NO")

import Control.Monad (liftM, unless, when)
import Data.List (group, sort)
import Prelude hiding (reads)

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

solve :: [Int] -> Bool
solve xs  =  (<= m) $ maximum $ map length $ group $ sort xs
  where
    n  =  length xs
    m  =  n `div` 2 + n `mod` 2

main :: IO ()
main  =  do
    getLine
    xs  <-  reads
    when (solve xs) $
        putStrLn "YES"
    unless (solve xs) $
        putStrLn "NO"

import Data.List

main = do
    _ <- getLine
    ns <- (return.map read.words =<< getLine :: IO [Int])
    putStrLn.judge $ answer ns where
        judge True = "YES"
        judge False = "NO"

answer :: [Int] -> Bool
answer ns = maxN <= (length ns - maxN+1) where
    maxN = maxLength ns

maxLength = foldl max 0.map length.group.qsort

qsort :: [Int] -> [Int]
qsort [] = []
qsort (x:xs) = qsort small ++ [x] ++ qsort big where
    small = [z| z <- xs, z <= x ]
    big = [z | z <- xs , z > x]

import Data.List

main =
  interact $ f . solve . map (map read . words) . lines
  where f True = "YES"
        f False = "NO"

solve :: [[Int]] -> Bool
solve (_:nums:_) =
  let maxLen = maximum $ map length $ group $ sort nums
      n = length nums
  in case n `mod` 2 of
      0 -> maxLen <= n `quot` 2
      1 -> maxLen <= (n `quot` 2) + 1

import Data.List
main=interact$f.map read.words
f[_,_]="YES"
f[_,x,y]|x==y="NO"|0<1="YES"
f(n:x)|l<-maximum.map length.group$sort x,l<=div(n+1)2="YES"|0<1="NO"

import Control.Applicative
import Control.Arrow
import Data.List

main = do
    n <- read <$> getLine
    let m = if even n then n `div` 2 else n `div` 2 + 1
    b <- (words >>> sort >>> group >>> map ((<=m).length) >>> and ) <$> getLine
    let s = (if b then "YES" else "NO")
    putStrLn s

import Data.List

main = do
    x <- getLine
    x <- getLine
    putStrLn $ f $ sort $ words $ x

f :: [String] -> String
f ws =  if (val <= (div len 2) + (mod len 2)) then "YES" else "NO"
        where
            len = length ws
            val = maximum $ map length $ group ws

import Data.Ord (comparing)
import Data.List
import Data.Tuple (fst)

main = do
    x <- getLine
    x <- getLine
    putStrLn $ f x

f :: String -> String
f x =   if (val <= (div len 2) + (mod len 2))
        then "YES"
        else "NO"
        where
            ws = sort $ words $ x
            len = length ws
            val = fst $ maximumBy (comparing fst) $ map (\x -> (length x, head x)) $ group ws

main = interact $ go . (map read) . concat . (map words) . lines
go (n:s) | maximum cnt > (div n 2)+(mod n 2) = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

main = interact $ go . (map read) . concat . (map words) . lines
go (n:s) | maximum cnt > div (n+1) 2 = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

main = interact $ go . (map read) . words . concat . lines
go (n:s) | maximum cnt > (div n 2)+(mod n 2) = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

import Control.Monad (liftM, unless, when)
import Data.List (group)
import Prelude hiding (reads)

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

solve :: [Int] -> Bool
solve xs  =  (<= m) $ maximum $ map length $ group xs
  where
    n  =  length xs
    m  =  n `div` 2 + n `mod` 2

main :: IO ()
main  =  do
    getLine
    xs  <-  reads
    when (solve xs) $
        putStrLn "YES"
    unless (solve xs) $
        putStrLn "NO"

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

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ reverse $ sort $ map length $ group $ sort s
	putStrLn $ if (2*k-2<=ls) then "YES" else "NO"

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

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ sort $ map length $ group $ sort s
	putStrLn $ if (2*k-2<=ls) then "YES" else "NO"


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

getInts :: IO [Int]
getInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

myDiv :: Int -> Int -> Int
myDiv x y = (x + y - 1) `quot` y

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [a, b, _] <- getInts
    as <- getInts
    bs <- getInts
    let result = foldl' acc (Just (a, b)) $ sort $ zip as bs
        acc Nothing _ = Nothing
        acc (Just (a1, b1)) (a2, b2)
          | b1 <= 0 = Nothing
          | otherwise = if k1 < k2 then Nothing else Just (a1, b1 - k2 * a2)
          where
          k1 = myDiv b1 a2
          k2 = myDiv b2 a1
    C.putStrLn $ C.pack $ if isJust result then "YES" else "NO"

chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

showBool True  = "YES"
showBool False = "NO"

uncurry5 f (a,b,c,d,e) = f a b c d e

getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read
          [a,b,n] =  map toInteger (words abn)

teto n d = 1 + (n - 1) `div` d

process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

showBool True  = "YES"
showBool False = "NO"

uncurry5 f (a,b,c,d,e) = f a b c d e

getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read :: String -> Integer
          [a,b,n] =  map toInteger (words abn)

teto n d = 1 + (n - 1) `div` d

process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

chunksOf3 :: [a] -> [[a]]
chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Integer, Integer, Integer, [Integer], [Integer])
getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read :: String -> Integer
          [a,b,n] =  map toInteger (words abn)

teto :: Integer -> Integer -> Integer
teto n d = 1 + (n - 1) `div` d

process :: Integer -> Integer -> Integer -> [Integer] -> [Integer] -> Bool
process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

import qualified Data.ByteString.Lazy.Char8 as P

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

cost :: Integer -> (Integer, Integer) -> Integer
cost ax (a, b) = let
  rounds = ceilDiv b ax
  in  rounds * a

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [ax, bx, _n] <- readInts
    a <- readInts
    b <- readInts
    let
      vs = sortOn fst $ zip a b
      totCost = sum $ map (cost ax) vs
      isOK = totCost - fst (last vs) < bx
    lift $ P.putStrLn $ if  isOK
      then  P.pack "YES"
      else  P.pack "NO"

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: Num t => SIO [t]
readInts = do
  currLine <- readLine
  pure [fromInteger x | Just (x, _) <- P.readInteger <$> P.words currLine]

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts #-}

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Traversable

------

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f (x, y) = (f x, y)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (x, y) = (x, f y)

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

pop :: MonadState [r] m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadState [r] m => m r
popJust = fromJust <$> pop

------

popInt :: MonadState [B.ByteString] m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadState [B.ByteString] m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadState [B.ByteString] m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadState [B.ByteString] m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

dropBackWhile :: (Char -> Bool) -> B.ByteString -> B.ByteString
dropBackWhile p = B.reverse . B.dropWhile p . B.reverse

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map (dropBackWhile isSpace) . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  n <- popInt
  B.unlines <$> replicateM n run1

run1 :: Hopper B.ByteString B.ByteString
run1 = do
  ~[attack, health, n] <- popIntegers
  a <- popIntegers
  b <- popIntegers
  return $ fmt $ solve attack health (zip a b)

  where
    fmt True = "YES"
    fmt False = "NO"

solve :: Integer -> Integer -> [(Integer, Integer)] -> Bool
solve attack health ms =
  let damagef (mattack, mhealth) =
        mattack * ((mhealth + attack - 1) `div` attack)
      totalDamage = sum $ map damagef ms
      lastDamage = maximum $ map fst ms in
    health - totalDamage + lastDamage > 0

chunksOf3 :: [a] -> [[a]]
chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Int, Int, Int, [Int], [Int])
getInput [abn, as, bs] = (a, b, n, map toInt (words as), map toInt (words bs))
    where toInt = read :: String -> Int
          [a,b,n] =  map toInt (words abn)

teto :: Int -> Int -> Int
teto n d = 1 + (n - 1) `div` d

process :: Int -> Int -> Int -> [Int] -> [Int] -> Bool
process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

import Data.List

build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Int, Int, Int, [Int], [Int])
getInput [abn, as, bs] = (a, b, n, map toInt (words as), map toInt (words bs))
    where toInt = read :: String -> Int
          [a,b,n] =  map toInt (words abn)

teto :: Int -> Int -> Int
teto n d = 1 + (n - 1) `div` d

process :: Int -> Int -> Int -> [Int] -> [Int] -> Bool
process a b n as bs = damage - maximum as <= b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf 3 . tail . lines)

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

getInts :: IO [Int]
getInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

myDiv :: Int -> Int -> Int
myDiv x y = (x + y - 1) `quot` y

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [b, a, _] <- getInts
    bs <- getInts
    as <- getInts
    let result = foldl' acc (Just (a, b)) $ sort $ zip as bs
        acc Nothing _ = Nothing
        acc (Just (a1, b1)) (a2, b2)
          | a1 <= 0 = Nothing
          | otherwise = if k1 < k2 then Nothing else Just (a1 - k2 * b2, b1)
          where
          k1 = myDiv a1 b2
          k2 = myDiv a2 b1
    C.putStrLn $ C.pack $ if isJust result then "YES" else "NO"


import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray ((!),bounds,listArray)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStrLn $ label ++ ":"
  let ((ilo,jlo),(ihi,jhi)) = bounds arr
  forM_ [ilo..ihi] $ \i -> do
    putStr "    "
    forM_ [jlo..jhi] $ \j -> do
      putStr $ printf "%6d " (arr ! (i,j))
    putStrLn ""

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (UArray (Int,Int) Int)

  let bnds = ((1,1),(n,m))
      bnds' = ((0,0),(n+1,m+1))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      g11' r (i,j) = do x <- r (i-1,j); y <- r (i,j-1); return $ a!(i,j) + max x y
      gn1' r (i,j) = do x <- r (i+1,j); y <- r (i,j-1); return $ a!(i,j) + max x y
      g1m' r (i,j) = do x <- r (i-1,j); y <- r (i,j+1); return $ a!(i,j) + max x y
      gnm' r (i,j) = do x <- r (i+1,j); y <- r (i,j+1); return $ a!(i,j) + max x y

      tabulate' f ijs = do
        arr <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
        forM_ ijs $ \ij -> f (readArray arr) ij >>=  writeArray arr ij
        M.freeze arr :: IO (UArray (Int,Int) Int)

{-
  a11 <- tabulate' g11' [ (i,j) | i <- [1..n], j <- [1..m] ]
  an1 <- tabulate' gn1' [ (i,j) | i <- [n,n-1..1], j <- [1..m] ]
  a1m <- tabulate' g1m' [ (i,j) | i <- [1..n], j <- [m,m-1..1] ]
  anm <- tabulate' gnm' [ (i,j) | i <- [n,n-1..1], j <- [m,m-1..1] ]
-}
  a11' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> forM_ [1..m] $ \j -> do
    x <- readArray a11' (i-1,j)
    y <- readArray a11' (i,j-1)
    writeArray a11' (i,j) $ a!(i,j) + max x y
  a11 <- M.freeze a11' :: IO (UArray (Int,Int) Int)

  an1' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [n,n-1..1] $ \i -> forM_ [1..m] $ \j -> do
    x <- readArray an1' (i+1,j)
    y <- readArray an1' (i,j-1)
    writeArray an1' (i,j) $ a!(i,j) + max x y
  an1 <- M.freeze an1' :: IO (UArray (Int,Int) Int)

  a1m' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> forM_ [m,m-1..1] $ \j -> do
    x <- readArray a1m' (i-1,j)
    y <- readArray a1m' (i,j+1)
    writeArray a1m' (i,j) $ a!(i,j) + max x y
  a1m <- M.freeze a1m' :: IO (UArray (Int,Int) Int)

  anm' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [n,n-1..1] $ \i -> forM_ [m,m-1..1] $ \j -> do
    x <- readArray anm' (i+1,j)
    y <- readArray anm' (i,j+1)
    writeArray anm' (i,j) $ a!(i,j) + max x y
  anm <- M.freeze anm' :: IO (UArray (Int,Int) Int)

  let g (i,j) = max top side
        where top  = a11!(i-1,j) + anm!(i+1,j) + an1!(i,j-1) + a1m!(i,j+1)
              side = a11!(i,j-1) + anm!(i,j+1) + an1!(i+1,j) + a1m!(i-1,j)
      -- b = listArray ((2,2),(n-1,m-1)) [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ] :: Array (Int,Int) Int
      best = maximum [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ]
  print best

{-
  showArray "a11" a11
  showArray "an1" an1
  showArray "a1m" a1m
  showArray "anm" anm
-}

import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStrLn $ label ++ ":"
  let ((ilo,jlo),(ihi,jhi)) = bounds arr
  forM_ [ilo..ihi] $ \i -> do
    putStr "    "
    forM_ [jlo..jhi] $ \j -> do
      putStr $ printf "%6d " (arr ! (i,j))
    putStrLn ""

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (Array (Int,Int) Int)

  let bnds = ((1,1),(n,m))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      a11 = tabulate g11
      a1m = tabulate g1m
      an1 = tabulate gn1
      anm = tabulate gnm

      g (i,j) = max top side
        where top  = a11!(i-1,j) + anm!(i+1,j) + an1!(i,j-1) + a1m!(i,j+1)
              side = a11!(i,j-1) + anm!(i,j+1) + an1!(i+1,j) + a1m!(i-1,j)
      b = listArray ((2,2),(n-1,m-1)) [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ] :: Array (Int,Int) Int
      best = maximum [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ]
{-
  showArray "a11" a11
  showArray "anm" anm
  showArray "a1m" a1m
  showArray "an1" an1
  showArray "a" a
  showArray "best" b
-}
  print best

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    as <- replicateM n readInts
    print $ solve n m as

solve :: Int -> Int -> [[Int]] -> Int64
solve n m as = maximum $ do
        i <- [2..n-1]
        j <- [2..m-1]
        let c1 = cost11 ! (i,j-1)
               + cost12 ! (i,j+1)
               + cost21 ! (i+1,j)
               + cost22 ! (i-1,j)
        let c2 = cost11 ! (i-1,j)
               + cost12 ! (i+1,j)
               + cost21 ! (i,j-1)
               + cost22 ! (i,j+1)
        return $ max c1 c2
    where
    bb = ((1,1),(n,m))
    a :: UArray (Int,Int) Int64
    a = listArray bb $ map fromIntegral $ concat as
    cost11 :: UArray (Int,Int) Int64
    cost11 = f 1 (<=n) succ pred 1 (<=m) succ pred
    cost12 = f n (>=1) pred succ m (>=1) pred succ
    cost21 = f n (>=1) pred succ 1 (<=m) succ pred
    cost22 = f 1 (<=n) succ pred m (>=1) pred succ
    f i0 ip si pi j0 jp sj pj = runSTUArray $ do
        cost <- newArray bb 0
        stepM_ i0 ip si $ \i -> stepM_ j0 jp sj $ \j -> do
            v <- if i == i0 && j == j0 then return 0
                 else if i == i0 then
                     readArray cost (i,pj j)
                 else if j == j0 then
                     readArray cost (pi i,j)
                 else
                     max <$> readArray cost (i,pj j)
                         <*> readArray cost (pi i,j)
            writeArray cost (i,j) (v+a!(i,j))
        return cost

import Data.Array.IO
import Data.Ix
import Control.Monad
import Data.IORef
import Data.Tuple
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

parse :: B.ByteString -> [Int]
parse s = do
    q <- B.splitWith (\x-> x == 13 || x == 10 || x == 32) s
    if B.length q == 0 then
        []
    else
        return $ foldl' (\a b-> a * 10 + (fromIntegral b) - (ord '0')) 0 (B.unpack q)

readNum :: IORef [a] -> IO a
readNum nums = do
    x:xs <- readIORef nums
    writeIORef nums xs
    return x

dyn :: IOUArray (Int, Int) Int -> Int -> Int -> IO (IOUArray (Int, Int) Int)
dyn g di dj = do
    bounds <- getBounds g
    let ((i1, j1), (i2, j2)) = bounds
    let newBounds = ((i1 + min di 0, j1 + min dj 0), (i2 + max di 0, j2 + max dj 0))
    q <- newArray newBounds 0
    let startI = if di > 0 then i2 else i1
    let endI = if di > 0 then i1 else i2
    let startJ = if dj > 0 then j2 else j1
    let endJ = if dj > 0 then j1 else j2
    forM_ [startI, (startI - di)..endI] $ \i -> do
        forM_ [startJ, (startJ - dj)..endJ] $ \j -> do
            a <- readArray g (i, j)
            ai <- readArray q ((i + di), j)
            aj <- readArray q (i, (j + dj))
            writeArray q (i, j) (a + max ai aj)
    return q

main :: IO ()
main = do
    nums0 <- B.getContents
    nums <- newIORef $ parse nums0
    n <- readNum nums
    m <- readNum nums
    g <- newArray ((1, 1), (n, m)) 0
    forM_ (range ((1, 1), (n, m))) $ \p -> do
        a <- readNum nums
        writeArray g p a
    dpp <- dyn g 1 1
    dpn <- dyn g 1 (-1)
    dnp <- dyn g (-1) 1
    dnn <- dyn g (-1) (-1)
    maxRes <- newIORef 0
    forM_ (range ((2, 2), (n - 1, m - 1))) $ \(i, j) -> do
        a1Up <- readArray dnn (i - 1, j)
        a1Left <- readArray dnn (i, j - 1)
        a2Right <- readArray dpp (i, j + 1)
        a2Down <- readArray dpp (i + 1, j)
        b1Left <- readArray dpn (i, j - 1)
        b1Down <- readArray dpn (i + 1, j)
        b2Right <- readArray dnp (i, j + 1)
        b2Up <- readArray dnp (i - 1, j)
        let r = max (a1Up + b1Left + a2Down + b2Right) (a1Left + b1Down + a2Right + b2Up)
        curMaxRes <- readIORef maxRes
        writeIORef maxRes $! (max curMaxRes r)
    r <- readIORef maxRes
    putStrLn $ show r

import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (Array (Int,Int) Int)

  let bnds = ((1,1),(n,m))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      a11 = tabulate g11
      a1m = tabulate g1m
      an1 = tabulate gn1
      anm = tabulate gnm

      g ij = (a11!ij) + (a1m!ij) + (an1!ij) + (anm!ij) - 4*(a!ij)
      best = maximum [ g ij | ij <- range bnds ]
  print best

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    as <- replicateM n readInts
    print $ solve n m as

solve :: Int -> Int -> [[Int]] -> Int64
solve n m as = maximum $ do
        i <- [1..n]
        j <- [1..m]
        return $ cost11 ! (i,j) + cost12 ! (i,j) + cost21 ! (i,j) + cost22 ! (i,j)
    where
    bb = ((1,1),(n,m))
    a :: UArray (Int,Int) Int64
    a = listArray bb $ map fromIntegral $ concat as
    cost11 :: UArray (Int,Int) Int64
    cost11 = f 1 (<=n) succ pred 1 (<=m) succ pred
    cost12 = f n (>=1) pred succ m (>=1) pred succ
    cost21 = f n (>=1) pred succ 1 (<=m) succ pred
    cost22 = f 1 (<=n) succ pred m (>=1) pred succ
    f i0 ip si pi j0 jp sj pj = runSTUArray $ do
        cost <- newArray bb 0
        stepM_ i0 ip si $ \i -> stepM_ j0 jp sj $ \j -> do
            v <- if i == i0 && j == j0 then return 0
                 else if i == i0 then
                     ((a ! (i,pj j))+) <$> readArray cost (i,pj j)
                 else if j == j0 then
                     ((a ! (pi i,j))+) <$> readArray cost (pi i,j)
                 else
                     max <$> (((a ! (i,pj j))+) <$> readArray cost (i,pj j))
                         <*> (((a ! (pi i,j))+) <$> readArray cost (pi i,j))
            writeArray cost (i,j) v
        return cost


module Main where
    import Data.Array

    solve :: Integer -> Bool
    solve x = (d >= 1) && (1 <= t) && (t <= 6) where
        t = x `mod` 14
        d = x `div` 14

    main = do
        n <- getLine
        l <- getLine
        let a = map(\x -> read x :: Integer) $ words l
            res = map(\x -> if solve x == True then "YES" else "NO") a
        mapM_ putStrLn res

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
main=interact$unlines.map(p.read).tail.words
p x|x<14="NO"|mod(x-1)14<6="YES"|1>0="NO"

main=interact$unlines.map p.tail.words
p x|mod(read x-1)14<6="YES"|1>0="NO"


import Data.List ( sort, nub )
import Data.Bool ( bool )

main :: IO ()
main = interact $ unlines . fmap (toYesNo . isDiverse) . tail . words
  where
    toYesNo = bool "No" "Yes"

isDiverse :: String -> Bool
isDiverse s = isAdj s && isDistinct s

isAdj :: String -> Bool
isAdj = and . (zipWith (\a b -> succ a == b) <*> tail) . sort

isDistinct :: String -> Bool
isDistinct s = nub s == s

-- Codeforces Round #550 (Div. 3) - Problem A: Diverse Strings (https://codeforces.com/problemset/problem/1144/A)
import Data.List
import Data.Char

isDiverse s | s == nub s && (ord . head) s + n - 1 == (ord . last) s  = "Yes"
            | otherwise                                 = "No"
            where
                n = length s

solve = map (isDiverse . sort)

main = do
    input <- getContents
    let xs = tail . lines $ input
    putStr . unlines $ solve xs

import Data.List (sort)

isVarious str = all (\(a, b) -> succ a == b) $ zip (init sorted_str) (tail sorted_str) where
    sorted_str = sort str

test = if isVarious "asd" then "Yes" else "No"

iterSolve 0 = return ()
iterSolve n = do
    str <- getLine
    putStrLn $ if isVarious str then "Yes" else "No"
    iterSolve (n - 1)

main = do
    line <- getLine
    iterSolve $ read line

import Data.List
works (y:[]) = True
works (x:y:xs) = case (succ x) == y of
  True -> works (y:xs)
  False -> False

process [] = putStr ""
process (x:xs) = case works (sort x) of
  True -> putStrLn "Yes" >> process xs
  False -> putStrLn "No" >> process xs
main = getContents >>= process . tail . words

import Data.List

main = getLine >> (interact $ unlines . map solve . lines)

solve xs
    | build ss == ss = "Yes"
    | otherwise = "No"
    where build all@(x:_) = take (length all) $ iterate succ x
          ss = sort xs

import Data.List
import System.IO

readInteger :: IO Int
readInteger = do
   z <- readLn
   return z

readString = do
   z <- getLine
   return z

readStrings 0 = return []
readStrings n = do
   line <- readString
   rest <- readStrings (n - 1)
   return (line : rest)

takeInput = do
   z <- readInteger
   readStrings z

ok (ch: []) = True
ok (ch : rest) = (ok rest) && ((fromEnum ch) + 1 == fromEnum (head rest))

answer True = "Yes"
answer False = "No"

process = map (answer . ok . sort)

display [] = return ()
display (x:xs) = do
   putStrLn x
   display xs

main = do
   input <- takeInput
   display (process input)

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

diverse :: String -> String
diverse s
    | m == l && m == (d + 1) = "Yes"
    | otherwise              = "No"
        where l = length s
              t = sort s
              m = length $ group t
              d = ord (last t) - ord (head t)

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    mapM_ putStrLn $ map diverse xs

import Data.List
main = interact $ unlines . map solve . tail . lines
solve s | fromEnum (maximum s) - fromEnum (minimum s) == length s - 1
          && nub s == s = "Yes"
        | otherwise = "No"

import Data.List
consecCheck s =  (== 1) . length . filter id . map head . group $ map (`elem` s) ['a'..'z']
allDiff [] = True
allDiff (x:xs) = not (x `elem` xs) && allDiff xs
solve s = allDiff s && consecCheck s
p b = if b then "Yes" else "No"
main = interact $ unlines . map (p . solve) . tail . lines

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
import Data.Array.Unboxed
import Data.Int
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

rstrip = C.takeWhile isPrint
sYes = byteString $ C.pack "Yes\n"
sNo = byteString $ C.pack "No\n"

test s = if res then sYes else sNo
  where
    c = runSTUArray $ do
      x <- newArray (0, 25) 0 :: ST s (STUArray s Int Int32)
      forM (C.unpack s) $ \i -> do
        let !j = ord i - 97
        readArray x j >>= ((writeArray x j) . succ)
      return x
    lst = filter (\ l -> head l /= 0) $ group $ elems c
    !res = length lst == 1 && (head $ head lst) == 1

solve (sn:a) = mconcat $ map test b
  where
    !n = ru sn
    b = take n a

main :: IO ()
main = hPutBuilder stdout . solve . map rstrip . C.lines =<< C.getContents

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M

m1 =M.fromList $   zip ['a'..'z'] [1..]

process1 x 	| d+1== length x = "Yes"
	  	| otherwise = "No"
	where mi = minimum x
              ma = maximum x
	      d =fromJust ( M.lookup ma m1) - fromJust (M.lookup mi m1)

onecase = do
		x<-getLine
		putStrLn $ 	if length (group (sort x)) <length x then "No" else process1 x

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M

m1 =M.fromList $   zip ['a'..'y'] ['b'..'z']

process [_] = "No"

process (a:b) 	| elem (fromJust(M.lookup a m1)) b = "Yes"
		| otherwise = process b
process1 x | length x == 1 = "Yes"
	   | otherwise = process   x

onecase = do
		x<-getLine
		putStrLn $ 	if length (group (sort x)) <length x then "No" else process1 x

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

-- Codeforces Round #550 (Div. 3) - Problem A: Diverse Strings (https://codeforces.com/problemset/problem/1144/A)
import Data.List
import Data.Char

isDiverse s | (ord . head) s + n - 1 == (ord . last) s  = "Yes"
            | otherwise                                 = "No"
            where
                n = length s

solve = map (isDiverse . sort)

main = do
    input <- getContents
    let xs = tail . lines $ input
    putStr . unlines $ solve xs


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Arrow
import Control.Monad (replicateM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Base
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort)
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  (n, m) <- pair int int
  ps <- n >< int
  let ks = solve m ps
  return . unwords . map show $ length ks : ks

solve :: Int -> [Int] -> [Int]
solve m ps =
  filter check
    . map head -- ks
    . filter ((>= n - 2 * m) . length) -- cnt_k >= n - 2m
    . group
    . sort
    $ [(n + i - x) `mod` n | i <- [1 ..] | x <- ps] -- k values for each fixpoint
  where
    n = length ps
    check k = let (hs, ts) = splitAt k ps in numCycles (ts ++ hs) >= n - m

-- Number of cycles in a 1-indexed permutation
numCycles :: [Int] -> Int
numCycles = rangeSize . bounds . cycleLen . permToCycles . fromList

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

--- https://github.com/byorgey/comprog-hs/blob/master/Perm.hs

-- | 'Perm' represents a /1-indexed/ permutation.  It can also be
--   thought of as an endofunction on the set @{1 .. n}@.
type Perm = UArray Int Int

-- | Construct a 'Perm' from a list containing a permutation of the
--   numbers 1..n.  The resulting 'Perm' sends @i@ to whatever number
--   is at index @i-1@ in the list.
fromList :: [Int] -> Perm
fromList xs = listArray (1, length xs) xs

-- | Compose two permutations (corresponds to backwards function
--   composition).  Only defined if the permutations have the same
--   size.
andThen :: Perm -> Perm -> Perm
andThen p1 p2 = listArray (bounds p1) (map ((p1 !) >>> (p2 !)) (range (bounds p1)))

-- | Compute the inverse of a permutation.
inverse :: Perm -> Perm
inverse p = array (bounds p) [(p ! k, k) | k <- range (bounds p)]

data CycleDecomp = CD
  { -- | Each number maps to the ID #
    --   of the cycle it is part of
    cycleID :: UArray Int Int,
    -- | Each cycle ID maps to the length of that cycle
    cycleLen :: UArray Int Int,
    -- | Each element maps to its (0-based) index in its cycle
    cycleIndex :: UArray Int Int,
    -- | Each size maps to the number of cycles of that size
    cycleCounts :: UArray Int Int
  }
  deriving (Show)

-- | Cycle decomposition of a permutation in O(n), using mutable arrays.
permToCycles :: Perm -> CycleDecomp
permToCycles p = cd
  where
    (_, n) = bounds p

    cd = runST $ do
      cid <- newArray (1, n) 0
      cix <- newArray (1, n) 0
      ccs <- newArray (1, n) 0

      lens <- findCycles cid cix ccs 1 1
      cid' <- freeze cid
      cix' <- freeze cix
      ccs' <- freeze ccs
      return $ CD cid' (listArray (1, length lens) lens) cix' ccs'

    findCycles ::
      STUArray s Int Int ->
      STUArray s Int Int ->
      STUArray s Int Int ->
      Int ->
      Int ->
      ST s [Int]
    findCycles cid cix ccs l !k -- l = next available cycle ID; k = cur element
      | k > n = return []
      | otherwise = do
        -- check if k is already marked as part of a cycle
        id <- readArray cid k
        case id of
          0 -> do
            -- k is unvisited.  Explore its cycle and label it as l.
            len <- labelCycle cid cix l k 0

            -- Remember that we have one more cycle of this size.
            count <- readArray ccs len
            writeArray ccs len (count + 1)

            -- Continue with the next label and the next element, and
            -- remember the size of this cycle
            (len :) <$> findCycles cid cix ccs (l + 1) (k + 1)

          -- k is already visited: just go on to the next element
          _ -> findCycles cid cix ccs l (k + 1)

    -- Explore a single cycle, label all its elements and return its size.
    labelCycle cid cix l k !i = do
      -- Keep going as long as the next element is unlabelled.
      id <- readArray cid k
      case id of
        0 -> do
          -- Label the current element with l.
          writeArray cid k l
          -- The index of the current element is i.
          writeArray cix k i

          -- Look up the next element in the permutation and continue.
          (1 +) <$> labelCycle cid cix l (p ! k) (i + 1)
        _ -> return 0

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST.Lazy

seenBefore :: (Int, Int) -> [Int] -> [Bool]
seenBefore bnds li = runST $ do
  arr <- strictToLazyST $ newArray bnds False :: ST s (STUArray s Int Bool)
  (\fun -> mapM fun li) $ \x -> strictToLazyST $ do
    ans <- readArray arr x
    ans <$ writeArray arr x True

getCycles :: UArray Int Int -> [[Int]]
getCycles arr = let
  go qrs x = let
    (ansTail, remQs) = case  qrs  of
      False : qrst -> go qrst (arr ! x)
      True  : qrst -> ([], qrst)
      [] -> error "unanswered query"
    in  (x : ansTail, remQs)
  queryResponses = seenBefore (bounds arr) queries
  queries = concat untrimmed
  untrimmed = map fst
    $ scanl (\(_, qrs) x -> go qrs x) ([], queryResponses) (indices arr)
  in  [ts | _ : ts <- untrimmed, not $ null ts]

check :: UArray Int Int -> Int -> Int
check p k = let
  (1, n) = bounds p
  pk = listArray (1, n) $ [1 + mod (pj + k - 1) n | pj <- elems p]
  in  n - length (getCycles pk)

solve :: UArray Int Int -> Int -> [Int]
solve p m = let
  (1, n) = bounds p
  ncorrect :: UArray Int Int
  ncorrect = accumArray (+) 0 (0, n-1)
    $ [(mod (i - pj) n, 1) | (i, pj) <- assocs p]
  isOK k = if  ncorrect ! k + 2 * m < n
    then  False  -- at most 3 values of k can skip this per testcase
    else  check p k <= m
  in  filter isOK [0 .. n-1]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    p <- listArray (1, n) <$>readInts
    let  ans = solve p m
    putInts $ length ans : ans

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Arrow
import Control.Monad (replicateM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Base
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort)
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  (n, m) <- pair int int
  ps <- n >< int
  let ks = solve m ps
  return . unwords . map show $ length ks : ks

solve :: Int -> [Int] -> [Int]
solve m ps =
  id
  -- filter (\k -> numCycles ([n - k + 1 .. n] ++ [1 .. n - k]) >= n - m) -- check swaps
    . map head -- ks
    . filter ((>= n - 2 * m) . length) -- cnt_k >= n - 2m
    . group
    . sort
    $ [(n + i - x) `mod` n | i <- [1 ..] | x <- ps] -- k values for each fixpoint
  where
    n = length ps

-- Number of cycles in a 1-indexed permutation
numCycles :: [Int] -> Int
numCycles = rangeSize . bounds . cycleLen . permToCycles . fromList

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

--- https://github.com/byorgey/comprog-hs/blob/master/Perm.hs

-- | 'Perm' represents a /1-indexed/ permutation.  It can also be
--   thought of as an endofunction on the set @{1 .. n}@.
type Perm = UArray Int Int

-- | Construct a 'Perm' from a list containing a permutation of the
--   numbers 1..n.  The resulting 'Perm' sends @i@ to whatever number
--   is at index @i-1@ in the list.
fromList :: [Int] -> Perm
fromList xs = listArray (1, length xs) xs

-- | Compose two permutations (corresponds to backwards function
--   composition).  Only defined if the permutations have the same
--   size.
andThen :: Perm -> Perm -> Perm
andThen p1 p2 = listArray (bounds p1) (map ((p1 !) >>> (p2 !)) (range (bounds p1)))

-- | Compute the inverse of a permutation.
inverse :: Perm -> Perm
inverse p = array (bounds p) [(p ! k, k) | k <- range (bounds p)]

data CycleDecomp = CD
  { -- | Each number maps to the ID #
    --   of the cycle it is part of
    cycleID :: UArray Int Int,
    -- | Each cycle ID maps to the length of that cycle
    cycleLen :: UArray Int Int,
    -- | Each element maps to its (0-based) index in its cycle
    cycleIndex :: UArray Int Int,
    -- | Each size maps to the number of cycles of that size
    cycleCounts :: UArray Int Int
  }
  deriving (Show)

-- | Cycle decomposition of a permutation in O(n), using mutable arrays.
permToCycles :: Perm -> CycleDecomp
permToCycles p = cd
  where
    (_, n) = bounds p

    cd = runST $ do
      cid <- newArray (1, n) 0
      cix <- newArray (1, n) 0
      ccs <- newArray (1, n) 0

      lens <- findCycles cid cix ccs 1 1
      cid' <- freeze cid
      cix' <- freeze cix
      ccs' <- freeze ccs
      return $ CD cid' (listArray (1, length lens) lens) cix' ccs'

    findCycles ::
      STUArray s Int Int ->
      STUArray s Int Int ->
      STUArray s Int Int ->
      Int ->
      Int ->
      ST s [Int]
    findCycles cid cix ccs l !k -- l = next available cycle ID; k = cur element
      | k > n = return []
      | otherwise = do
        -- check if k is already marked as part of a cycle
        id <- readArray cid k
        case id of
          0 -> do
            -- k is unvisited.  Explore its cycle and label it as l.
            len <- labelCycle cid cix l k 0

            -- Remember that we have one more cycle of this size.
            count <- readArray ccs len
            writeArray ccs len (count + 1)

            -- Continue with the next label and the next element, and
            -- remember the size of this cycle
            (len :) <$> findCycles cid cix ccs (l + 1) (k + 1)

          -- k is already visited: just go on to the next element
          _ -> findCycles cid cix ccs l (k + 1)

    -- Explore a single cycle, label all its elements and return its size.
    labelCycle cid cix l k !i = do
      -- Keep going as long as the next element is unlabelled.
      id <- readArray cid k
      case id of
        0 -> do
          -- Label the current element with l.
          writeArray cid k l
          -- The index of the current element is i.
          writeArray cix k i

          -- Look up the next element in the permutation and continue.
          (1 +) <$> labelCycle cid cix l (p ! k) (i + 1)
        _ -> return 0

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST.Lazy

seenBefore :: (Int, Int) -> [Int] -> [Bool]
seenBefore bnds li = runST $ do
  arr <- strictToLazyST $ newArray bnds False :: ST s (STUArray s Int Bool)
  (\fun -> mapM fun li) $ \x -> strictToLazyST $ do
    ans <- readArray arr x
    ans <$ writeArray arr x True

getCycles :: UArray Int Int -> [[Int]]
getCycles arr = let
  go qrs x = let
    (ansTail, remQs) = case  qrs  of
      True  : qrst -> go qrst (arr ! x)
      False : qrst -> ([], qrst)
      [] -> error "unanswered query"
    in  (x : ansTail, remQs)
  queryResponses = seenBefore (bounds arr) queries
  queries = concat untrimmed
  untrimmed = map fst
    $ scanl (\(_, qrs) x -> go qrs x) ([], queryResponses) (indices arr)
  in  [ts | _ : ts <- untrimmed]

check :: UArray Int Int -> Int -> Int
check p k = let
  (1, n) = bounds p
  pk = listArray (1, n) $ [1 + mod (pj - k - 1) n | pj <- elems p]
  in  n - length (getCycles pk)

solve :: UArray Int Int -> Int -> [Int]
solve p m = let
  (1, n) = bounds p
  ncorrect :: UArray Int Int
  ncorrect = accumArray (+) 0 (0, n-1)
    $ [(mod (i - pj) n, 1) | (i, pj) <- assocs p]
  isOK k = if  ncorrect ! k + 2 * m < n
    then  False  -- at most 3 values of k can skip this per testcase
    else  check p k < m
  in  filter isOK [0 .. n-1]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    p <- listArray (1, n) <$>readInts
    let  ans = solve p m
    putInts $ length ans : ans

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


import Data.List
import qualified Data.Map as DM
import Data.Maybe

getMap :: String -> DM.Map Char Int
getMap = foldl' (\ acc x -> DM.insertWith (+) x 1 acc) DM.empty

solve :: String -> String -> (Int, Int)
solve s t =
    let m1 = getMap s
        m2 = getMap t
    in foldl' (\ (a, b) (c1, c2) ->
                let (a1, b1) = getBest m1 m2 c1 c2 in (a + a1, b + b1))
              (0, 0)
              (zip ['a'..'z'] ['A'..'Z'])
    where
        getBest :: DM.Map Char Int -> DM.Map Char Int -> Char -> Char -> (Int, Int)
        getBest m1 m2 lower upper =
            let cntLower1 = fromMaybe 0 (DM.lookup lower m1)
                cntLower2 = fromMaybe 0 (DM.lookup lower m2)
                cntUpper1 = fromMaybe 0 (DM.lookup upper m1)
                cntUpper2 = fromMaybe 0 (DM.lookup upper m2)
                goodLower = min cntLower1 cntLower2
                goodUpper = min cntUpper1 cntUpper2
                rest1 = cntLower1 + cntUpper1 - goodLower - goodUpper
                rest2 = cntLower2 + cntUpper2 - goodLower - goodUpper
                rest = min rest1 rest2
            in (goodLower + goodUpper, rest)

main = do
    s <- getLine
    t <- getLine
    let (a, b) = solve s t
    putStrLn $ show a ++ " " ++ show b

module Main where
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Ord
import Data.List
import qualified Data.Map.Lazy as M
import Data.Maybe

main :: IO ()
main = do
  s <- getLine
  t <- getLine
  mapM_ (putStr . (" "++) . show) $ sol s t

sol s t = map (sum . M.elems) [mi, li]
  where
  ms = M.fromListWith (+) $ zip s (repeat 1)
  mt = M.fromListWith (+) $ zip t (repeat 1)
  mi = M.intersectionWith min ms mt
  ds = M.differenceWith (\a b -> if a>b then Just (a-b) else Nothing) ms mi
  dt = M.differenceWith (\a b -> if a>b then Just (a-b) else Nothing) mt mi
  ls = M.mapKeysWith (+) toLower ds
  lt = M.mapKeysWith (+) toLower dt
  li = M.intersectionWith min ls lt

import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import Data.Char
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

succRevStr [] = "a"
succRevStr ('z':tl) = 'a' : succRevStr tl
succRevStr ( c :tl) = succ c : tl

succStr s =
    reverse . succRevStr . reverse $ s

groupCount s =
    let s' = group . sort $ s
    in  map (\l -> (head l, length l)) s'

main = do
    s <- getLine
    t <- getLine
    let sg = groupCount s
        tg = groupCount t

        searchLetter bag (c,n) =
          case lookup c bag of
                    Nothing -> 0
                    Just x' -> min n x'

        yay = sum . map (searchLetter tg) $ sg

        sg' = groupCount $ map toLower s
        tg' = groupCount $ map toLower t

        yay_whoops = sum . map (searchLetter tg') $ sg'

    -- traceShow sg $ do
    -- traceShow tg $ do
    -- when (yay == 198087) $
      -- putStrLn ("Sum is " ++ show (yay_whoops) ++ " and length is " ++ show (length s))
    putStrLn $ show yay ++ " " ++ show (yay_whoops - yay)

import qualified Data.Map.Strict as M
import Data.Char (toUpper, toLower)

type TanyaMap = M.Map Char Integer

occurrences :: String -> TanyaMap
occurrences = foldl (\acc ch -> M.insertWith (+) ch 1 acc) M.empty

find def ch map = (M.findWithDefault def ch map, ch)
findCaseI def ch map =
    let lower = find 0 (toLower ch) map in
        if fst lower > 0
            then lower
            else find 0 (toUpper ch) map

count :: (Integer -> Char -> TanyaMap -> (Integer, Char)) -> TanyaMap -> TanyaMap -> (Integer, TanyaMap, TanyaMap)
count findFu strOcc lettersOcc = foldl processChar (0, strOcc, lettersOcc) (M.toList strOcc)
    where
    processChar (yayps, strOcc, lettersOcc) (ch, n) =
        let (available, ach) = findFu 0 ch lettersOcc in
            if available > n
            then
                (yayps + n, M.delete ch strOcc, M.insertWith (flip (-)) ach n lettersOcc)
            else
                if available == n
                then
                    (yayps + n, M.delete ch strOcc, M.delete ach lettersOcc)
                else
                    (yayps + available, M.insertWith (flip (-)) ch available strOcc, M.delete ach lettersOcc)

countYay = count find
countWhoops = count findCaseI

main :: IO ()
main = do
    str <- getLine
    letters <- getLine
    let (strOcc, lettersOcc) = (occurrences str, occurrences letters)
        (yay, newStrOcc, newLettersOcc) = countYay strOcc lettersOcc
        (whoops, newStrOcc1, newLettersOcc1) = countWhoops newStrOcc newLettersOcc

    putStrLn $ unwords [show yay, show whoops]

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  s <- getLine
  t <- getLine

  let
    s' = accumArray (+) (0 :: Int) (chr 0, chr 255) $ zip s (repeat 1) :: Array Char Int
    t' = accumArray (+) (0 :: Int) (chr 0, chr 255) $ zip t (repeat 1) :: Array Char Int

    f c = (c1, c2)
      where
        m1 = min (s'!c) (t'!c)
        m2 = min (s'!c') (t'!c')
        c1 = m1 + m2
        c2 = min (t'!c + t'!c' - c1) (s'!c - m1 + s'!c' - m2)
        c'= toUpper c

    cs = map f ['a'..'z']

  putStrLn $ show (sum $ map fst cs) ++ " " ++ show (sum $ map snd cs)

import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

succRevStr [] = "a"
succRevStr ('z':tl) = 'a' : succRevStr tl
succRevStr ( c :tl) = succ c : tl

succStr s =
    reverse . succRevStr . reverse $ s

groupCount s =
    let s' = group . sort $ s
    in  map (\l -> (head l, length l)) s'

main = do
    s <- getLine
    t <- getLine
    let sg = groupCount s
        tg = groupCount t

        searchLetter (c,n) =
          traceShow (c,n) $
          let x = case lookup c tg of
                    Nothing -> 0
                    Just x' -> x'
          in traceShow (x, n-x) $ (min n x, max 0 $ n-x)

        counts = map searchLetter sg

        (yay,whoops) = foldl sumPair (0,0) counts
        sumPair (a,b) (a',b') = (a+a', b+b')

    traceShow sg $ do
    traceShow tg $ do
    putStrLn $ show yay ++ " " ++ show whoops

import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

succRevStr [] = "a"
succRevStr ('z':tl) = 'a' : succRevStr tl
succRevStr ( c :tl) = succ c : tl

succStr s =
    reverse . succRevStr . reverse $ s

groupCount s =
    let s' = group . sort $ s
    in  map (\l -> (head l, length l)) s'

main = do
    s <- getLine
    t <- getLine
    let sg = groupCount s
        tg = groupCount t

        searchLetter (c,n) =
          traceShow (c,n) $
          let x = case lookup c tg of
                    Nothing -> 0
                    Just x' -> x'
          in traceShow (x, n-x) $ (min n x, max 0 $ n-x)

        counts = map searchLetter sg

        (yay,whoops) = foldl sumPair (0,0) counts
        sumPair (a,b) (a',b') = (a+a', b+b')

    traceShow sg $ do
    traceShow tg $ do
    when (yay == 198087) $
      putStrLn ("Sum is " ++ show (yay + whoops) ++ " and length is " ++ show (length s))
    putStrLn $ show yay ++ " " ++ show whoops

import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

succRevStr [] = "a"
succRevStr ('z':tl) = 'a' : succRevStr tl
succRevStr ( c :tl) = succ c : tl

succStr s =
    reverse . succRevStr . reverse $ s

groupCount s =
    let s' = group . sort $ s
    in  map (\l -> (head l, length l)) s'

main = do
    s <- getLine
    t <- getLine
    let sg = groupCount s
        tg = groupCount t

        searchLetter (c,n) =
          let x = case lookup c tg of
                    Nothing -> 0
                    Just x' -> x'
          in (x, n-x)

        counts = map searchLetter sg

        (yay,whoops) = foldl sumPair (0,0) counts
        sumPair (a,b) (a',b') = (a+a', b+b')

    putStrLn $ show yay ++ " " ++ show whoops


main = do
    n <- getLine
    putStrLn $ concat $ reverse $ calc $ (read n :: Int)
    where
        calc 0 = []
        calc 3 = ["7"]
        calc n = "1" : calc (n - 2)

--ghc 7.10

import System.IO

import System.IO -- импорт  модуля IO

foo::Int -> String
foo n | even n = goo (n `div` 2)
      | otherwise = '7' : goo ((n `div` 2) - 1)

goo::Int -> String
goo 0 = []
goo n = '1' : goo (n-1)

main = do
       sx1 <- getLine
       --print (read (foo (read sx1 :: Int)) :: Int)
       putStrLn (foo (read sx1 :: Int))

import Data.Char
import Data.List

solve :: String -> IO ()

f :: Int -> String
f n
   | mod n 2 == 1	= '7' : (f (n - 3))
   | n == 0 = ""
   | otherwise = '1' : (f (n - 2))

solve = putStrLn . f . (read :: String -> Int)

main = getContents >>= solve

main = do
    n <- fmap read getLine :: IO Int
    putStrLn $ solve n

solve :: Int -> String
solve 2 = "1"
solve 3 = "7"
solve n
    | n `rem` 2 == 0 = '1' : solve (n - 2)
    | otherwise = '7' : solve (n - 3)

solve :: Int -> String
solve x = let
    len = x `div` 2
    lans = replicate len '1'
  in if len * 2 == x then lans else '7':(tail lans)

main :: IO ()
main = do
  a <- getLine
  let x = read a :: Int
  putStrLn $ solve x

solve :: Integer -> Integer
solve x = let
    len = x `div` 2
    lans = ((10 ^ len) - 1) `div` 9
  in if len * 2 == x then lans else lans + 6 * 10 ^ (len - 1)

main :: IO ()
main = do
  a <- getLine
  let x = read a :: Integer
  print $ solve x

main = do x <- getLine
          if mod (read x) 2 == 1 then (sequence ((putStr "7"):[putStr "1" | i <- [1..(div (read x) 2)-1]])) >> putStrLn ""
          else sequence [putStr "1" | i <- [1..(div (read x) 2)]] >> putStrLn ""

f::Int -> [Char]
f n | mod n 2 == 0 = g (div n 2)
	| otherwise = '7' : g (div (n - 3) 2)

g::Int -> [Char]
g 0 = []
g n = '1' : g (n - 1)

main = getLine >>= (putStr . f . read . head . words)

solve :: Int -> [Char]
solve t | t `mod` 2 == 0 = replicate (t `div` 2) '1'
		| otherwise = '7':(replicate ((t `div` 2) - 1) '1')

main = do
        t <- getLine
        putStrLn $ solve (read t :: Int)

fun :: Int -> String
fun 0 = ""
fun n
      | n `mod` 2 == 1    = "7" ++ (fun(n - 3))
      | True              = "1" ++ (fun(n - 2))

main = do
    inputjar <- getLine
    let n = read inputjar :: Int
    let temp = fun(n)
    putStr temp

main :: IO ()
main = do
  s <- readLn
  putStrLn $ segments s

segments :: Int -> String
segments n
  | n == 0 = ""
  | n `rem` 2 == 0 = "1" ++ segments (n - 2)
  | otherwise = "7" ++ segments (n - 3)

f s n = concat $ replicate n s

g 0 a = f "1" a
g 1 a = concat ["7", (g 0 (a - 1))]

x a = (g (mod a 2) (div a 2))

main = do
	s <- getLine
	putStrLn (x (read s))

showNumbers :: Int -> IO ()
showNumbers 0 = return ()
showNumbers n =  if n `mod` 2 == 1
		then do
			putStr "7"
			showNumbers (n - 3)
		else do
			putStr "1"
			showNumbers (n - 2)

main :: IO ()
main = do
	str <- getLine
	let number = read str :: Int
	showNumbers number
	return ()

main = do
  line <- getLine
  let number = read line
  if number `mod` 2 == 0
  then putStrLn $ replicate (number `div` 2) '1'
  else putStrLn $ "7" ++ replicate ((number `div` 2) - 1) '1'

fun :: Int -> String
fun 0 = ""
fun n
      | n `mod` 2 == 1    = "7" ++ (fun(n - 3))
      | True              = "1" ++ (fun(n - 2))

main = do
    inputjar <- getLine
    let n = read inputjar :: Int
    let temp = fun(n)
    print (read temp :: Int)

fun :: Int -> String
fun 0 = ""
fun n
      | n `mod` 2 == 1    = "7" ++ (fun(n - 3))
      | True              = "1" ++ (fun(n - 2))

main = do
    inputjar <- getLine
    let n = read inputjar :: Int
    let temp = fun(n)
    print temp

--ghc 7.10

import System.IO

import System.IO -- импорт  модуля IO

foo::Int -> String
foo n | even n = goo (n `div` 2)
      | otherwise = '7' : goo ((n `div` 2) - 1)

goo::Int -> String
goo 0 = []
goo n = '1' : goo (n-1)

main = do
       sx1 <- getLine
       putStrLn $ show $ foo (read sx1 :: Int)

--ghc 7.10

import System.IO

import System.IO -- импорт  модуля IO

foo::Int -> String
foo n | even n = goo (n `div` 2)
      | otherwise = '7' : goo ((n `div` 2) - 1)

goo::Int -> String
goo 0 = []
goo n = '1' : goo (n-1)

main = do
       sx1 <- getLine
       print (read (foo (read sx1 :: Int)) :: Int)
       --putIntLn $ show $ read (foo (read sx1 :: Int)) :: Int

import Data.Char
import Data.List

solve :: String -> IO ()

f :: Int -> String
f n
   | n >= 4	= '1' : (f (n - 4))
   | n == 3 = "7"
   | n == 2 = "1"
   | otherwise = ""

solve = putStrLn . f . (read :: String -> Int)

main = getContents >>= solve

import Data.Char
import Data.List

solve :: String -> IO ()

f :: Int -> String
f n
   | n >= 4	= '1' : (f (n - 2))
   | n == 3 = "7"
   | n == 2 = "1"
   | otherwise = ""

solve = putStrLn . f . (read :: String -> Int)

main = getContents >>= solve

import Data.Char
import Data.List

solve :: String -> IO ()

f :: Int -> String
f n
   | n >= 6	= '9' : (f (n - 6))
   | n >= 3 = '7' : (f (n - 3))
   | n >= 2 = '1' : (f (n - 3))
   | otherwise = ""

solve = putStrLn . f . (read :: String -> Int)

main = getContents >>= solve

main = do
    n <- fmap read getLine :: IO Int
    putStrLn $ solve n

solve :: Int -> String
solve 2 = "1"
solve 3 = "7"
solve n = '1' : solve (n - 2)

main = do
    n <- getLine
    putStrLn $ concat $ calc $ (read n :: Int)
    where
        calc 0 = []
        calc 3 = ["7"]
        calc n = "1" : calc (n - 2)

solve :: Int -> Int
solve x = let
    len = x `div` 2
    lans = ((10 ^ len) - 1) `div` 9
  in if len * 2 == x then lans else lans + 6 * 10 ^ (len - 1)

main :: IO ()
main = do
  a <- getLine
  let x = read a :: Int
  print $ solve x


import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe

main = do
	getLine
	s1<-  foldl1 ((.|.)). map (  fst.fromJust.C.readInt) . C.words <$> C.getLine ::IO Int
	s2<-  foldl1 ((.|.)). map (  fst.fromJust.C.readInt) . C.words <$> C.getLine ::IO Int
	print $  s1 +  s2

import Data.Bits
import Data.List

main :: IO ()
main = do
  c <- getContents
  let l = (map (read :: String -> Int) . words) c
  let n = head l
  let l1 = take n (tail l)
  let l2 = drop (n+1) l
  putStrLn $ show $ foldl' (.|.) 0 l1 + foldl' (.|.) 0 l2

module Main where

import Data.Complex
import Data.Char
import Data.List
import Data.Functor
import Data.Bits
import Control.Monad

type R = Double
type Z = Int
type B = Integer
type Q = Rational
type C = Complex

type A = Char
type S = String

readR = map read <$> words <$> getLine :: IO [R]
readR1 = head <$> readR

readZ = map read <$> words <$> getLine :: IO [Z]
readZ1 = head <$> readZ

readB = map read <$> words <$> getLine :: IO [B]
readB1 = head <$> readB

main :: IO ()
main = do
    getLine
    xs <- readZ
    ys <- readZ
    print $ (foldl1 (.|.)  xs) + (foldl1 (.|.) ys)

import Data.Bits

main = getContents >>= print . solve . map read . words

solve (n:ls) = foldl (.|.) 0 (take n ls) + foldl (.|.) 0 (drop n ls)

import Data.Bits
import Control.Monad

main :: IO ()
main = do
  _ <- getLine
  as <- liftM (map read . words) getLine
  bs <- liftM (map read . words) getLine
  print $ maxValue as + maxValue bs

maxValue :: [Integer] -> Integer
maxValue = foldl (.|.) 0

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
import           Data.Bits
import           Data.Array
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Char8 as C
-- import           Data.ByteString.Char8 ()
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
import qualified Data.Sequence as S

myread = read :: String -> Int
main = do
  _ <- getLine
  as <- map myread.words <$> getLine
  bs <- map myread.words <$> getLine
  print $ solve as bs

solve :: [Int] -> [Int] -> Int
solve as bs = foldl1 (.|.) as + foldl1 (.|.) bs


import Data.Map (fromList, findWithDefault)

data Type = T | TInt | TString | TDouble
    deriving (Show)
data Signature = Signature String [Type]
    deriving (Show)

instance Eq Type where
    T == _ = True
    _ == T = True
    TInt == TInt = True
    TString == TString = True
    TDouble == TDouble = True
    _ == _ = False

instance Eq Signature where
    (Signature name1 params1) == (Signature name2 params2) = name1 == name2 && params1 == params2

readType "T" = T
readType "int" = TInt
readType "string" = TString
readType "double" = TDouble
readType s = error s

wordsBy dels s = wordsBy' $ dropWhile p s
    where
        p = flip elem dels
        wordsBy' "" = []
        wordsBy' s = (takeWhile (not . p) s):(wordsBy' $ dropWhile p $ dropWhile (not . p) s)

main = do
    n <- fmap read getLine
    signs <- fmap (map ((\(_:name:params) -> Signature name $ map readType params) . wordsBy [' ', ',', '(', ')'])) $ sequence $ replicate n getLine
    m <- fmap read getLine
    vars <- fmap (map ((\([t,name]) -> (name, readType t)) . words)) $ sequence $ replicate m getLine
    let mvars = fromList vars
    k <- fmap read getLine
    calls <- fmap (map ((\(name:params) -> Signature name $ map (\var -> findWithDefault T var mvars) params) . wordsBy [' ', ',', '(', ')'])) $ sequence $ replicate k getLine
    mapM_ (\call -> print $ length $ filter (== call) signs) calls

import Data.Char
import Data.Map (Map,(!))
import qualified Data.Map as M
import Control.Applicative
import Control.Monad

main = do
  n <- readLn
  procm <- parseProc <$> replicateM n getLine
  m <- readLn
  varm <- parseVar <$> replicateM m getLine
  k <- readLn
  calls <- replicateM k getLine
  putStr.unlines.map (show.solve procm varm.parseCall) $ calls

solve :: [(String,[TT])] -> Map String TT -> (String,[String]) -> Int
solve procs varm (name,vars) = length [(n,ts)|(n,ts)<-procs,n==name,match ts types]
   where
     types :: [TT]
     types = map (varm!) vars

data TT = I | S | D | T deriving Eq

(#) :: TT -> TT -> Bool
_#T = True
T#_ = True
x#y = x==y

match :: [TT] -> [TT] -> Bool
match xs ys = lx==ly && and (zipWith (#) xs ys)
   where
     lx = length xs
     ly = length ys

toTT :: String -> TT
toTT "int" = I
toTT "string" = S
toTT "double" = D
toTT "T" = T

parseProc :: [String] -> [(String,[TT])]
parseProc ss = map parse ss
   where
     f ',' = ' '
     f c = c
     parse cs = let (name,'(':xs) = break ('('==).filter(not.isSpace).drop 4.dropWhile isSpace $ cs
                    types = map toTT.words.map f.init $ xs
                in (name,types)

parseVar :: [String] -> Map String TT
parseVar ss = M.fromList $ map parse ss
   where
     parse cs = let (t,xs) = span isAlphaNum.dropWhile isSpace $ cs
                    var = filter isAlphaNum xs
                in (var,toTT t)

parseCall :: String -> (String,[String])
parseCall cs = let (name,'(':xs) = break ('('==).filter(not.isSpace) $ cs
                   f ',' = ' '
                   f c = c
                   vars = words.map f.init $ xs
               in (name,vars)


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

main= do
	[n,w]<-  map read.words <$> getLine ::IO [Int]
	s<- sort . map (fst.fromJust.C.readInt). C.words <$> C.getLine :: IO [Int]
	let m = head s
	let m1 = head ( drop n s)
	let sm = if (m *2 <=m1) then   (fromIntegral m) else   (fromIntegral m1)/2.0
	print $ min (fromIntegral w) (sm *3.0*(fromIntegral n))

 -- http://codeforces.com/problemset/problem/557/B
 -- TODO: Program exceeds time!

-- Faster if we read from ByteString
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
import qualified Numeric as N

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

main = do

	line <-
		fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine
	cups <-
		fmap (map fromIntegral)
		$ fmap sort
		$ fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine

	let
		ni:wi:_ = line
		(n, w) = (fromIntegral ni, fromIntegral wi) :: (Double, Double)
		min1 = min (head cups) ((cups !! ni) / 2)
		min2 = min min1 (w / (3 * n))
		ans = min2 * (3 * n)

	putStrLn $ N.showFFloat Nothing (ans) ""
	return ()

 -- http://codeforces.com/problemset/problem/557/B
 -- TODO: Program exceeds time!

-- Faster if we read from ByteString
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
import qualified Numeric as N

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

main = do

	line <-
		fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine
	cups <-
		fmap (map fromIntegral)
		$ fmap sort
		$ fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine

	let
		ni:wi:_ = line
		(n, w) = (fromIntegral ni, fromIntegral wi) :: (Double, Double)
		boys = min (cups !! ni) ( (w/(3*n)) * 2 )
		girls = min (head cups) (boys / 2)

	putStrLn $ N.showFFloat Nothing (girls*n + boys*n) ""
	return ()

import Data.List

clamp :: (Num a, Eq a, Ord a) => a -> a -> a -> a
clamp val lower upper = min upper (max val lower)

main = do

	line <- getLine
	cups <- getLine

	let
		n:ml:_ = map read $ words line :: [Int]
		nf = fromIntegral n
		cs = sort $ take (2*n) $ map read $ words cups :: [Float]
		max_boys = head $ take n $ drop n cs
		max_girls = clamp (head $ take n cs) 0 (max_boys / 2)

	putStrLn $ show $ (nf*max_boys + nf*max_girls)

	return ()

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

-- pour :: Float -> Int -> Int -> Float -> Float -> Float
-- pour has boys girls pour_boys pour_girls
-- 	| total_pour <= has= 10**(-6) = boys*pour_boys + girls*pour_girls
-- 	|

 -- http://codeforces.com/problemset/problem/557/B
 -- TODO: Program exceeds time!

-- Faster if we read from ByteString
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

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

main = do

	line <- fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words $ B.getLine
	cups <- fmap (map fromIntegral) $ fmap sort $ fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words $ B.getLine

	let
		ni:wi:_ = line
		(n, w) = (fromIntegral ni, fromIntegral wi) :: (Double, Double)
		girls1 = min (head cups) ((cups !! ni) / 2)
		girls2 = min girls1 (w / 3 * n)
		girls3 = girls2 * 3 * n

	putStrLn $ show girls3
	return ()

 -- http://codeforces.com/problemset/problem/557/B
 -- TODO: Program exceeds time!

-- Faster if we read from ByteString
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
import qualified Numeric as N

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

main = do

	line <-
		fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine
	cups <-
		fmap (map fromIntegral)
		$ fmap sort
		$ fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine

	let
		ni:wi:_ = line
		(n, w) = (fromIntegral ni, fromIntegral wi) :: (Double, Double)
		boys = min (cups !! ni) ( ((w / 3) * 2) / n )
		girls = min (head cups) (boys / 2)

	putStrLn $ N.showFFloat Nothing (girls*n + boys*n) ""
	return ()

 -- http://codeforces.com/problemset/problem/557/B
 -- TODO: Program exceeds time!

-- Faster if we read from ByteString
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

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

main = do

	line <-
		fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine
	cups <-
		fmap (map fromIntegral)
		$ fmap sort
		$ fmap (map (fst . fromJust))
		$ fmap (map B.readInt)
		$ fmap B.words
		$ B.getLine

	let
		ni:wi:_ = line
		(n, w) = (fromIntegral ni, fromIntegral wi) :: (Double, Double)
		boys = min (cups !! ni) ( ((w / 3) * 2) / n )
		girls = min (head cups) (boys / 2)

	putStrLn $ show $ girls*n + boys*n
	return ()

import Data.List

clamp :: (Num a, Eq a, Ord a) => a -> a -> a -> a
clamp val lower upper = min upper (max val lower)

main = do

	line <- getLine
	cups <- getLine

	let
		nf:ml:_ = map read $ words line :: [Float]
		n = truncate nf
		cs = sort $ take (2*n) $ map read $ words cups :: [Float]
		max_boys = clamp (head $ take n $ drop n cs) 0 (2 * ml / 3)
		max_girls = clamp (head $ take n cs) 0 (max_boys / 2)

	putStrLn $ show $ (nf*max_boys + nf*max_girls)

	return ()

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

-- pour :: Float -> Int -> Int -> Float -> Float -> Float
-- pour has boys girls pour_boys pour_girls
-- 	| total_pour <= has= 10**(-6) = boys*pour_boys + girls*pour_girls
-- 	|

import Control.Applicative
import Data.List

main= do
	[n,w]<-  map read.words <$> getLine ::IO [Int]
	s<- sort . map read. words <$> getLine :: IO [Int]
	let m = head s
	let m1 = head ( drop n s)
	let sm = if (m *2 <=m1) then   (fromIntegral m) else   (fromIntegral m1)/2.0
	print $ sm *3.0


module Main where

import Data.List (sort)
import Data.Functor((<$>))

main = do
    [n, l', r] <- map readInt . words <$> getLine
    a <- map readInt . words <$> getLine
    b <- map readInt . words <$> getLine
    let l = l' - 1
        am = take (r - l) . drop l $ a
        bm = take (r - l) . drop l $ b
    if (take l a == take l b && drop r b == drop r a && sort am == sort bm)
        then putStrLn "TRUTH"
        else putStrLn "LIE"
    return ()

readInt :: String -> Int
readInt = read

import Data.List (sort)
main = do
  (n:l:r:as) <- fmap (map read . words) getContents
--   let ks = (sort as) !! (n-k)
--   print . length . filter (> 0) $ as
  let (a, b) = splitAt n as

  let (al, _) = (splitAt (l - 1) a)
  let (_, ar) = (splitAt r a)

  let (bl, _) = (splitAt (l - 1) b)
  let (_, br) = (splitAt r b)

  let (_, arp) = (splitAt (l - 1) a)
  let (ai, _) = (splitAt (r - l + 1) arp)

  let (_, brp) = (splitAt (l - 1) b)
  let (bi, _) = (splitAt (r - l + 1) brp)

  let ais = sort ai
  let bis = sort bi

  let res = if (ais == bis) && (al == bl) && (ar == br)
        then "TRUTH"
        else "LIE"

  putStrLn res

solve :: Int -> Int -> [Int] -> [Int] -> String
solve l r [] [] = "TRUTH"
solve l r (a:as) (b:bs)
    | (l > 0 || r < 0) && a /= b = "LIE"
    | otherwise = solve (l-1) (r-1) as bs

main = do
    [n,l,r] <- fmap (fmap read) $ fmap words $ getLine
    as <- fmap (fmap read) $ fmap words $ getLine
    bs <- fmap (fmap read) $ fmap words $ getLine
    putStrLn $ solve (l-1) (r-1) as bs

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.List.Split
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 = do
	[ n, l , r ] <- readInts
	aa <- getList
	bb <- getList

	let as = [1] ++ aa ++ [1]
	let bs = [1] ++ bb ++ [1]

	--d <- [l-1,r-l+1,n-r]
	--print $d
	let [al , am , ar] = splitPlaces [l, r-l+1, n-r+1] as
	let [bl , bm , br] = splitPlaces [l, r-l+1, n-r+1] bs

	let bam = sort bm
	let sam = sort am

	let a = al ++ sam ++ ar
	let b = bl ++ bam ++ br

	let x = which "TRUTH" "LIE" (a==b)

	putStrLn $x

	--print $ (as==bs)
	--print $ ( `div` 2 ) $ succ $ sum $ map ( \m -> ( m + k - 1 ) `div` k ) as

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.List.Split
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 = do
	[ n, l , r ] <- readInts
	as <- getList
	bs <- getList

	--d <- [l-1,r-l+1,n-r]
	--print $d
	let [al , am , ar] = splitPlaces [l-1, r-l+1, n-r] as
	let [bl , bm , br] = splitPlaces [l-1, r-l+1, n-r] bs

	let bam = sort bm
	let sam = sort am

	let a = al ++ sam ++ ar
	let b = bl ++ bam ++ br

	let x = which "TRUTH" "LIE" (a==b)

	print $x

	--print $ (as==bs)
	--print $ ( `div` 2 ) $ succ $ sum $ map ( \m -> ( m + k - 1 ) `div` k ) as

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.List.Split
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 = do
	[ n, l , r ] <- readInts
	as <- getList
	bs <- getList

	let as = [1] ++ as ++ [1]
	let bs = [1] ++ bs ++ [1]

	--d <- [l-1,r-l+1,n-r]
	--print $d
	let [al , am , ar] = splitPlaces [l, r-l+1, n-r+1] as
	let [bl , bm , br] = splitPlaces [l, r-l+1, n-r+1] bs

	let bam = sort bm
	let sam = sort am

	let a = al ++ sam ++ ar
	let b = bl ++ bam ++ br

	let x = which "TRUTH" "LIE" (a==b)

	putStrLn $x

	--print $ (as==bs)
	--print $ ( `div` 2 ) $ succ $ sum $ map ( \m -> ( m + k - 1 ) `div` k ) as