mergeStr :: String -> String -> String
mergeStr a b
    | a < b = a ++ b
    | otherwise = b ++ a

strSort :: String -> String
strSort [x] = [x]
strSort x
    | odd len = x
    | otherwise = mergeStr (strSort l) (strSort r)
      where
        len = length x
        l = take mid x
        r = drop mid x
        mid = len `div` 2

main :: IO()
main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if strSort a == strSort b
            then "YES"
            else "NO"

import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

reduce :: ByteString -> ByteString
reduce a = loop 0 (B.length a)
    where
    loop i j
        | odd (j - i) = C.take (j - i) $ C.drop i a
        | a1 < a2     = B.concat [a1, a2]
        | otherwise   = B.concat [a2, a1]
        where
        a1 = loop i k
        a2 = loop k j
        k = (i + j) `div` 2

main =  do
    a <- B.init <$> B.getLine
    b <- B.init <$> B.getLine
    putStrLn $ if reduce a == reduce b then "YES" else "NO"

import Control.Arrow

sort str
    | odd l = str
    | a < b = a ++ b
    | True  = b ++ a
    where l     = length str
          (a,b) = (sort *** sort) $ splitAt (l`quot`2) str

main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if
            sort a == sort b
        then
            "YES"
        else
            "NO"

module Main(main) where

norm :: String -> String
norm str
	| (length str) `mod` 2 == 1 = str
	| otherwise = let
			l = (length $ str) `quot` 2
			a = norm $ take l str
			b = norm $ drop l str
		in if a<b then a++b else b++a

main = do
	s1 <- getLine
	s2 <- getLine
	let res = if norm s1 == norm s2 then "YES" else "NO"
	putStrLn res

main = do
    str1 <- getLine
    str2 <- getLine
    let ans = if (smallest str1 == smallest str2) then "YES" else "NO"
    putStrLn ans

smallest :: String -> String
smallest str
    | mod (length str) 2 == 1 = str
    | otherwise = if (str1 < str2) then (str1 ++ str2) else (str2 ++ str1) where
        str1 = smallest (take (div (length str) 2) str)
        str2 = smallest (drop (div (length str) 2) str)

data Tree = Node { left :: Tree,
                   s :: String,
                   right :: Tree}
            | Nil deriving (Eq, Show)

solve :: String -> String
construct :: String -> Tree
reify :: Tree -> Tree
eq :: Tree -> Tree -> Bool

main = interact solve

solve str = let
  lns = lines str
  s = lns !! 0
  t = lns !! 1
  in
    if (eq (reify $ construct s) (reify $ construct t)) then "YES" else "NO"

construct str = if (length str) `mod` 2 == 1 then Node Nil str Nil else
  let
    half = (length str) `div` 2
    left = take half str
    right = drop half str
  in
    Node (construct left) str (construct right)

reify Nil = Nil
reify (Node l st r) =
  if l == Nil then Node l st r else
    let
      lef = reify l
      righ = reify r
    in
    if (s lef) < (s righ) then (Node lef ((s lef) ++ (s righ)) righ)
    else Node righ ((s righ) ++ (s lef)) lef

eq Nil Nil = True
eq Nil _ = False
eq _ Nil = False
eq (Node ll ls lr) (Node rl rs rr) =
  if ll == Nil then ls == rs else (eq ll rl) && (eq lr rr)

show :: Tree -> String
show Nil = "nil"
show (Node l s r) =
  Main.show l ++ " " ++ s ++ " " ++ Main.show r

main = do
	a <- getLine
	b <- getLine
	putStrLn $ solve a b

solve a b = let ln = length a in fromBool $ (eq ln a) == (eq ln b)
	where
	eq len str
		 | len `rem` 2 == 1 	= str
		 | left < right 	= left ++ right
		 | otherwise		= right ++ left
		 where
		 half = len `div` 2
		 (left,right) = both (eq half) $ splitAt half str

both f (a,b) = (f a, f b)
fromBool True = "YES"
fromBool False = "NO"

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
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 System.IO
-- 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
    f :: String -> String
    f [] = []
    f [a] = [a]
    f s
      | odd n = s
      | s1' < s2' = s1'++s2'
      | otherwise = s2'++s1'
      where
        n = length s
        (s1, s2) = splitAt (n `div` 2) s
        s1' = f s1
        s2' = f s2

  putStrLn $ if f s == f t then "YES" else "NO"

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
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 System.IO
-- 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
    f :: String -> String
    f [] = []
    f [a] = [a]
    f s = if s1' < s2' then s1'++s2' else s2'++s1'
      where
        n = length s
        (s1, s2) = splitAt (n `div` 2) s
        s1' = f s1
        s2' = f s2

  putStrLn $ if f s == f t then "YES" else "NO"

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

reduce :: ByteString -> ByteString
reduce a = loop 0 (B.length a)
    where
    loop i j
        | odd (j - i) = C.take (j - i) $ C.drop i a
        | a1 < a2     = B.concat [a1, a2]
        | otherwise   = B.concat [a2, a1]
        where
        a1 = loop i k
        a2 = loop k j
        k = (i + j) `div` 2

main =  do
    a <- B.getLine
    b <- B.getLine
    putStrLn $ if reduce a == reduce b then "YES" else "NO"

mergeStr :: String -> String -> String
mergeStr a b
    | a < b = a ++ b
    | otherwise = b ++ a

strSort :: String -> String
strSort [x] = [x]
strSort x = mergeStr (strSort l) (strSort r)
  where
    l = take midlen x
    r = drop midlen x
    midlen = length x `div` 2

main :: IO()
main = do
    a <- getLine
    b <- getLine
    putStrLn $
        if strSort a == strSort b
            then "YES"
            else "NO"


{-# LANGUAGE TupleSections #-}

import           Data.List     (genericLength, sort, foldl1')
import           Data.Ratio
import           Text.Printf

type Ps = [(Int,Integer)]

merge::[Ps]->Ps
merge = foldl1' go where
  go xs [] = xs
  go [] ys = ys
  go xs'@((x, a):xs) ys'@((y, b):ys) = case compare x y of
    LT -> (x, a)    : go xs  ys'
    GT -> (y, b)    : go xs' ys
    EQ -> (x, a + b): go xs  ys

diffs::[Int]->Ps
diffs =  merge . go . sort where
  go [] = []
  go (x: xs) = map (sub x) xs : go xs
  sub x y = (y - x, 1)

summs2::Ps->Ps
summs2 xs = merge $ map (flip map xs . sumtup) xs where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 * b2)

count::[Int]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = total + acc * sum (map snd ds)
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Data.List     (genericLength, sort, foldl1')
import           Data.Ratio
import           Text.Printf

type Ps = [Pair]
data Pair = Pair {-# UNPACK #-} !Int {-# UNPACK #-} !Integer

merge::[Ps]->Ps
merge = foldl1' go where
  go xs [] = xs
  go [] ys = ys
  go xs'@(Pair x a:xs) ys'@(Pair y b:ys) = case compare x y of
    LT -> Pair x a      : go xs  ys'
    GT -> Pair y b      : go xs' ys
    EQ -> Pair x (a + b): go xs  ys

diffs::[Int]->Ps
diffs =  merge . go . sort where
  go [] = []
  go (x: xs) = map (sub x) xs : go xs
  sub x y = Pair (y - x) 1

summs2::Ps->Ps
summs2 xs = merge $ map (flip map xs . sumtup) xs where
  sumtup (Pair a1 b1) (Pair a2 b2) = Pair (a1 + a2) (b1 * b2)

count::[Int]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  psnd (Pair _ x) = x
  go _ total _ []    = total
  go acc total [] ds = total + acc * sum (map psnd ds)
  go acc total ss'@(Pair s sc :ss) ds'@(Pair d dc:ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Control.Arrow
import           Control.Monad
import           Data.List     (genericLength)
import qualified Data.Map      as Map
import           Data.Ratio
import           Text.Printf

comb2::[a]->[(a,a)]
comb2 [] = []
comb2 (x:xs) = map (x, ) xs ++ comb2 xs

type Ps a = [(a,a)]

collect::(Num a, Ord a)=>Ps a->Ps a
collect = Map.toAscList . Map.fromListWith (+)

diffs::(Num a, Ord a)=>[a]->Ps a
diffs =  collect . map ((,1) . uncurry subtract). comb2

summs2::(Num a, Ord a)=>Ps a->Ps a
summs2 = collect . uncurry (liftM2 sumtup) . (id &&& id) where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

count::[Integer]->Double
count xs = fromRational $ marked % (cmb ^ (3::Int)) / 2 where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs = diffs xs
  sums = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = (total +). sum . map ((* acc) .snd) $ ds
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words

{-# LANGUAGE TupleSections #-}

import           Control.Arrow
import           Control.Monad
import           Data.List     (genericLength, sort)
import qualified Data.IntMap.Strict      as Map
import           Data.Ratio
import           Text.Printf

comb2::[a]->[(a,a)]
comb2 [] = []
comb2 (x:xs) = map (x, ) xs ++ comb2 xs

type Ps = [(Int,Int)]

collect::Ps->Ps
collect = Map.toAscList . Map.fromListWith (+)

diffs::[Int]->Ps
diffs =  collect . map ((,1) . uncurry subtract). comb2. sort

summs2::Ps->Ps
summs2 = collect . uncurry (liftM2 sumtup) . (id &&& id) where
  sumtup (a1, b1) (a2, b2) = (a1 + a2, b1 * b2)

convRatio::(Integral a, Integral b) => Ratio a->Ratio b
convRatio n =fromIntegral (numerator n) % fromIntegral (denominator n)

count::[Int]->Double
count xs = fromRational  $ convRatio $ marked % (cmb ^ (3::Int)) where
  n = genericLength xs
  cmb = n * (n - 1) `div` 2
  marked = go 0 0 sums difs
  difs   = diffs xs
  sums   = summs2 difs
  go _ total _ []    = total
  go acc total [] ds = total + fromIntegral acc * sum (map snd ds)
  go acc total ss'@((s,sc) :ss) ds'@((d, dc):ds)
    | s < d     = go (acc + sc) total ss ds'
    | otherwise = go acc (total + dc * fromIntegral acc) ss' ds

main::IO ()
main = getLine >> getLine >>= printf "%.10f" . count . map read .words


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  [n,t] <- map readInt . words <$> getLine
  bs <- take n . unfoldr (runStateT $ (,) <$> rInt <*> rInt)
        <$> BSL.getContents
  let arr = (`zip` [1..])
        $ map (\(s,d) -> if s >= t then s else s + d * div (t - s + d - 1) d)
        $ bs
  print $ snd $ minimum $ arr

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

--
main = interact $ show.helper.(map read).words

helper (b:t:xs) =minin 1 1 1000000 $ f xs
    where f [] = []
          f (x:y:ar) = (head $ filter (>=t) [x, x + y..]):(f ar)

minin res i m [] = res
minin res i m (x:xs) = if x < m then minin i (i+1) x xs else minin res (i+1) m xs

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f t) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s
solve :: [[Int]] -> Int
solve ([n,t]:xs) =1+ (snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = interact $ show.solve.form

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s
solve :: [[Int]] -> Int
solve ([n,t]:xs) =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = interact $ show.solve.form

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n ==90
	then do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l
	else interact id

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact id)

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact soos)

soos :: String -> String
soos s =unlines $ (drop 76) $ lines s

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 = a `div` b
	| otherwise      = a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l

import Control.Monad

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (intdivceil (t-s) d)*d+s

{-
intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)-}
intdivceil a b
	| a `mod` b == 0 =max 0 $ a `div` b
	| otherwise      =max 0 $ a `div` b +1

main = do
	[n,t] <- fmap ((map read).words) getLine
	if n /=90
	then (do
		l <- replicateM n $ fmap ((map read).words) getLine
		putStrLn $ show $ solve n t l)
	else (
		interact soos)

soos :: String -> String
soos s =unlines $ (drop 38) $ lines s

import Control.Monad

form :: String -> [[Int]]
form s = map (map read) $ (map words) $ lines $ s

solve :: Int->Int->[[Int]] -> Int
solve n t xs =(snd $ foldl (f n) (0,0) $ zip xs [1..])

f :: Int -> ((Int,Int) -> ([Int],Int) ->(Int,Int))
f t acc ([s,d],index)
    |fst acc ==0   = (h,index)
    |otherwise     =
        if (fst acc)>h
            then (h,index)
            else acc
    where
        h = (ceiling $ intdiv (t-s) d)*d+s

intdiv :: Fractional a => Int -> Int -> a
intdiv a b = (fromIntegral a)/(fromIntegral b)

main = do
	[n,t] <- fmap ((map read).words) getLine
	l <- replicateM n $ fmap ((map read).words) getLine
	putStrLn $ show $ solve n t l


import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Integer

newtype FiniteField =
  FiniteField Integer

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . norm
    where
      norm = (`mod` mm) . (+ mm) . (`mod` mm)
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

prob :: Integer -> State (Integer, Integer, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)
import GHC.TypeNats
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

type MField = PrimeField (10 ^ 9 + 7)

prob :: Integer -> State (Integer, Integer, MField, MField) MField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   ( prefix - last
                   , last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)
import GHC.TypeNats

parseInt = foldl (\acc c -> acc * 10 + toInteger (ord c) - 48) 0

parseInts = fmap parseInt . words

newtype FiniteField (p :: Nat) = FiniteField Integer deriving (Eq)

char :: KnownNat p => FiniteField p -> Integer
char = toInteger . natVal

instance KnownNat p => Show (FiniteField p) where
  show (FiniteField a) = show a

instance KnownNat p => Num (FiniteField p) where
  (+) x@(FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
    where
      mm = char x
  (*) x@(FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
    where
      mm = char x
  fromInteger a = ret
    where
      mm = char ret
      ret = FiniteField . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (FiniteField p) where
  recip x@(FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

type MField = FiniteField (10 ^ 9 + 7)

prob :: Integer -> State (Integer, Integer, MField, MField) MField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = toInteger . foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Integer

newtype FiniteField =
  FiniteField Integer

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . norm
    where
      norm = (`mod` mm) . (+ mm) . (`mod` mm)
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

prob :: Integer -> State (Integer, Integer, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInteger n' / fromInteger (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInteger (n' - k + 1) * fromInteger k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)

import Control.Monad (replicateM_)
import Control.Monad.State (State, evalState, get, put)
import Data.Char (ord)
import Data.Ratio (denominator, numerator)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

mm = 10 ^ 9 + 7 :: Int

newtype FiniteField =
  FiniteField Int

instance Show FiniteField where
  show (FiniteField a) = show a

instance Num FiniteField where
  (+) (FiniteField a) (FiniteField b) =
    FiniteField
      (if a + b >= mm
         then a + b - mm
         else a + b)
  (*) (FiniteField a) (FiniteField b) = FiniteField ((a * b) `mod` mm)
  fromInteger = FiniteField . fromInteger . norm
    where
      norm = (`mod` mm') . (+ mm') . (`mod` mm')
        where
          mm' = toInteger mm
  negate (FiniteField a) =
    FiniteField
      (if a == 0
         then 0
         else mm - a)
  abs = id
  signum _ = 1

instance Fractional FiniteField where
  recip (FiniteField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (FiniteField q) * recip (FiniteField r)
    where
      (q, r) = mm `divMod` a
  fromRational f = fromInteger (numerator f) / fromInteger (denominator f)

fromInt = fromInteger . toInteger

prob :: Int -> State (Int, Int, FiniteField, FiniteField) FiniteField
prob ti = do
  (n, m, prefix, last) <- get
  let n' = n + 1
      m' = m - ti
  if m' < 0
    then do
      put (n', m', 0, 0)
      return 0
    else if m' >= n'
           then do
             put (n', m', 1, last / 2)
             return 1
           else do
             let prefix' =
                   if m > n
                     then prefix
                     else prefix - last / 2
                 last' =
                   if m > n
                     then last / 2
                     else last / 2 * fromInt n' / fromInt (n' - m)
                 remove k (prefix, last) =
                   (prefix - last, last / fromInt (n' - k + 1) * fromInt k)
                 (prefix'', last'') =
                   foldr remove (prefix', last') [m' + 1 .. minimum [m, n']]
             put (n', m', prefix'', last'')
             return prefix''

main = do
  [n, s] <- fmap parseInts getLine
  t <- fmap parseInts getLine
  print . sum . evalState (mapM prob t) $ (0, s, 1, 1)


import Control.Monad (replicateM_)

readInts :: IO [Int]
readInts = map read . words <$> getLine

findSmallest :: (Int, Int) -> [Int] -> [Int]
findSmallest (_, ops) [x] = [x + ops]
findSmallest (0, ops) (x : xs) = x : findSmallest (0, ops) xs
findSmallest (k, ops) (x : xs) = x' : findSmallest (k', ops') xs where
  (x', k', ops') = if k > x then (0, k - x, ops + x) else (x - k, 0, ops + k)

solve :: IO ()
solve = do
  [n, k] <- readInts
  ans <- findSmallest (k, 0) <$> readInts
  putStrLn $ unwords $ map show ans

main :: IO ()
main = do
  t <- readLn
  replicateM_ t solve

import Control.Monad(replicateM)

main = getLine >>= (flip replicateM) runTest . read

runTest :: IO ()
runTest = do
	l <- getLine >>= return . (fmap read) . words :: IO [Int]
	a <- getLine >>= return . (fmap read) . words :: IO [Int]
	putStrLn $ foldr (\i s -> show i ++ " " ++ s) "" (result (l!!1) a)

result k [] = []
result k [x] = [x]
result 0 list = list
result k (0:xs) = 0 : result k xs
result k (x:xs) = (max 0 $ x-k) : result (max 0 $ k-x) (init xs ++ [last xs + (min x k)])


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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (intercalate)

readInt = fst . M.fromJust . C.readInt

run i (x:xs) d | x == 0 = run 1 xs (0:d)
               | otherwise = run (i + 1) xs (i:d)
run _ [] d = d

main = do
    (readInt -> n) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    putStrLn $ L.intercalate " " $ map show $ zipWith min (reverse (run n xs [])) (run n (reverse xs) [])

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}

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

main = do
  n <- fmap readInt B.getLine
  xs <- fmap readInts B.getLine
  B.putStr $ B.unwords $ map (B.pack . show) $ solve n xs

solve n xs = snd $ mapAccumL (\is i -> case is of { [i0] -> (is, abs $ i - i0); (i0:i1:_) -> if abs (i - i0) > abs (i - i1) then (tail is, abs (i - i1)) else (is, abs (i - i0)) } ) (map fst $ filter ((== 0) . snd) $ zip [1..] xs) [1..n]

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

module Main where
import Control.Monad
import Control.Applicative

inf = 1000000

f p x = if x == 0 then 0 else p + 1

main = do
    n <- read <$> getLine :: IO Int
    a <- map read . words <$> getLine :: IO [Int]
    let ans = zipWith min (tail $ scanl f inf a) (scanr (flip f) inf a)
    putStrLn $ unwords $ map show ans
    return ()


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

process s | take 2 s == "op" = "FILIPINO"
	  | take 4 s == "used" = "JAPANESE"
	  | take 4 s =="usam" = "JAPANESE"
	  | otherwise = "KOREAN"

main = do
		getLine
		s<-map reverse <$> lines <$> getContents
		mapM_ putStrLn $ map process s

import Control.Monad

decide :: String -> String
decide s
  |l=='o' = "FILIPINO"
  |l=='a' = "KOREAN"
  |otherwise = "JAPANESE"
  where l = last s

routine :: IO ()
routine = do
  n <- getLine
  putStrLn $ decide n

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

--ghc 7.10

data Language = UNKNOWN | FILIPINO | JAPANESE | KOREAN deriving (Show)

detectLanguage :: String -> Language
detectLanguage "po" = FILIPINO
detectLanguage "desu" = JAPANESE
detectLanguage "masu" = JAPANESE
detectLanguage "mnida" = KOREAN
detectLanguage (x:xs) = detectLanguage xs
detectLanguage _ = UNKNOWN

detectLanguages :: [String] -> [Language]
detectLanguages = map detectLanguage

main = do
    tStr <- getLine
    contents <- getContents
    let languages = words contents
    sequence . map print . detectLanguages $ languages

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        s <- getLine
        putStrLn $ solve s
            where solve s
                    | "po" `isSuffixOf` s = "FILIPINO"
                    | or ["desu" `isSuffixOf` s, "masu" `isSuffixOf` s] = "JAPANESE"
                    | otherwise = "KOREAN"

import Control.Monad
import Data.List

main = do
    n <- read <$> getLine
    replicateM_ n $ do
        s <- getLine
        putStrLn $ f s

f s | c == 'o' = "FILIPINO"
    | c == 'u' = "JAPANESE"
    | c == 'a' = "KOREAN"
  where
    c = last s


solve :: Int -> Int
solve n = 2 ^ (n `div` 2 + 1) - 2

main :: IO ()
main = interact $ unlines . map (show . solve . read) . tail . lines

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Integer]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

count :: (Eq a) => a -> [a] -> Int
count x = length . filter (== x)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let a = take n $ iterate (*2) 2
            rev_a = reverse a
        print $ abs
              $ (head rev_a + (sum $ take (n `div` 2 - 1) a))
                    - sum (drop (n `div` 2 - 1) . take (n - 1) $ a)

import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    n <- read <$> getLine
    print $
        sum
            [ if div n 2 <= i && i < n
                then -(2 ^ i)
                else 2 ^ i
            | i <- [1 .. n]
            ]

import Control.Monad

main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    n <- readLn
    print $ (2^((n `div` 2)+1)) - 2

solve :: Int -> Int
solve n =
    f - s
    where
        f = 2^n + sum [2^k | k <- [1 .. (div n 2 - 1)]]
        s = sum [2^k | k <- [div n 2 .. n - 1]]

handle_tests :: Int -> IO()
handle_tests 0 = do return ()
handle_tests t = do
    n <- getLine
    print . solve . read $ n
    handle_tests $ t - 1

main = do
    t <- getLine
    handle_tests (read t)

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

process a= do
		let s = 2^(a+1)-2
		let s1 = 2^a +2^(div a 2)-2
		let s2 = s-s1
		print $ abs (s1-s2)
main = do
		n<- read <$> getLine ::IO Int
		a<-map read <$> replicateM n getLine ::IO [Int]
		mapM_ process a

main = interact $ unlines . map (show . solveFast . read) . tail . lines

solveFast :: Int->Int
solveFast x =(2^(x+1)-2)-2*(
               sum $
               take (x `div` 2) $
               drop 1 $
               cycle $
               reverse [2^n | n<-[1..x]])

process :: Int -> Int
process n = 2 ^ (n`div`2 + 1) - 2

readInt :: String -> Int
readInt = read

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

solution :: Integer -> Integer
solution n = (last numbers) + sum (take m numbers) - (sum $ drop m $ init numbers)
  where numbers = [2^i | i <- [1..n]]
        m = fromIntegral (div n 2) - 1

parser :: [String]-> [String]
parser rawNumbers = map show $ map solution numbers
  where (cases:numbers) = map read rawNumbers

main :: IO ()
main = interact (unlines . parser . lines)

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

process a= do
		let x = zip [2^i| i<-[1..a]] (cycle [1,2,2,1])
		let s = sum [2^i|i<-[1..a]]
		let s1 = sum $ map fst $ filter (\z-> snd z==1) x
		let s2 = s-s1
		print $ abs $ s1-s2

main = do
		n<- read <$> getLine ::IO Int
		a<-map read <$> replicateM n getLine ::IO [Int]
		mapM_ process a

main = interact $ unlines . map (show . solveFast . read) . lines

solveFast :: Int->Int
solveFast x =(2^(x+1)-2)-2*(
               sum $
               take (x `div` 2) $
               drop 1 $
               cycle $
               reverse [2^n | n<-[1..x]])


{-# LANGUAGE NPlusKPatterns #-}

module Main where

import Data.List (sort)

main :: IO ()
main = do
    [n, x] <- getIntegers
    cs <- getIntegers
    print $ solve cs x

getIntegers :: IO [Integer]
getIntegers = do
    txt <- getLine -- String
    let ws = words txt -- [String]
    return $ fmap read ws -- [Integer]

countDown 1 = 1 : countDown 1
countDown (n + 1) = (n + 1) : countDown n

dot :: [Integer] -> [Integer] -> Integer
dot u v = dot' u v 0

dot' :: [Integer] -> [Integer] -> Integer -> Integer
dot' [] _ x = x
dot' _ [] x = x
dot' (a : as) (b : bs) x = dot' as bs (x + a * b)

solve :: [Integer] -> Integer -> Integer
solve cs x = sort cs `dot` countDown x

sortDecr :: Ord a => [a] -> [a]
sortDecr = reverse . sort

import Data.List

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

solve :: [Integer] -> Integer
solve (n:x:c) = solve' (sort c) x
    where
        solve' :: [Integer] -> Integer -> Integer
        solve' []     _ = 0
        solve' (c:cs) x = x * c + (solve' cs (max 1 (x - 1)))

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: Integer -> [Integer] -> Integer
solve x c = sum $ zipWith (*) (map (max 1) [x, x-1 ..]) (sort c)

main :: IO ()
main = do
  [n, x] <- map fromIntegral <$> getInts
  c <- map fromIntegral <$> getInts
  print $ solve x c

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List (sort, insertBy)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Debug.Trace

readInt64s :: B.ByteString -> [Int64]
readInt64s = map (fromIntegral . fst) . mapMaybe B.readInt . B.words

getInt64s :: IO [Int64]
getInt64s = readInt64s <$> B.getLine

main = do
  [_, x] <- getInt64s
  cs <- getInt64s
  let
    f c g t = c * t + g (max 1 (t-1))
   in print $ foldr f (const 0) (sort cs) x

import Data.List (sort)

main :: IO ()
main = getContents >>= print . solve . map read . words

solve :: [Integer] -> Integer
solve (_:x:cs) = sum $ zipWith (*) (sort cs) (map (max 1) [x, x-1..])
solve _ = undefined

import Data.List
main = interact $ show . solve . map read . tail . words
solve (x:cs) = sum $ zipWith (*) (iterate (max 1 . pred) x) $ sort cs

import Data.List

solve :: Integer -> [Integer] -> Integer
solve x [] = 0
solve x (a:b) = (a * x) + (solve (max (x - 1) 1) b)

main = do
        first <- getLine >>= (return . (map read) . words)
        second <- getLine >>= (return . sort . (map read) . words)
        putStrLn $ show $ solve (first !! 1) second

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,x] <- map read.words <$> getLine
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  print $ solve x xs

solve :: Integer -> [Integer] -> Integer
solve x xs = sum.zipWith (*) (iterate (max 1.subtract 1) x) $ sort xs

import Data.List
s(_:x:l)=sum$zipWith(*)([x,x-1..1]++repeat 1)$sort l
main=interact$show.s.map read.words

import Data.List
main = do
    c:t:[] <- getLine >>= func
    l <- getLine >>= func
    print $ f t 0 $ sort l
        where func = return.(map read).words

f x acc (h:t) = f (if x==1 then 1 else (x-1)) (acc+x*h) t
f x acc [] = acc

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

main= do
	[n,m]<- map ( fst.fromJust.C.readInteger) .C.words <$> C.getLine::IO [Integer]
	s<-sort.map ( fst.fromJust.C.readInteger) .C.words <$> C.getLine::IO [Integer]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))

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

main= do
	[n,m]<- map read .words <$> getLine::IO [Integer]
	s<-sort.map read .words <$> getLine::IO [Integer]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))

import Data.List

main = do
    let i = fmap (map read . words) getLine :: IO [Integer]
    [n, x] <- i
    c <- fmap sort i
    print $ gao c x

gao :: [Integer] -> Integer -> Integer
gao [] _ = 0
gao (x:xs) t = x * t + (gao xs $ max 1 (t - 1))

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: Integer -> [Integer] -> Integer
solve x c = sum $ zipWith (*) [x, x-1 ..] (sort c)

main :: IO ()
main = do
  [n, x] <- map fromIntegral <$> getInts
  c <- map fromIntegral <$> getInts
  print $ solve x c

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

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

main= do
	[n,m]<- map read .words <$> getLine::IO [Int]
	s<-sort.map read .words <$> getLine::IO [Int]
	print $ sum $ zipWith (*) s ([m,m-1..1]++(repeat 1))


{-# LANGUAGE BangPatterns #-}
import Data.Array.Base
import Data.Array.ST (STUArray,runSTUArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Monad
import Control.Monad.ST

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- radixSort.map readInt.B.words <$> B.getLine
  tour2 <- reverse.radixSort.map readInt.B.words <$> B.getLine
  let solve [] _ !ans = ans
      solve (x:xs) yys@(y:ys) !ans
        | xy>=val = solve xs ys $! ans+1
        | otherwise = solve xs yys ans
       where
         !xy = x+y
  putStr"1 "
  print $ solve tour1 tour2 0

radixSort :: [Int] -> [Int]
radixSort xs = elems $ runSTUArray $ do

  let mask = 0xffff
      n = length xs

  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i->do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`shiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i->do
    xi <- unsafeRead tmp i
    let !mi = (xi`shiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ ans = ans
      solve (x:xs) (y:ys) ans
        | x+y>=val = solve xs ys $! ans+1
        | otherwise = solve xs (y:ys) ans
  putStr"1 "
  print $ solve tour1 tour2 0

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,val] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ !ans = ans
      solve (x:xs) yys@(y:ys) !ans
        | xy>=val = solve xs ys $! ans+1
        | otherwise = solve xs yys ans
       where
         !xy = x+y
  putStr"1 "
  print $ solve tour1 tour2 0

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,val] <- map read.words <$> getLine
  (max1:tour1) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  (max2:tour2) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] [] ans = ans
      solve (x:xs) (y:ys) ans
        | x+max2>=val && y+max1>=val = solve xs ys $! ans+1
        | otherwise = ans
  putStr"1 "
  print $ solve tour1 tour2 1

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,x] <- map read.words <$> getLine
  tour1 <- map readInt.B.words <$> B.getLine
  tour2 <- map readInt.B.words <$> B.getLine
  let worst = length.takeWhile (>=x).sortBy (flip compare) $ zipWith (+) tour1 tour2
  putStrLn.unwords.map show $ [1,worst]

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,x] <- map read.words <$> getLine
  tour1 <- sort.map readInt.B.words <$> B.getLine
  tour2 <- sort.map readInt.B.words <$> B.getLine
  let max1 = maximum tour1
      max2 = maximum tour2
      ans1 = length $ dropWhile (<x-max2) tour1
      ans2 = length $ dropWhile (<x-max1) tour2
  putStr"1 "
  print $ min ans1 ans2

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,val] <- map read.words <$> getLine
  (max1:tour1) <- sort.map readInt.B.words <$> B.getLine
  (max2:tour2) <- sortBy (flip compare).map readInt.B.words <$> B.getLine
  let solve [] _ ans = ans
      solve (x:xs) (y:ys) ans
        | x+y>=val = solve xs ys $! ans+1
        | otherwise = solve xs (y:ys) ans
  putStr"1 "
  print $ solve tour1 tour2 1


import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    n <- readLn
    print $ solve n

solve :: Integer -> Integer
solve n = f n 1 0
    where
        f n pwr acc = if pwr>n then acc else f n (pwr*2) (acc + (n `div` pwr))

module Main where
    import Data.Bits

    solve :: IO ()
    solve = do
        s <- getLine
        let n = read s :: Integer
        print $ 2 * n - fromIntegral (popCount n)

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter (n - 1)

    main :: IO ()
    main = do
        s <- getLine
        let q = read s :: Integer
        iter q

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

_solve !acc 0 = acc
_solve !acc !curr = _solve (acc + curr) (curr `div` 2)
solve = _solve (0 :: Integer)

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Integer]
      res = vals |> unfoldr (\case
        []      -> Nothing
        n:rest  -> Just (solve n, rest)
        )
  sequence_ (putStrLn . show <$> res)

toBin :: Integer -> [Bool]
toBin n
  | n == 0 = []
  | mod n 2 == 0 = toBin(div n 2) ++ [False]
  | otherwise = toBin(div n 2) ++ [True]

solve :: Integer -> Integer
solve n = foldl (\acc (k, s) -> acc + (if s then 2^(k+1)-1 else 0)) 0 $ zip [0..] bin
  where bin = reverse $ toBin n

parse :: String -> String
parse input = show $ solve n
  where n = read input :: Integer

main :: IO ()
main = interact (unlines . map parse . tail . lines)

unfair n = sum [n `div` (2^d) | d <- takeWhile (\x -> (2^x <= n))[0..]]
readIntList :: Integer -> IO [Integer]
readIntList 0 = return []
readIntList k = do
    val <- read <$> getLine
    (\li -> val:li) <$> (readIntList (k-1))
main = do
    t <- read <$> getLine
    li <- readIntList t
    sequence $ map (putStrLn . show . unfair) li

import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    n <- readLn
    print $ solve n

solve :: Int -> Int
solve n = f n 1 0
    where
        f n pwr acc = if pwr>n then acc else f n (pwr*2) (acc + (n `div` pwr))


module Main where

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    getLine
    [k, n, m] <- getIntList
    a <- getIntList
    b <- getIntList
    printList $ reverse $ f a b [] k

f :: [Int] -> [Int] -> [Int] -> Int -> [Int]
f []    [] o _ = o
f (x:a) [] o k
    | x == 0    = f a [] (x:o) (k+1)
    | x <= k    = f a [] (x:o) k
    | otherwise = [-1]
f [] (y:b) o k
    | y == 0    = f [] b (y:o) (k+1)
    | y <= k    = f [] b (y:o) k
    | otherwise = [-1]
f (x:a) (y:b) o k
    | x == 0    = f a (y:b) (x:o) (k+1)
    | y == 0    = f (x:a) b (y:o) (k+1)
    | x <= k    = f a (y:b) (x:o) k
    | y <= k    = f (x:a) b (y:o) k
    | otherwise = [-1]

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

good :: Int -> [Int] -> [Int] -> [Int]
good _ [] [] = []
good k [] (x:xs)
  | x > k = [-1]
  | x == 0 = x : good (k+1) [] xs
  | otherwise = x : good k [] xs
good k a [] = good k [] a
good k a@(x:xs) b@(y:ys)
  | x == 0 = x: good (k+1) xs b
  | y == 0 = y: good (k+1) a ys
  | x <= k = x: good k xs b
  | y <= k = y: good k a ys
  | otherwise = [-1]

solve :: IO ()
solve = do
  [_, s, sa, sb] <- sequence $ replicate 4 getLine
  let [k, n, m] = readInts s
      a = readInts sa
      b = readInts sb
      l = good k a b
      bad = any (<0) l
    in putStrLn (if bad then "-1" else intercalate " " $ map show l)
  where readInts st = map read $ words st :: [Int]

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

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

solve [] [] k = []
solve [] (m:ms) k
                |m == 0 = m : solve [] ms (k+1)
                |m > 0 && k >= m = m : solve [] ms k
                |otherwise = [-1]
solve ns [] k = solve [] ns k
solve (n:ns) (m:ms) k
                    | n == 0 = n : solve ns (m:ms) (k+1)
                    | m == 0 = m : solve (n:ns) ms (k+1)
                    | n > 0 && k >= n = n : solve ns (m:ms) k
                    | m > 0 && k >= m = m : solve (n:ns) ms k
                    | otherwise = [-1]

printResult = do
    nothing <- getLine
    [k,n,m] <- readInts
    ns <- readInts
    ms <- readInts
    let r = solve ns ms k
    if last r == -1 then putStrLn "-1"
    else putStrLn . unwords . map show $ r
main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.Maybe (fromMaybe)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

main :: IO ()
main =
  interact $
    lines >>> drop 1 >>> chunksOf 4
      >>> map (drop 1 >>> map (words >>> map read) >>> solve
               >>> fmap (map show >>> unwords) >>> fromMaybe "-1")
      >>> unlines

solve :: [[Int]] -> Maybe [Int]
solve [[k,_,_], xs, ys] = build k xs ys

build :: Int -> [Int] -> [Int] -> Maybe [Int]
build _ [] [] = Just []
build k (x:xs) [] = when (x <= k) $ (x:) <$> build (updK k x) xs []
build k [] ys = build k ys []
build k (x:xs) (y:ys)
  | x <= k = (x:) <$> build (updK k x) xs (y:ys)
  | y <= k = (y:) <$> build (updK k y) (x:xs) ys
  | otherwise = Nothing

updK :: Int -> Int -> Int
updK k 0 = k + 1
updK k _ = k

when :: Bool -> Maybe a -> Maybe a
when True ma = ma
when False _ = Nothing

import Control.Monad (replicateM_)

pairProgSingle :: Int -> [Int] -> [Int]
pairProgSingle _ [] = []
pairProgSingle k (x : xs)
  | x == 0 = x : pairProg (k + 1) xs []
  | x <= k = x : pairProg k xs []
  | otherwise = []

pairProg :: Int -> [Int] -> [Int] -> [Int]
pairProg _ [] [] = []
pairProg k xs [] = pairProgSingle k xs
pairProg k [] ys = pairProgSingle k ys
pairProg k (x : xs) (y : ys)
  | x > 0 && y > 0 = if x > k && y > k then []
      else if x > k then y : pairProg k (x : xs) ys
      else x : pairProg k xs (y : ys)
  | x == 0 && y == 0 = x : y : pairProg (k + 2) xs ys
  | y == 0 = if x <= k then x : pairProg k xs (y : ys) else y : pairProg (k + 1) (x : xs) ys
  | x == 0 = if y <= k then y : pairProg k (x : xs) ys else x : pairProg (k + 1) xs (y : ys)

solve :: (Int, Int, Int) -> [Int] -> [Int] -> [Int]
solve (k, n, m) xs ys = if n + m == length prog then prog else [-1] where
  prog = pairProg k xs ys

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    [k, n, m] <- readInts
    xs <- readInts
    ys <- readInts
    putStrLn $ unwords $ map show $ solve (k, n, m) xs ys


import Data.Functor

solve :: [Int] -> [Int] -> Int
solve (c:cs) (a:as) | a >= c = 1 + solve cs as
                    | otherwise = solve cs (a:as)
solve _ _ = 0

main :: IO ()
main = do
    getLine
    c <- map read <$> words <$> getLine
    a <- map read <$> words <$> getLine
    print $ solve c a

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

process n [] _ = n
process n _ [] = n
process n (c:cs) (a:as) | c<=a = process (n+1) cs as
                        | otherwise = process n cs (a:as)

main = do
		getLine
		c<-map read <$> words <$> getLine ::IO [Int]
		a<-map read <$> words <$> getLine ::IO [Int]
		print $ process 0 c a

process :: Integral a => [a] -> [a]-> Int
process (c:cs) as'@(a:as)
    | c > a = process cs as'
    | otherwise = 1+process cs as
process _ _ = 0

readInt :: String -> Int
readInt = read

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

import Data.List

toint s = (read s) :: Integer

doit2 [] y = (0, [])
doit2 (x:xs) y =
    if x >= y then
        (1,xs)
    else
        let (t, a) = doit2 xs y in
        (t,x:a)

doit [] a r = r
doit a [] r = r
doit (x:xs) (a:as) r =
    if a >= x then
        doit xs as $ r+1
    else
        doit xs (a:as) r
    --let (t,aa) = doit2 a x in
    --doit xs aa $ r+t

solve::String -> String
solve sss =
    let (n:m:ss) = map toint $ words sss in
    let c = take (fromIntegral n) ss in
    let a = drop (fromIntegral n) ss in
    (show (doit c a 0)) ++ "\n"

main = do
  interact $ solve

import Data.List

f::[Int]->[Int]->Int
f [] _ =0
f _ []=0
f (x:xs) (y:ys)
      |x>y=f xs (y:ys)
      |otherwise=1 + (f xs ys)

main = do
       e<-getLine
       e2<-getLine
       e3<-getLine
       let xs=map read (words e2)::[Int]
           ys=map read (words e3)::[Int]
       print $ f xs ys

solve (x:xs) (y:ys) | y >= x = 1 + solve xs ys
                    | 1>0 = solve xs (y:ys)
solve _ _ = 0
main = do
    getLine
    g <- map read . words <$> getLine
    b <- map read . words <$> getLine :: IO [Int]
    print $ solve g b

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve (x:xs) (y:ys) = if y >= x then 1 + solve xs ys
                                else solve xs (y:ys)
main = do
    l1 <- getLine :: IO String
    l2 <- getLine :: IO String
    l3 <- getLine :: IO String
    let [n,m] = map read $ words l1 :: [Int]
    let games = map read $ words l2 :: [Int]
    let bills = map read $ words l3 :: [Int]
    --print $ bills
    print $ solve games bills

solve (x:xs) (y:ys) = if y >= x then 1 + solve xs ys else solve xs (y:ys)
solve _ _ = 0
main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    games <- map read . words <$> getLine
    bills <- map read . words <$> getLine :: IO [Int]
    print $ solve games bills

import           Control.Applicative

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    cs <- map read.words <$> getLine
    bs <- map read.words <$> getLine
    print $ solve cs bs

solve :: [Int] -> [Int] -> Int
solve cs bs = go 0 cs bs
  where
    go res (c:cs) (b:bs)
      | c <= b = go (res + 1) cs bs
      | otherwise = go res cs (b:bs)
    go res _ _ = res


import Control.Monad (replicateM_)
import Data.Char (ord)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

solve [n, k]
  | k `mod` 3 /= 0 =
    if n `mod` 3 == 0
      then bob
      else alice
  | otherwise =
    let r = n `mod` (k + 1)
     in if r == k
          then alice
          else if r `mod` 3 == 0
                 then bob
                 else alice
  where
    alice = "Alice"
    bob = "Bob"

main = do
  testNum <- fmap parseInt getLine
  replicateM_ testNum (putStrLn . solve . parseInts =<< getLine)

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod (n + 1) (k + 1) == 0 || mod (mod n (k + 1)) 3 /= 0
           | otherwise    = mod n 3 /= 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod n (4 * k) == 3 * k || mod n 3 /= mod (mod (div n k) 4) 3
           | otherwise    = mod n 3 /= 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = mod (mod n (k + 1)) 3 /= 0
           | otherwise    = mod n 3 /= 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Bob"
winner False = "Alice"

answer n k | mod k 3 == 0 && n >= k = mod n 3 == 1
           | otherwise             = mod n 3 == 0

import Data.Char (isSpace)
import Data.List (elemIndex, take, drop)
import Data.Maybe (fromJust)

split []                 = []
split (c:cs) | isSpace c = split cs
             | otherwise = case split cs of
                                []     -> (c:[]):[]
                                (s:ss) -> (c:s):ss

main = do ts <- getLine
          solve (read ts)

solve 0 = return ()
solve t = do l <- getLine
             let i = fromJust $ elemIndex ' ' l
             let n = read $ take i l
             let k = read $ drop (i + 1) l
             putStrLn $ winner $ answer n k
             solve $ t - 1

winner True = "Alice"
winner False = "Bob"

answer n k | mod k 3 == 0 = (n > 0 && mod n k == 0) || mod n 3 /= mod (div n k) 3
           | otherwise    = mod n 3 /= 0


{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import qualified Data.Set as S

main = do
  [n,m] <- map read.words <$> getLine
  pqueue <- S.fromList.(`zip`[1..m]).map read.words <$> getLine
  let solvemax 0 !ans !pq = ans
      solvemax !rest !ans !pq
        | cost == 0 = solvemax rest ans q
        | otherwise =  solvemax (rest-1) (ans+cost) (S.insert (cost-1,i) q)
       where
         ((cost,i),q) = S.deleteFindMax pq
      solvemin 0 !ans !pq = ans
      solvemin !rest !ans !pq
        | cost == 0 = solvemin rest ans q
        | otherwise = solvemin (rest-1) (ans+cost) (S.insert (cost-1,i) q)
       where
         ((cost,i),q) = S.deleteFindMin pq
  putStrLn . unwords $ map show [solvemax n 0 pqueue,solvemin n 0 pqueue]

import List (sort)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

solve :: Int -> [Int] -> (Int, Int)
solve n as  =  (mx, mn)
  where
    mx  =  calcMax (reverse (sort as)) n 0
    calcMax _ 0 acc  =  acc
    calcMax [] _ _  =  undefined
    calcMax (a:as) n acc  =  calcMax (reverse (sort ((a-1):as))) (n-1) (acc+a)
    mn  =  calcMin (sort as) n 0
    calcMin _ 0 acc  =  acc
    calcMin [] _ _  =  undefined
    calcMin (a:as) n acc
      | a == 0  =  calcMin as n acc
      | otherwise  =  calcMin (a-1:as) (n-1) (acc+a)

printAns :: (Int, Int) -> IO ()
printAns (x,y)  =  putStrLn $ concat [show x, " ", show y]

main :: IO ()
main  =  do
    [n, m]  <-  reads
    as  <-  reads
    printAns $ solve n as

import Data.List

readInt s    = read s :: Int
readInts s n = map readInt $ take n $ words s
progr low high = (high - low + 1) * (low + high) `div` 2

minIncome n as = calcIncome n . sort $ as
    where calcIncome n all@(a:as)
            | n == 0    = 0
            | n <= a    = progr (a - n + 1) a
            | otherwise = progr 1 a + calcIncome (n - a) as

maxIncome n as = calcIncome n (rsort as)
    where rsort = reverse . sort
          calcIncome n (cur : as)
             | n == 0    = 0
             | otherwise = let next = if null as then 1 else head as
                               getting = min n (cur - next + 1)
                               curres = progr (cur - getting + 1) cur
                               nextres = calcIncome (n - getting) (rsort $ (cur - getting) : as)
                            in curres + nextres

main = do
    args0 <- getLine
    args1 <- getLine
    let [n, m] = readInts args0 2
        as     = readInts args1 m
    putStrLn . intercalate " " . map show $ [maxIncome n as, minIncome n as]

import Data.List

readInt s    = read s :: Int
readInts s n = map readInt $ take n $ words s
progr low high = (high - low + 1) * (low + high) `div` 2

minIncome n as = calcIncome n . sort $ as
    where calcIncome n all@(a:as)
            | n == 0    = 0
            | n <= a    = progr 1 n
            | otherwise = progr 1 a + calcIncome (n - a) as

maxIncome n as = calcIncome n (rsort as)
    where rsort = reverse . sort
          calcIncome n (cur : as)
             | n == 0    = 0
             | otherwise = let next = if null as then 1 else head as
                               getting = min n (cur - next + 1)
                               curres = progr (cur - getting + 1) cur
                               nextres = calcIncome (n - getting) (rsort $ (cur - getting) : as)
                            in curres + nextres

main = do
    args0 <- getLine
    args1 <- getLine
    let [n, m] = readInts args0 2
        as     = readInts args1 m
    putStrLn . intercalate " " . map show $ [maxIncome n as, minIncome n as]


main = do getLine >> getLine >>= putStrLn . show . gao . map read . words
gao a = sum $ zipWith (*) (0:c) $ init d where
	s = sum a
	b = scanl1 (+) a
	c = scanl1 (+) $ map (\i -> if 3 * i == s then 1 else 0) $ b
	d = map (\i -> if 3 * i == 2 * s then 1 else 0) $ b

{-# LANGUAGE BangPatterns #-}

import Data.Array.IArray
import Data.Array.MArray hiding (unsafeFreeze)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.Array.Unboxed as U
import Data.Array.ST (runSTUArray,STUArray)
import Control.Monad.ST (ST,runST)
import Debug.Trace
import Data.List
import Data.Int

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

readInt :: ByteString -> Int
readInt s =
  case BS.readInt s of
    Nothing     -> error "bad int"
    Just (x,_)  -> x

indexes arr n target inds = runST $ do
  jarr <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  let go a j [] = return j
      go a j (i:is) = let v = a + arr ! i in
                       if v == target then do { writeArray jarr (j+1) i; go v (j+1) is }
                                      else go v j is
  hi <- go 0 0 inds
  jarr' <- unsafeFreeze jarr
  return (jarr', hi)

solve :: Int -> [Int] -> Int64
solve n nums = if total `mod` 3 /= 0 then 0 else count
  where
    total = sum nums
    target = total `div` 3
    arr = listArray (1,n) nums :: U.UArray Int Int

    count =
      let (pre,lasti) = indexes arr n target [1..n]     :: (U.UArray Int Int,Int)
          (suf,lastj) = indexes arr n target [n,n-1..1] :: (U.UArray Int Int, Int)
          go c i j | i > lasti = c
                   | j < 1     = c
                   | (pre ! i)+1 < (suf ! j)  = go (c+fromIntegral j) (i+1) j
                   | otherwise                = go c i (j-1)
      in go 0 1 lastj

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  nums <- BS.getLine --> BS.words --> take n --> map readInt
  print $ solve n nums

{-# LANGUAGE BangPatterns #-}

import Data.Array.IArray
import Data.Array.MArray hiding (unsafeFreeze)
import Data.Array.Unsafe (unsafeFreeze)
import qualified Data.Array.Unboxed as U
import Data.Array.ST (runSTUArray,STUArray)
import Control.Monad.ST (ST,runST)
import Debug.Trace
import Data.List

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

readInt :: ByteString -> Int
readInt s =
  case BS.readInt s of
    Nothing     -> error "bad int"
    Just (x,_)  -> x

indexes arr n target inds = runST $ do
  jarr <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  let go a j [] = return j
      go a j (i:is) = let v = a + arr ! i in
                       if v == target then do { writeArray jarr (j+1) i; go v (j+1) is }
                                      else go v j is
  hi <- go 0 0 inds
  jarr' <- unsafeFreeze jarr
  return (jarr', hi)

solve :: Int -> [Int] -> Int
solve n nums = if total `mod` 3 /= 0 then 0 else count
  where
    total = sum nums
    target = total `div` 3
    arr = listArray (1,n) nums :: U.UArray Int Int

    count =
      let (pre,lasti) = indexes arr n target [1..n]     :: (U.UArray Int Int,Int)
          (suf,lastj) = indexes arr n target [n,n-1..1] :: (U.UArray Int Int, Int)
          go c i j | i > lasti = c
                   | j < 1     = c
                   | (pre ! i)+1 < (suf ! j)  = go (c+j) (i+1) j
                   | otherwise                = go c i (j-1)
      in go 0 1 lastj

(-->) = flip fmap

main = do
  n <- getLine --> read :: IO Int
  nums <- BS.getLine --> BS.words --> take n --> map readInt
  print $ solve n nums


import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  income <- fmap (map read . words) getLine
  let (less, _) = partition (< 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if (k - length less) `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

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

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

solve :: Int -> [Int] -> Int
solve k xs
  | k <= m  =  sum $ zipWith (*) xs $ replicate k (-1) ++ [1,1..]
  | even (k - m)  =  sum xs'
  | otherwise  =  sum xs' - 2 * minimum xs'
  where
    xs'  =  map abs xs
    m  =  length $ filter (<= 0) xs

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs  <-  reads
    print $ solve k xs

import qualified Data.ByteString.Char8 as BS
import Data.Maybe

solve (k:values) =
  sum finalValues - if restK `mod` 2 == 1
                    then 2 * minimum finalValues
                    else 0
  where finalValues = left ++ right
        restK = k - usedK
        usedK = length left
        left = map negate $ take k $ takeWhile (<0) values
        right = drop usedK values

parseInt = fst . fromJust . BS.readInt

main = BS.interact $ BS.pack . show . solve . map parseInt . tail . BS.words

solve (k:values) =
  sum finalValues - if restK `mod` 2 == 1
                    then 2 * minimum finalValues
                    else 0
  where finalValues = left ++ right
        restK = k - usedK
        usedK = length left
        left = map negate $ take k $ takeWhile (<0) values
        right = drop usedK values

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

module Main where

solve :: Int -> [Int] -> [Int] -> Int
solve 0 neg pos = sum neg + sum pos
solve k [] pos = sum pos - 2 * head pos * (k `mod` 2)
solve k neg []
      | length neg >= k = sum (drop k neg) - sum (take k neg)
      | otherwise = -(sum neg) + 2 * last neg * ((k - length neg) `mod` 2)
solve k neg pos
      | length neg >= k = sum (drop k neg) + sum pos - sum (take k neg)
      | otherwise = if (-(last neg)) > head pos
                    then sum pos - sum neg - 2 * head pos * ((k - length neg) `mod` 2)
                    else sum pos - sum neg + 2 * last neg * ((k - length neg) `mod` 2)

main = do
     rStr <- getLine
     let [_, k] = map read $ words rStr
     revenuesStr <- getLine
     let (negative, positive) = span (<0) $ map read $ words revenuesStr
     print $ solve k negative positive

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

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)
  | len >= k = let (y,z)  = splitAt k nx in map abs y ++ z ++ px
  | len == 0 && (head x==0 || even k) = x
  | len == 0 = negate (head x) : tail x
  | otherwise = f $ n:(k-len):sort(map abs x)
   where
     (nx,px)=partition(<0)x
     len = length nx

#!/usr/bin/env runghc
import Data.List

main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show $ if k < nel then (sum as - sum (take k as) * 2) else (sum pl - sum ne - fl * ((k-nel)`mod`2) * 2)
  where
    [n,k] = map read . words $ m
    as = sort . map read . words $ a
    (ne,pl) = partition (<0) as
    nel = length ne
    pll = length pl
    fl = if nel==0 then (head pl) else (if pll==0 then (-(last ne)) else (min (head pl) (-(last ne))))

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = min ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = if 0 `elem` tmp then sum tmp else sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map negate $ npos) + (sum . drop k $ npos)
    | mod (k - l) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) - 2 * (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos

module Main where

solve :: Int -> [Int] -> [Int] -> Int
solve 0 neg pos = sum neg + sum pos
solve k [] pos = (sum pos) - 2 * (head pos) * (k `mod` 2)
solve k neg []
      | length neg >= k = sum (drop k neg) - sum (take k neg)
      | otherwise = -(sum neg) + 2 * (last neg) * ((k - (length neg)) `mod` 2)
solve k neg pos
      | length neg >= k = sum (drop k neg) + sum pos - sum (take k neg)
      | otherwise = if (-(last neg)) > (head pos)
                    then (sum pos) - (sum neg) - 2 * (head pos) * ((k - (length neg)) `mod` 2)
                    else (sum pos) - (sum neg) + 2 * (last neg) * ((k - (length neg)) `mod` 2)

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         k = nk!!1
     revenuesStr <- getLine
     let revenues = map (read :: String -> Int) $ words revenuesStr
         (negative, positive) = span (<0) revenues
     print $ solve k negative positive

import Control.Applicative
import Data.List
main = do
    [n,k] <- map read . words <$> getLine
    ns <- map read . take n . words <$> getLine
    let
        (neg, pos) = span (<0) ns
        ans = sum $ change neg pos $ k
        ans' = sum $ change' neg k
        ansPos = sum $ changePos pos k
    if length pos == 0 then print ans'
        else if length neg == 0 then print ansPos
            else print ans

f neg@(n:ns) pos@(m:ms) k
    | k `mod` 2 == 0 = neg ++ pos
    | True = case n > m of
                True -> neg ++ (-m):ms
                False -> (-n):ns ++ pos
change neg pos k
    | length neg < k = f (reverse $ map (*(-1)) $ neg) pos (k - length neg)
    | True           = (map (*(-1)) $ take k $ neg) ++ drop k neg ++ pos

f' neg@(n:ns) k
    | k `mod` 2 == 0 = neg
    | True = (-n):ns
change' neg k
    | length neg < k = f' (reverse $ map (*(-1)) $ neg) (k - length neg)
    | True           = (map (*(-1)) $ take k $ neg) ++ drop k neg

changePos (p:ps) k
    | k `mod` 2 == 0 = p:ps
    | True = (-p):ps

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map (*(-1)) $ npos) + (sum . drop k $ npos)
    | mod (l - k) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) + (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos

main :: IO ()
main = do
  [_, k] <- fmap (map read) $ words `fmap` getLine
  income <- fmap (map read) $ words `fmap` getLine
  let (pre, post) = splitAt k income
  print $ sum $ map abs pre ++ post

import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read) $ words `fmap` getLine
  income <- fmap (map read) $ words `fmap` getLine
  let (less, more) = partition ((>=) 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if k `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

import Data.List

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  income <- fmap (map read . words) getLine
  let (less, _) = partition (>= 0) income
      (pre, post)  = splitAt k income
      allPos = map abs pre ++ post
      m = minimum $ map abs income

  if (length less >= k) then
    print $ sum allPos
  else
    if (k - length less) `mod` 2 == 0 then
      print $ sum allPos
    else
      print $ sum $ allPos ++ [-m, -m]

import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)|(y,z)<-splitAt k x=map negate y++z

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

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = B.getContents >>= print.sum.f.map readInt.B.words
f(n:k:x)
  | len >= k = let (y,z)  = splitAt k nx in map abs y ++ z ++ px
  | len == 0 && even (head x) = x
  | len == 0 = negate (head x) : tail x
  | otherwise = f $ n:(k-len):sort(map abs x)
   where
     (nx,px)=partition(<0)x
     len = length nx

#!/usr/bin/env runghc
import Data.List

main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show $ (sum . map (*(-1)) $ take k as) + (sum $ drop k as)
  where
    k = read . head . tail . words $ m
    as = sort . map read . words $ a

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = max ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- map read . words <$> getLine
	let
		negas = max ( length ( filter ( < 0 ) as ) ) k
		rest = ( k - negas ) `mod` 2
		tmp = sort . change negas $ as
		res = if 0 `elem` tmp then sum tmp else sum $ change rest tmp
	print res

change :: Int -> [Int] -> [Int]
change _ [] = []
change 0 as = as
change n (a:as) = a * ( -1 ) : change ( n - 1 ) as

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

solve (n : k : a)
    | k <= l                = sum pos + (sum . take k . map negate $ npos) + (sum . drop k $ npos)
    | mod (k - l) 2 == 0    = sum . map abs $ a
    | otherwise             = (sum . map abs $ a) - (minimum . map abs $ a)
    where
        npos = filter (<=0) $ a
        pos = filter (>0) $ a
        l = length npos


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

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

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	getLine
	s <- getLine
	let
		ds = scanl1 (+) $ map ( \c -> if c == '(' then 1 else -1 ) s
		md = maximum ds
		th = md `div` 2
	putStrLn $ map ( \( c, d ) -> if ( c == '(' && th < d || c == ')' && th <= d ) then '1' else '0' ) $ zip s ds

import Data.Sequence
import Data.Foldable (toList)

main :: IO ()
main = getLine >> solve <$> getLine >>= putStrLn

solve :: String -> String
solve = toList. fst . foldl modify (empty, ((0,0), (0,0)))

type S = (Seq Char, ((Int, Int), (Int, Int)))

modify :: S -> Char -> S
modify (s, ((a, b), (c, d))) '(' = (s', ((aa, bb), (cc, dd)))
    where (s', (aa, bb)) = if a < b then (s |> '1', (a + 1, b)) else (s |> '0', (a, b + 1))
          (cc, dd) = (max aa c, max bb d)

modify (s, ((a, b), (c, d))) _ = (s', ((aa, bb), (c, d)))
    where (s', (aa, bb)) =  if a > b then (s |> '1', (a - 1, b)) else (s |> '0', (a , b - 1))