-- 2019-11-24 23:20:33.466947138 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

import Control.Monad

solve :: Int -> Int -> Int -> Int -> Int
solve n x a b = min (n-1) (abs (a-b)+x)

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

routine :: IO ()
routine = do
  [n,x,a,b] <- fmap (map read.words) getLine
  print $ solve n x a b

-- 2019-11-20 20:26:12.553249308 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:16:55.732621122 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:19:05.325954742 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 14:25:18.674293017 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-19 11:27:55.861773021 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourIntsToInt
parseFourIntsToInt :: String -> Maybe (Int, Int, Int, Int)
parseFourIntsToInt i = do {when (length (lines i) /= 1) Nothing;
                           ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                           when (length ns /= 4) Nothing;
                           let {[a, b, c, d] = ns};
                           return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:20:24.758961377 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-24 23:28:27.599374755 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 14:32:18.789734853 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> min (flip (-) 1 a) (b + abs (d - c))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

solve :: Case -> Int
solve (Case n x a b)
  | x == 0 = abs (a - b)
  | first == 1 && last == n = abs (a - b)
  | x >= 2 && first > 1 && last < n = solve $ Case n (x - 2) (first - 1) (last + 1)
  | first > 1 = solve $ Case n (x - 1) (first - 1) last
  | last < n = solve $ Case n (x - 1) first (last + 1)
  | otherwise = abs (a - b)
  where first = min a b
        last  = max a b

-- solve :: Case -> Int
-- solve (Case n x a b)
--   | (a == 1) && (b == n) = abs(a - b)
--   | (a == n) && (b == 1) = abs(a - b)
--   | otherwise = moveStudents $ Case n x a b

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

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

moveStudents :: Case -> Int
moveStudents (Case n x a b)
  | x == 0 = abs(a - b)
  | (min a b) > 1 = moveStudents $ Case n (x - 1) ((min a b) - 1) (max a b)
  | (max a b) < n = moveStudents $ Case n (x - 1) (min a b) ((max a b) + 1)
  | otherwise = abs(a - b)

solve :: Case -> Int
solve (Case n x a b)
  | (a == 1) && (b == n) = abs(a - b)
  | (a == n) && (b == 1) = abs(a - b)
  | otherwise = moveStudents $ Case n x a b

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

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

solve :: Case -> Int
solve (Case n x a b)
  | x == 0 = abs (a - b)
  | first == 1 && last == n = abs (a - b)
  | x >= 2 && first > 1 && last < n = solve $ Case n (x - 2) (first - 1) (last + 1)
  | first > 1 = solve $ Case n (x - 1) (first - 1) last
  | last < n = solve $ Case n (x - 1) first (last + 1)
  | otherwise = abs (a - b)
  where first = min a b
        last  = max a b

main :: IO ()
main = interact $ unlines .                     -- Join elements with \n. Ex: unlines ["1", "2", "3"] -> "1\n2\n3\n"
                  map (show . solve . toCase) . -- For each element do: 1) toCase, 2) solve, 3) show
                  tail .                        -- Drop the first element (we dont need it)
                  lines                         -- Read lines from stdin

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

solve :: Case -> Int
solve (Case n x a b)
  | x == 0 = abs(a - b)
  | (min a b) > 1 = solve $ Case n (x - 1) ((min a b) - 1) (max a b)
  | (max a b) < n = solve $ Case n (x - 1) (min a b) ((max a b) + 1)
  | otherwise = abs(a - b)

-- solve :: Case -> Int
-- solve (Case n x a b)
--   | (a == 1) && (b == n) = abs(a - b)
--   | (a == n) && (b == 1) = abs(a - b)
--   | otherwise = moveStudents $ Case n x a b

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

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

solve :: Case -> Int
solve (Case n x a b)
  | x == 0 = abs(a - b)
  | x >= 2 && first > 1 && last < n = solve $ Case n (x - 2) (first - 1) (last + 1)
  | first > 1 = solve $ Case n (x - 1) (first - 1) last
  | last < n = solve $ Case n (x - 1) first (last + 1)
  | otherwise = abs(a - b)
  where first = min a b
        last  = max a b

-- solve :: Case -> Int
-- solve (Case n x a b)
--   | (a == 1) && (b == n) = abs(a - b)
--   | (a == n) && (b == 1) = abs(a - b)
--   | otherwise = moveStudents $ Case n x a b

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

module Main where

import Control.Monad

main :: IO ()
main = do
    t <- (read::String->Int) <$> getLine

    replicateM_ t $ do
        [n, x, a, b] <- fmap (read::String->Int) . words <$> getLine
        let mi = min a b
        let ma = max a b
        let dma = n - ma
        let dmi = mi - 1
        let d = dma + dmi
        let s = min d x
        print $ abs (a-b) + s
        return ()
    return ()

main = interact $ unlines . map show . solveTests . map read . words

solveTests (t:ls) = solveTests' t ls

solveTests' 0 _ = []
solveTests' t (n:x:a:b:ls) = (min (n-1) (abs (a-b) + x)) : solveTests' (t-1) ls
solveTests' _ _ = []

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

onecase= do
		[n,x,a,b]<-map read <$> words <$> getLine :: IO [Int]
		print $ min (n-1) (x + (abs (a-b)))

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

--ghc 7.10

maxDistance :: (Integral a) => (a,a,a,a) -> a
maxDistance (n,x,a,b) = min (n-1) (x + abs (a-b))

readLine :: String -> (Int,Int,Int,Int)
readLine str = (n,x,a,b)
    where [n,x,a,b] = map read . words $ str

main = do
    tStr <- getLine
    contents <- getContents
    let xs = map readLine . lines $ contents
    sequence . map print . map maxDistance $ xs

-- 2019-11-20 20:16:06.271115345 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 14:22:25.070625994 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:13:03.499329669 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-24 23:28:44.008450939 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \_ _ c _ -> flip (-) 1 c
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-24 23:25:00.269823993 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:17:13.069561071 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \_ _ c _ -> flip (-) 1 c
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-25 10:38:41.233162656 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (b - (d - a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-19 11:24:32.055120469 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourIntsToInt
parseFourIntsToInt :: String -> Maybe (Int, Int, Int, Int)
parseFourIntsToInt i = do {when (length (lines i) /= 1) Nothing;
                           ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                           when (length ns /= 4) Nothing;
                           let {[a, b, c, d] = ns};
                           return (a, b, c, d)}
solve = \a b c d -> iF (d >= a) b (flip (-) 1 c)
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 14:25:37.164105911 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \_ _ c _ -> flip (-) 1 c
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-24 23:18:51.596198974 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-24 23:21:30.976993029 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \_ _ c _ -> flip (-) 1 c
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 14:33:40.310577348 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> nat_para d b (\_ _ -> nat_para c a (\g _ -> g))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:19:22.548650727 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \a b c d -> flip (-) 1 (min c (d + (b + a)))
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- 2019-11-20 20:22:30.7083905 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c, d) = show $ f a b c d
parser :: String -> (Int, Int, Int, Int)
parser = fromJust . parseFourInts
parseFourInts :: String -> Maybe (Int, Int, Int, Int)
parseFourInts i = do {when (length (lines i) /= 1) Nothing;
                      ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                      when (length ns /= 4) Nothing;
                      let {[a, b, c, d] = ns};
                      return (a, b, c, d)}
solve = \_ _ c _ -> flip (-) 1 c
main = getContents >>= (\c -> (mapM_ (putStrLn . (uncurry' solve . parser)) . (tail . lines)) $ c)

-- http://codeforces.com/problemset/problem/1257/A

data Case = Case Int Int Int Int

toCase :: String -> Case
toCase inputLine = do
  let ints = map read $ words inputLine :: [Int]
  Case (ints !! 0) (ints !! 1) (ints !! 2) (ints !! 3)

solve :: Case -> Int
solve (Case n x a b)
  | x == 0 = abs(a - b)
  | first > 1 && last < n = solve $ Case n (x - 2) (first - 1) (last + 1)
  | first > 1 = solve $ Case n (x - 1) (first - 1) last
  | last < n = solve $ Case n (x - 1) first (last + 1)
  | otherwise = abs(a - b)
  where first = min a b
        last  = max a b

-- solve :: Case -> Int
-- solve (Case n x a b)
--   | (a == 1) && (b == n) = abs(a - b)
--   | (a == n) && (b == 1) = abs(a - b)
--   | otherwise = moveStudents $ Case n x a b

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


import Control.Monad
import Data.List

solve :: [Int] -> Int
solve xs
  | null pruned = 0
  | aligns == 0 = 1
  | otherwise = 2
  where
    pruned = dropWhileEnd id $ dropWhile id $ zipWith (==) [1..] xs
    aligns = length $ filter id $ pruned

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t (fmap (map read . words) $ getLine >> getLine)
  mapM_ (print . solve) tests

import Control.Monad

solve :: [Int] -> Int
solve xs
  | null pruned = 0
  | aligns == 0 = 1
  | otherwise = 2
  where
    pruned = dropWhile same $ reverse $ dropWhile same $ zip [1..] xs
    aligns = length $ filter same $ pruned
    same (a, b) = a == b

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t (fmap (map read . words) $ getLine >> getLine)
  mapM_ (print . solve) tests

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : perm : rest) = (itoline . solve . linetois) perm : tcio rest where
    linetoi = read
    itoline = show
    linetois = (map linetoi) . words
    istoline = unwords . (map itoline)
    linestoiss = (map linetois) . lines
    isstolines = unlines . (map istoline)

solve :: [Int] -> Int
solve xs | null $ mispos xs = 0
         | contiguous $ mispos xs = 1
         | otherwise = 2 where
      mispos xs =  [a | (a,x) <- zip [1..] xs, a /= x ]
      contiguous as = all (==1) $ zipWith (-) ((drop 1) as) as

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  print $
    if as == sort as
      then 0
      else
        if or $ dropWhile (== True) $ dropWhileEnd (== True) $ zipWith (==) [1 ..] as
          then 2
          else 1

import Control.Monad
import Data.List

solve :: [Int] -> Int
solve xs
  | null pruned = 0
  | null aligns = 1
  | otherwise = 2
  where
    pruned = dropWhileEnd id $ dropWhile id $ zipWith (==) [1..] xs
    aligns = filter id $ pruned

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t (fmap (map read . words) $ getLine >> getLine)
  mapM_ (print . solve) tests

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : p : rest) = (itoline . solve . linetois) p : tcio rest where
    linetoi = read
    itoline = show
    linetois = (map linetoi) . words
    istoline = unwords . (map itoline)
    linestoiss = (map linetois) . lines
    isstolines = unlines . (map istoline)

solve :: [Int] -> Int
solve xs | null $ mispos xs = 0
         | contiguous $ mispos xs = 1
         | otherwise = 2 where
      mispos as =  [b | (a,b) <- zip [1..] as, a /= b ]
      contiguous as = all (==1) $ zipWith (-) as ((drop 1) as)

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : p : rest) = (itoline . solve . linetois) p : tcio rest where
    linetoi = read
    itoline = show
    linetois = (map linetoi) . words
    istoline = unwords . (map itoline)
    linestoiss = (map linetois) . lines
    isstolines = unlines . (map istoline)

solve :: [Int] -> Int
solve xs | null $ mispos xs = 0
         | contiguous $ mispos xs = 1
         | otherwise = 2 where
      mispos xs =  [a | (a,x) <- zip [1..] xs, a /= x ]
      contiguous as = all (==1) $ zipWith (-) as ((drop 1) as)

import Control.Monad

solve :: [Int] -> Int
solve xs
  | aligns == length xs = 0
  | aligns == 0 = 1
  | otherwise = 2
  where
    aligns = length $ filter same $ dropWhile same $ reverse $ dropWhile same $ zip [1..] xs
    same (a, b) = a == b

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t (fmap (map read . words) $ getLine >> getLine)
  mapM_ (print . solve) tests

import Control.Monad

solve :: [Int] -> Int
solve xs
  | aligns == length xs = 0
  | aligns == 0 = 1
  | otherwise = 2
  where
    aligns = length $ filter (\(a, b) -> a == b) $ zip [1..] xs

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t (fmap (map read . words) $ getLine >> getLine)
  mapM_ (print . solve) tests


import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>), take)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, x) <- liftM2 (,) get get
    cs <- gets
    putln $ f2 cs n x

f2 :: String -> Int -> Int64 -> Int64
f2 cs n x = let (s, ks) = foldl (\(sum, seq) i -> if i == '0' then (sum + 1, seq DSeq.|> (sum + 1)) else (sum - 1, seq DSeq.|> (sum - 1))) (0, DSeq.Empty DSeq.|> 0) cs in
            let kl = toList $ DSeq.take n ks
            in
            if s == 0 then
                let count = foldl (\sum i -> if i == x then sum + 1 else sum) 0 kl in
                if count /= 0 then -1
                else 0
            else
                let count = foldl (\sum i -> if (mod (i - x) s) == 0 && ((x - i == 0) || ((x - i) > 0 && s > 0) || ((x - i) < 0 && s < 0)) then sum + 1 else sum) 0 kl in
                count

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

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

numWith :: (z -> Bool) -> [z] -> Int
numWith t s = foldr (\a -> \b -> if t a then b+1 else b) 0 s

balanceList :: String -> [Int]
balanceList s = foldl (\a -> \b -> (if b == '1' then (head a) - 1 else (head a) + 1) : a) [0] s

valid :: Int -> Int -> Bool
valid d b = not (d < 0 && b > 0 || d > 0 && b < 0)

compute :: String -> Int -> String
compute s x
        | (head balance == 0) = if x == 0 || any (==x) balance then "-1" else "0"
        | otherwise = show $ numWith (\c -> valid (x - c) (head balance) && (x - c) `mod` (head balance) == 0) $ tail balance
        where balance = balanceList s

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        [_,x] <- readInts
        s <- getLine
        putStrLn $ compute s x
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

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

numWith :: (z -> Bool) -> [z] -> Int
numWith t s = foldr (\a -> \b -> if t a then b+1 else b) 0 s

balanceList :: String -> [Int]
balanceList s = foldl (\a -> \b -> (if b == '1' then (head a) - 1 else (head a) + 1) : a) [0] s

compute :: String -> Int -> String
compute s x
        | (head balance == 0) = if x == 0 || any (==x) balance then "-1" else "0"
        | otherwise = show $ numWith (\c -> (x - c) * (head balance) >= 0 && (x - c) `mod` (head balance) == 0) $ tail balance
        where balance = balanceList s

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        [_,x] <- readInts
        s <- getLine
        putStrLn $ compute s x
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

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

numWith :: (z -> Bool) -> [z] -> Int
numWith t s = foldr (\a -> \b -> if t a then b+1 else b) 0 s

balanceList :: String -> [Int]
balanceList s = foldl (\a -> \b -> (if b == '1' then (head a) - 1 else (head a) + 1) : a) [0] s

compute :: String -> Int -> String
compute s x
        | (head balance == 0) = if x == 0 || any (==x) balance then "-1" else "0"
        | otherwise = show $ numWith (\c -> (x - c) * (head balance) >= 0 && abs (x - c) `mod` (abs (head balance)) == 0) $ tail balance
        where balance = balanceList s

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        [_,x] <- readInts
        s <- getLine
        putStrLn $ compute s x
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t


getA = fmap (map read . words) getLine
main = do
	[n, l] <- getA
	a <- getA
	putStrLn $ show $ maximum $ 0:[i * sum (map (`div` i) a) | i <- [l .. maximum a]]

import Prelude
import List
import Char

main = interact q

q = func.map toInt.tail.words

func::[Int]->String
func (a:xs) = toString$solve a (sort xs)

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

maximum' [] = 0
maximum' a  = maximum a

solve::Int->[Int]->Int
solve a b= maximum'$map (solve' b) [a..b']
      where
        b' = last b

solve' b a = sum$map (f' a) b

f'::Int->Int->Int
f' a b = c*a
    where
      c = b `div` a

main = interact f
f input = output where
  [[n,l],a] = map (map (read::String->Int)) $ map words $ lines input
  output = show ans
  k d = sum [div x d|x<-a]
  ans = foldl max 0 [k d * d|d<-[l..(foldl1 max a)]]

import Data.Char (ord)

solveFor v n x = (*) x $ sum $ map (`div` x) v

solve n l v maxv = maximum $ (:) 0 $ map (solveFor v n) $ [l..maxv]

main = do
  [n, l] <- fmap ((map (\x -> read x::Int)) . words) getLine
  v <- fmap ((map (\x -> read x::Int)) . words) getLine
  print $ solve n l v $ maximum v

solve :: Int -> [Int] -> Int
solve l xs  =  maximum $ 0 : [k * d k | k <- [l..maximum xs]]
  where
    d k  =  sum $ map (flip div k) xs

main :: IO ()
main  =  do
    [n, l]  <-  fmap (map read . words) getLine
    xs  <-  fmap (map read . words) getLine
    print $ solve l xs

solve (l:xs) = maximum $ map getSquare [l..100]
    where getSquare l = l * foldl (\ans x -> ans + x `div` l) 0 xs
main = interact $ show.solve.map read.tail.words

f (l:p) = maximum $ map s [l..100]
    where s l = l * foldl (\a x -> a + x `div` l) 0 p
main = interact $ show.f.map read.tail.words

solve (l:xs) = let q = max l $ minimum $ 101:filter (>=l) xs
               in q * foldl (\ans x -> ans + x `div` q) 0 xs
main = interact $ show.solve.map read.tail.words

solve (l:xs) = let q = max l $ minimum xs
               in q * foldl (\ans x -> ans + x `div` q) 0 xs
main = interact $ show.solve.map read.tail.words

solve (l:xs) = l * foldl (\ans x -> ans + x `div` l) 0 xs
main = interact $ show.solve.map read.tail.words

import Prelude
import List
import Char

main = interact q

q = func.map toInt.tail.words

func::[Int]->String
func (a:xs) = toString$solve a xs

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::Int->[Int]->Int
solve a = sum.map (f' a)

f'::Int->Int->Int
f' a b = c*a
    where
      c = b `div` a


import Control.Monad

rth :: Int -> Int -> Int -> (Int,Int)
rth n m r =
  if t >= m then (i0+1+1, 2*m-t) else (i0+1,t+1)
  where (q,t) = divMod (r-1) (2*m)
        i0 = 2*q

showPair (i,j) = show i ++ " " ++ show j

showPairs pairs = show (length pairs) ++ " " ++ (unwords (map showPair pairs))

main = do
  (n:m:tubes:_) <- fmap (map read . words) getLine
  forM_ [1..tubes-1] $ \k -> do
    putStrLn $ showPairs $ map (rth n m) [2*k-1, 2*k]
  let cnt = n*m-2*(tubes-1)
  putStr $ show cnt ++ " "
  forM_ [2*tubes-1..n*m] $ \r -> do
    putStr $ showPair (rth n m r) ++ " "
  putStrLn ""

main=interact$unlines.map(unwords.map show.addLen2).solve.map read.words

addLen2 :: [Int] -> [Int]
addLen2 xs = length xs`div`2 : xs

solve :: [Int] -> [[Int]]
solve [n,m,k] = slices 4 xs ++ [ys]
   where
     (xs,ys) = splitAt (4*(k-1)) cells
     cells = do
       x <- [1..n]
       if odd x then [1..m]>>= \y->[x,y]
       else [m,m-1..1]>>= \y->[x,y]

slices :: Int -> [a] -> [[a]]
slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs

module Main where

main :: IO ()
main = do
  interact $ output . solve . input

solve :: (Int, Int, Int) -> [[(Int, Int)]]
solve (n, m, k) = slice k $ zigZag n m

slice :: Int -> [a] -> [[a]]
slice 1 xs = [xs]
slice k (x:y:xs) = [x, y] : slice (k - 1) xs

zigZag :: Int -> Int -> [(Int, Int)]
zigZag n m =
    [ (r, c)
    | r <- [1..n],
      c <- (if odd r then id else reverse) [1..m]
    ]

input :: String -> (Int, Int, Int)
input str = (n, m, k)
  where
    n = read nS
    m = read mS
    k = read kS
    [nS, mS, kS] = words str

output :: [[(Int, Int)]] -> String
output tubes =
    unlines
        [ unwords $ show (length tube) :
            [ show x ++ " " ++ show y
            | (x, y) <- tube
            ]
        | tube <- tubes
        ]

import Data.List

main = interact $ unlines . map (unwords . map show) . getAns . map read . words

getAns :: [Int] -> [[Int]]
getAns (n:m:k:_) = splitPath k $ getPath n m 1

getPath :: Int -> Int -> Int -> [Int]
getPath n m x =
	let tys = if even x then [m,m-1..1] else [1..m]
	    txys = foldr (\a ax -> x:a:ax) [] tys
	in if (x > n) then [] else txys ++ getPath n m (x + 1)

splitPath :: Int -> [Int] -> [[Int]]
splitPath _ [] = []
splitPath 1 xs = ((div (length xs) 2) : xs) : []
splitPath k xs =
	let sp = splitAt 4 xs
	    ft = fst sp
	    st = snd sp
	in (2 : ft) : splitPath (k - 1) st

import Data.List

main = interact $ unlines . map (unwords . map show) . getAns . map read . words

getAns :: [Int] -> [[Int]]
getAns (n:m:k:_) = splitPath k $ getPath n m 1 1

getPath :: Int -> Int -> Int -> Int -> [Int]
getPath n m x y =
	let ty = if x `mod` 2 == 0 then y - 1 else y + 1
	    nx = if ty > m || ty <= 0 then x + 1 else x
	    ny = if ty <= m && ty > 0 then ty else y
	in if (x > n) then [] else x:y:getPath n m nx ny

splitPath :: Int -> [Int] -> [[Int]]
splitPath _ [] = []
splitPath 1 xs = ((div (length xs) 2) : xs) : []
splitPath k xs =
	let sp = splitAt 4 xs
	    ft = fst sp
	    st = snd sp
	in (2 : ft) : splitPath (k - 1) st

module Main where

pinput:: String -> [Int]
pinput = map read . words

poutput:: [[(Int, Int)]] -> String
poutput o = unlines (map poneoutput o) where
    prest ((x, y):xs)  = x : y : prest xs
    prest [] = []
    poneoutput t = unwords $ map show (length t : prest t)

-- Solution starts here
snake:: Int -> Int -> [(Int, Int)]
snake nrow ncol = loop 1 1 1 where
    loop row col dir
        | row == (nrow + 1) = []
        | col == ncol && dir == 1 = (row, col) : loop (row + 1) col (-1)
        | col == 1 && dir == -1 = (row, col) : loop (row + 1) col 1
        | otherwise = (row, col) : loop row (col + dir) dir

solve:: [Int] -> [[(Int, Int)]]
solve [nrow, ncol, tubes] = slice (snake nrow ncol) (nrow * ncol) where
    step = (nrow * ncol) `div` tubes
    slice [] _ = []
    slice xs m = if m  == step + (nrow * ncol) `mod` tubes
                   then take (length xs) xs : slice [] 0
                   else take step xs : slice (drop step xs) (m - step)
solve _ = undefined

main :: IO ()
main = do
        l <- getLine
        putStrLn $ poutput $ solve $ pinput l

import Data.List

main = interact $ unlines . map (unwords . map show) . getAns . map read . words

getAns :: [Int] -> [[Int]]
getAns (n:m:k:_) = splitPath (n * m `div` k * 2) $ getPath n m 1 1

getPath :: Int -> Int -> Int -> Int -> [Int]
getPath n m x y =
	let ty = if x `mod` 2 == 0 then y - 1 else y + 1
	    nx = if ty > m || ty <= 0 then x + 1 else x
	    ny = if ty <= m && ty > 0 then ty else y
	in if (x > n) then [] else x:y:getPath n m nx ny

splitPath :: Int -> [Int] -> [[Int]]
splitPath _ [] = []
splitPath k xs =
	let sp = splitAt k xs
	    ft = fst sp
	    st = snd sp
	in ((div (length ft) 2) : ft) : (splitPath k st)

import Control.Monad

rth :: Int -> Int -> Int -> (Int,Int)
rth n m r =
  if t >= m then (i0+1+1, 2*m-t) else (i0+1,t+1)
  where (q,t) = divMod (r-1) (2*m)
        i0 = 2*q

showPair (i,j) = show i ++ " " ++ show j

main = do
  (n:m:tubes:_) <- fmap (map read . words) getLine
  forM_ [1..tubes-1] $ \k -> do
    putStrLn $ "1 " ++ showPair (rth n m k)
  let cnt = n*m-tubes+1
  putStr $ show cnt ++ " "
  forM_ [tubes..n*m] $ \r -> do
    putStr $ showPair (rth n m r) ++ " "
  putStrLn ""

module Main where

pinput:: String -> [Int]
pinput = map read . words

poutput:: [[(Int, Int)]] -> String
poutput o = unlines (map poneoutput o) where
    prest ((x, y):xs)  = x : y : prest xs
    prest [] = []
    poneoutput t = unwords $ map show (length t : prest t)

-- Solution starts here
snake:: Int -> Int -> [(Int, Int)]
snake nrow ncol = loop 1 1 1 where
    loop row col dir
        | row == (nrow + 1) = []
        | col == ncol && dir == 1 = (row, col) : loop (row + 1) col (-1)
        | col == 1 && dir == -1 = (row, col) : loop (row + 1) col 1
        | otherwise = (row, col) : loop row (col + dir) dir

solve:: [Int] -> [[(Int, Int)]]
solve [nrow, ncol, tubes] = slice (snake nrow ncol) where
    step = (nrow * ncol) `div` tubes
    slice [] = []
    slice xs = take step xs : slice (drop step xs)
solve _ = undefined

main :: IO ()
main = do
        l <- getLine
        putStrLn $ poutput $ solve $ pinput l


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

solve :: [Integer] -> String
solve (p : q : _ : as)
  | p * r == q * s = "YES"
  | otherwise = "NO"
  where
  (r, s) = foldr f (0, 1) as
  f a (n, d) = (d, a * d + n)

import Data.Ratio ((%))
import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: (Integer, Integer) -> [Integer] -> Bool
solve (a, b) xs  =  a % b == solve' xs
  where
    solve' [x]  =  x % 1
    solve' (x:xs)  =  x % 1 + 1 / solve' xs

main :: IO ()
main  =  do
    [a, b]  <-  reads
    getLine
    xs  <-  reads
    if solve (a, b) xs
        then putStrLn "YES"
        else putStrLn "NO"

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Ord
import Data.Ratio

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

main :: IO ()
main = do
  [p,q] <- map read.words <$> getLine
  _ <- getLine
  xs <- map readInteger.B.words <$> B.getLine
  if (p%q) == calc xs
     then putStrLn "YES"
     else putStrLn "NO"

calc :: [Integer] -> Ratio Integer
calc [x] = x%1
calc (x:xs) = (x%1)+ (1 / (calc xs))

isEqual :: Integer -> Integer -> [Integer] -> Bool
isEqual p q [] = q == 0
isEqual p q (x : xs) = if q /= 0 then div p q >= x && isEqual q (p - q * x) xs else False

handle :: [[String]] -> String
handle [[sp, sq], _, sa] = if isEqual (read sp) (read sq) (map read sa) then "YES" else "NO"

main :: IO ()
main = interact $ handle . map words . lines

isEqual :: Integer -> Integer -> [Integer] -> Bool
isEqual p q [] = q == 0
isEqual _ 0 _ = False
isEqual p q (x : xs) = div p q >= x && isEqual q (p - q * x) xs

handle :: [[String]] -> String
handle [[sp, sq], _, sa] = if isEqual (read sp) (read sq) (map read sa) then "YES" else "NO"

main :: IO ()
main = interact $ handle . map words . lines

isEqual :: Int -> Int -> [Int] -> Bool
isEqual p q [] = q == 0
isEqual p q (x : xs) = div p q >= x && isEqual q (p - q * x) xs

handle :: [[String]] -> String
handle [[sp, sq], _, sa] = if isEqual (read sp) (read sq) (map read sa) then "YES" else "NO"

main :: IO ()
main = interact $ handle . map words . lines


import Data.List

main = do
  [n, p, q] <- (map read . words) `fmap` getLine
  s <- getLine

  let vs = [(a, b) | a <- [0..100], b <- [0..100], a*p + b*q == n]

  if null vs
    then print $ -1
    else do
      let
        (a, b) = head vs
        ss = slice p (take (p*a) s) ++ slice q (drop (p*a) s)
          where
            slice n = unfoldr (\s -> if null s then Nothing else Just (take n s, drop n s))
      print $ length ss
      putStr $ unlines ss

import Control.Applicative
import Data.List.Split

solve :: Int -> Int -> Int -> String -> [String]
solve n p q x
  | null matches = ["-1"]
  | otherwise = show (p_uses + q_uses):chunksOf p p_str ++ chunksOf q q_str
  where
    matches = [(p_uses, q_uses) | p_uses <- [0..n], q_uses <- [0..n], p_uses * p + q_uses * q == n]
    (p_uses, q_uses) = head matches
    (p_str, q_str) = splitAt (p_uses * p) x

main = do
  [n, p, q] <- map read . words <$> getLine
  x <- getLine
  let soln = solve n p q x
  putStrLn $ unlines $ soln

import Control.Applicative
import Data.List.Split

main = do
  [n, p, q] <- map read . words <$> getLine
  s <- getLine
  putStr $ unlines $ solve n p q s

solve n p q s = if null ls then ["-1"]
                else show (m `div` p + (n - m) `div` q) : chunksOf p (take m s) ++  chunksOf q (drop m s)
                    where ls = [m | m <-[0..n], m `mod` p == 0, (n - m) `mod` q == 0 ]
                          m = if null ls then -1 else head ls

import Data.List

read_int :: String -> Int
read_int = read

solve :: Int -> Int -> String -> Maybe [String]
solve p q str
  | len `mod`g /= 0    = Nothing
  | len == p           = Just [str]
  | len == q           = Just [str]
  | len < p && len < q = Nothing
  | otherwise          = case (solve p q psuff, solve p q qsuff) of
                           (Just ss, _) -> Just (ppref:ss)
                           (_, Just ss) -> Just (qpref:ss)
                           _ -> Nothing
  where len            = length str
        (ppref, psuff) = splitAt p str
        (qpref, qsuff) = splitAt q str
        g              = gcd p q

formatout :: Maybe [String] -> String
formatout Nothing   = "-1"
formatout (Just ss) = intercalate "\n" ((show $ length ss):ss)

formatin :: [String] -> Maybe [String]
formatin (_:x:y:z:_) = solve (read_int x) (read_int y) z

main = do
  input <- getContents
  putStrLn $ formatout . formatin . words $ input

splitS s n p q
    | n == 0 = ([], True)
    | n < p = ([], False)
    | n `mod` p == 0 = ((take p s) : spLeft, passedP)
    | n < q = ([], False)
    | otherwise = ((take q s) : sqLeft, passedQ)
    where
        (spLeft, passedP) = splitS (drop p s) (n-p) p q
        (sqLeft, passedQ) = splitS (drop q s) (n-q) p q

main = do
    line <- getLine
    let [n, p, q] = map read $ words line
    let (pP, qQ) = (min p q, max p q)
    s <- getLine
    let (result, possible) = splitS s n pP qQ
    if possible then do
        putStrLn $ show $ length result
        putStr $ unlines result
    else do
        putStrLn "-1"

{-- 612.A. The Text Splitting --}
main = do
    firstLine <- getLine
    word <- getLine
    case splitter (words firstLine) word of
        Just set -> do
            putStrLn (show $ length set)
            mapM_ putStrLn set
        Nothing ->
            putStrLn "-1"

splitter :: [String] -> String -> Maybe [String]
splitter [] _ = Nothing
splitter _ [] = Nothing
splitter xs str = case partition str len p q of
                    (_, -1) -> Nothing
                    (set, _) -> Just set
    where
        len = read (xs !! 0) :: Int
        p = read (xs !! 1) :: Int
        q = read (xs !! 2) :: Int

partition :: (Num a) => String -> Int -> Int -> Int -> ([String], a)
partition str len p q
    | len < 0   = ([], -1)
    | len == 0  = ([], 0)
    | otherwise = ((take val str) : next, num)
    where
        (next, num) = if modPass
                        then partition (drop val str) (len - val) val val
                        else partition (drop val str) (len - val) p q
        modPass = len `mod` p == 0 || len `mod` q == 0
        val
            | len `mod` p == 0 = p
            | len `mod` q == 0 = q
            | p < q = p
            | otherwise = q

main = interact $
        sol .
        (\[n, p, q, s] -> (read n, read p, read q, s)) .
        words

sol (n, p, q, s) = case posb of
                    [] -> "-1"
                    (pl:_) -> let ans = slice s $ replicate (pl `div` p) p ++ replicate ((n-pl) `div` q) q
                              in unlines $ (show $ length ans):ans
    where
    posb = filter (\pl -> (n-pl) `mod` q == 0) . takeWhile (<= n) $ map (*p) [0..]
    slice _ [] = []
    slice str (x:xs) = (take x str):(slice (drop x str) xs)

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

main = do
    (n : p : q : _) <- map read . words <$> getLine
    s <- getLine
    putStrLn $ case listToMaybe [i | i <- [0, p .. n], (n - i) `mod` q == 0] of
        Nothing -> "-1"
        Just i  -> let (s1, s2) = splitAt i s in decorate $ (splitEvery p s1) ++ (splitEvery q s2)
    where
        decorate l      = unlines $ (show $ length l) : l
        splitEvery x    = takeWhile (not . null) . unfoldr (Just . splitAt x)

import Data.List

main = do
  [n, p, q] <- (map read . words) `fmap` getLine
  s <- getLine

  let vs = [(a, b) | a <- [0..100], b <- [0..100], a*p + b*q == n]

  if null vs
    then print $ -1
    else do
      print 2
      let
        (a, b) = head vs
        ss = slice p (take (p*a) s) ++ slice q (drop (p*a) s)
          where
            slice n = unfoldr (\s -> if null s then Nothing else Just (take n s, drop n s))
      putStr $ unlines ss


{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Applicative hiding(empty)

import Data.List hiding(insert)
import Data.Bits
import Data.Maybe
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
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]

main = do
    (n,_) <- readIntPair
    qs <- map (map readInt . B.words) . B.lines <$> B.getContents
    case solve n qs of
        Just as -> do
            putStrLn $ "YES"
            putStrLn $ unwords $ map show as
        Nothing -> putStrLn $ "NO"

data SegTree a = Leaf !Int !a | Node !Int !Int !a !(SegTree a) !(SegTree a) deriving(Show)

get :: SegTree a -> a
get (Leaf _ q) = q
get (Node _ _ q _ _) = q

mkTree :: Int -> SegTree Int
mkTree n = go 0 n where
    go l r | r - l == 1 = Leaf l 0
           | otherwise = Node l r 0 t1 t2 where
                m = (l + r) `div` 2
                t1 = go l m
                t2 = go m r

update :: Int -> Int -> Int -> SegTree Int -> SegTree Int
update !ql !qr !v = go where
    go t@(Leaf i q)
        | ql <= i && i < qr = Leaf i (q .|. v)
        | otherwise = t
    go t@(Node l r q t1 t2)
        | ql <= l && r <= qr = Node l r (q .|. v) t1 t2
        | r <= ql || qr <= l = t
        | otherwise = Node l r q (go t1) (go t2)

convert :: SegTree Int -> SegTree Int
convert = go 0 where
    go !q (Leaf i q') = Leaf i (q .|. q')
    go !q (Node l r q' t1 t2) =
        let t1' = go (q .|. q') t1
            t2' = go (q .|. q') t2
        in Node l r (get t1' .&. get t2') t1' t2'

rmq :: Int -> Int -> SegTree Int -> Int
rmq ql qr = go where
    go (Leaf i q) | ql <= i && i < qr = q
                  | otherwise = -1
    go (Node l r q t1 t2) | ql <= l && r <= qr = q
                          | r <= ql || qr <= l = -1
                          | otherwise = go t1 .&. go t2

toList :: SegTree Int -> [Int]
toList = go [] where
    go acc (Leaf _ q) = q:acc
    go acc (Node _ _ _ t1 t2) = go (go acc t2) t1

solve :: Int -> [[Int]] -> Maybe [Int]
solve n qs = pure as <* guard check where
    t1 = mkTree n
    t2 = foldl' (\acc [li,ri,qi] -> update (li-1) ri qi acc) t1 qs
    t3 = convert t2
    as = toList t3
    check = all (\[li,ri,qi] -> rmq (li-1) ri t3 == qi) qs

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Applicative hiding(empty)

import Data.List hiding(insert)
import Data.Bits
import Data.Maybe
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
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]

main = do
    (n,_) <- readIntPair
    qs <- map (map readInt . B.words) . B.lines <$> B.getContents
    case solve n qs of
        Just as -> do
            putStrLn $ "YES"
            putStrLn $ unwords $ map show as
        Nothing -> putStrLn $ "NO"

data SegTree = Leaf !Int !Int | Node !Int !Int !Int !SegTree !SegTree deriving(Show)

get :: SegTree -> Int
get (Leaf _ q) = q
get (Node _ _ q _ _) = q

mkTree :: Int -> SegTree
mkTree n = go 0 n where
    go l r | r - l == 1 = Leaf l 0
           | otherwise = Node l r 0 t1 t2 where
                m = (l + r) `div` 2
                t1 = go l m
                t2 = go m r

update :: Int -> Int -> Int -> SegTree -> SegTree
update !ql !qr !v = go where
    go t@(Leaf i q)
        | ql <= i && i < qr = Leaf i (q .|. v)
        | otherwise = t
    go t@(Node l r q t1 t2)
        | ql <= l && r <= qr = Node l r (q .|. v) t1 t2
        | r <= ql || qr <= l = t
        | otherwise = Node l r q (go t1) (go t2)

convert :: SegTree -> SegTree
convert = go 0 where
    go !q (Leaf i q') = Leaf i (q .|. q')
    go !q (Node l r q' t1 t2) =
        let t1' = go (q .|. q') t1
            t2' = go (q .|. q') t2
        in Node l r (get t1' .&. get t2') t1' t2'

rmq :: Int -> Int -> SegTree -> Int
rmq ql qr = go where
    go (Leaf i q) | ql <= i && i < qr = q
                  | otherwise = -1
    go (Node l r q t1 t2) | ql <= l && r <= qr = q
                          | r <= ql || qr <= l = -1
                          | otherwise = go t1 .&. go t2

toList :: SegTree -> [Int]
toList = go [] where
    go acc (Leaf _ q) = q:acc
    go acc (Node _ _ _ t1 t2) = go (go acc t2) t1

solve :: Int -> [[Int]] -> Maybe [Int]
solve n qs = pure as <* guard check where
    t1 = mkTree n
    t2 = foldl' (\acc [li,ri,qi] -> update (li-1) ri qi acc) t1 qs
    t3 = convert t2
    as = toList t3
    check = all (\[li,ri,qi] -> rmq (li-1) ri t3 == qi) qs

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Applicative hiding(empty)

import Data.List hiding(insert)
import Data.Bits
import Data.Maybe
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
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]

main = do
    (n,_) <- readIntPair
    qs <- map (map readInt . B.words) . B.lines <$> B.getContents
    case solve n qs of
        Just as -> do
            putStrLn $ "YES"
            putStrLn $ unwords $ map show as
        Nothing -> putStrLn $ "NO"

data SegTree = Leaf !Int !Int | Node !Int !Int !Int !SegTree !SegTree deriving(Show)

get :: SegTree -> Int
get (Leaf _ q) = q
get (Node _ _ q _ _) = q

mkTree :: [Int] -> SegTree
mkTree as = go 0 n as where
    n = length as
    go l r as | r - l == 1 = Leaf l $ head as
              | otherwise =
                let m = (l+r) `div` 2
                    (asl,asr) = splitAt (m-l) as
                    t1 = go l m asl
                    t2 = go m r asr in
                Node l r (get t1 .&. get t2) t1 t2

update :: Int -> Int -> Int -> SegTree -> SegTree
update ql qr v t@(Leaf i q) =
    if ql <= i && i < qr then Leaf i (q .|. v) else t
update ql qr v t@(Node l r q t1 t2)
    | ql <= l && r <= qr = Node l r (q .|. v) t1 t2
    | r <= ql || qr <= l = t
    | otherwise = Node l r q (update ql qr v t1) (update ql qr v t2)

toList :: SegTree -> [Int]
toList tree = go 0 tree [] where
    go q (Leaf _ q') acc = (q .|. q'):acc
    go q (Node _ _ q' t1 t2) acc = go (q .|. q') t1 (go (q .|. q') t2 acc)

rmq :: Int -> Int -> SegTree -> Int
rmq ql qr (Leaf i q) = if ql <= i && i < qr then q else -1
rmq ql qr (Node l r q t1 t2) | ql <= l && r <= qr = q
                             | r <= ql || qr <= l = -1
                             | otherwise = rmq ql qr t1 .&. rmq ql qr t2

solve :: Int -> [[Int]] -> Maybe [Int]
solve n qs = pure as <* guard check where
    t1 = mkTree $ take n $ repeat 0
    t2 = foldl' (\acc [li,ri,qi] -> update (li-1) ri qi acc) t1 qs
    as = toList t2
    t3 = mkTree $ toList t2
    check = all (\[li,ri,qi] -> rmq (li-1) ri t3 == qi) qs

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative hiding(empty)
import Control.Arrow
import Debug.Trace
import Text.Printf
import Data.Monoid((<>))

import Data.List hiding(insert)
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 ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,_) <- readIntPair
    qs <- map (map readInt . B.words) . B.lines <$> B.getContents
    case solve n qs of
        Just as -> do
            putStrLn $ "YES"
            putStrLn $ unwords $ map show as
        Nothing -> putStrLn $ "NO"

data SegTree = Leaf Int Int | Node Int Int Int SegTree SegTree deriving(Show)

get :: SegTree -> Int
get (Leaf _ q) = q
get (Node _ _ q _ _) = q

mkTree :: [Int] -> SegTree
mkTree as = go 0 n as where
    n = length as
    go l r as | r - l == 1 = Leaf l $ head as
              | otherwise =
                let m = (l+r) `div` 2
                    (asl,asr) = splitAt (m-l) as
                    t1 = go l m asl
                    t2 = go m r asr in
                Node l r (get t1 .&. get t2) t1 t2

update :: Int -> Int -> Int -> SegTree -> SegTree
update ql qr v t@(Leaf i q) =
    if ql <= i && i < qr then Leaf i (q .|. v) else t
update ql qr v t@(Node l r q t1 t2)
    | ql <= l && r <= qr = Node l r (q .|. v) t1 t2
    | r <= ql || qr <= l = t
    | otherwise = Node l r q (update ql qr v t1) (update ql qr v t2)

toList :: SegTree -> [Int]
toList tree = go 0 tree [] where
    go q (Leaf _ q') acc = (q .|. q'):acc
    go q (Node _ _ q' t1 t2) acc = go (q .|. q') t1 (go (q .|. q') t2 acc)

rmq :: Int -> Int -> SegTree -> Int
rmq ql qr (Leaf i q) = if ql <= i && i < qr then q else -1
rmq ql qr (Node l r q t1 t2) | ql <= l && r <= qr = q
                             | r <= ql || qr <= l = -1
                             | otherwise = rmq ql qr t1 .&. rmq ql qr t2

solve :: Int -> [[Int]] -> Maybe [Int]
solve n qs = pure as <* guard check where
    t1 = mkTree [0..n-1]
    t2 = foldl' (\acc [li,ri,qi] -> update (li-1) ri qi acc) t1 qs
    as = toList t2
    t3 = mkTree $ toList t2
    check = all (\[li,ri,qi] -> rmq (li-1) ri t3 == qi) qs

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

import Data.List hiding(insert)
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 ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

data Tree a = Null | Fork a (Tree a) (Tree a) deriving(Show)

empty :: Tree a
empty = Null

isEmpty :: Tree a -> Bool
isEmpty Null = True
isEmpty _ = False

minElem :: Tree a -> a
minElem (Fork a _ _) = a
minElem Null = error "min for empty queue is not supported"

deleteMin :: (Ord a) => Tree a -> Tree a
deleteMin (Fork _ a b) = merge a b

insert :: (Ord a) => a -> Tree a -> Tree a
insert x a = merge (Fork x Null Null) a

merge :: (Ord a) => Tree a -> Tree a -> Tree a
merge a Null = a
merge Null b = b
merge a b | minElem a <= minElem b = join a b
          | otherwise = join b a
    where
    join (Fork x a b) c = Fork x b (merge a c)

main = do
    (n,_) <- readIntPair
    qs <- map (map readInt . B.words) . B.lines <$> B.getContents
    case solve n qs of
        Just as -> do
            putStrLn $ "YES"
            putStrLn $ unwords $ map show as
        Nothing -> putStrLn $ "NO"

data SegTree = Leaf Int Int | Node Int Int Int SegTree SegTree deriving(Show)

get :: SegTree -> Int
get (Leaf _ q) = q
get (Node _ _ q _ _) = q

mkTree :: [Int] -> SegTree
mkTree as = go 0 n as where
    n = length as
    go l r as | r - l == 1 = Leaf l $ head as
              | otherwise =
                let m = (l+r) `div` 2
                    (asl,asr) = splitAt (m-l) as
                    t1 = go l m asl
                    t2 = go m r asr in
                Node l r (get t1 .&. get t2) t1 t2

rmq :: Int -> Int -> SegTree -> Int
rmq ql qr (Leaf i q) = if ql <= i && i < qr then q else -1
rmq ql qr (Node l r q t1 t2) | ql <= l && r <= qr = q
                             | otherwise = rmq ql qr t1 .&. rmq ql qr t2

solve :: Int -> [[Int]] -> Maybe [Int]
solve n qs = pure as <* guard (check as) where
    qs' = sort $ map (\[li,ri,qi] -> ((li,ri),qi)) qs
    as = go 1 empty qs'
    tree = mkTree as
    check as = all (\((li,ri),qi) -> rmq (li-1) ri tree == qi) qs'
    go i queue rem | i > n = []
                   | otherwise =
        let (a,b) = span ((<=i).fst.fst) rem
            queue' = foldl (\acc ((l,r),q) -> insert (r,q) acc) queue a
            pop qs | isEmpty qs = qs
                   | fst (minElem qs) < i = pop (deleteMin qs)
                   | otherwise = qs
            queue'' = pop queue'
        in
        if isEmpty queue''
            then 0:go (i+1) queue'' b
            else snd (minElem queue''):go (i+1) queue'' b


f::Int->[Int]->Int
f n _
  |n<=0=0
f n (x:xs)=1 + (f (n-(86400-x)) xs)

main = do
       e<-getLine
       es<-getLine
       let (a:b:[])=map read (words e)::[Int]
           xs=map read (words es)::[Int]
       print $ f b xs

module Main where

import Control.Applicative
import Control.Monad

day :: Int
day = 86400

getMinTime :: [Int] -> Int -> Int
getMinTime as t = fst . head . dropWhile ((< t) . snd) $ zip [0 :: Int ..] fs
    where fs = scanl (+) 0 $ map (day - ) as

main :: IO ()
main = do
  [_, t] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ getMinTime as t

import Data.List
import Data.Maybe

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

main = do
    [n,t] <- getInts
    as <- getInts
    print $ 1 + (fromJust $ findIndex (\a -> a >= t) (scanl1 (+) (map (\a -> 86400 - a) as)))

main = getContents >>= print . exec
exec = solve . map read . words
solve (n:t:xs) = length $ takeWhile (> 0) $ scanl (\t x -> t - (86400 - x) :: Int) t xs

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

solve :: Int -> [Int] -> Int
solve d (_:0:_) = d
solve d (n:t:a:ax) = solve (d + 1) (n:(maximum [0, t - (86400 - a)]):ax)

import Data.List

main = do
   [n,s] <- getLine >>=  return . map (read :: String -> Int) . words
   as <- getLine >>=  return . map (read :: String -> Int) . words
   let  d = fst $ foldl' (\acc@(d,t) x -> if t > 0 then (d+1,t-86400+x) else acc) (0,s) as
   print d

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

main = do
		[n,t]<-map read <$> words <$> getLine::IO [Int]
		k<-scanl1 (+) <$> map (86400-) <$> map read <$> words <$> getLine::IO [Int]
 		print $ (+1) $ length $ takeWhile (<t) k

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
--import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

f :: Int -> [Int] -> Int
f t (x:xs) = if t <= x then 1 else 1 + f (t-x) xs

main :: IO ()
main = do
    n:k:_ <- readInts
    a <- readInts
    print $ f k . map ((-) 86400) $ a


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

import Data.Map((!))

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

result list = aux (length sort) sort sumOcc where
	sort = fmap fst $ L.sortOn snd $ M.toList occ
	occ = numOcc list

	sumOcc = foldr (+) 0 occ

	aux l [] s = 0
	aux l (x:xs) s = min (s - y*l) (y + aux (l-1) xs (s-y)) where y = occ ! x

showR (x:xs) = show (x+1) ++ " " ++ showR xs
showR [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		print $ result a
		loop $ t - 1
	loop t

-- https://codeforces.com/problemset/problem/1490/F
module Main where

import Data.List (nub)
import Data.Map as M (Map, alter, empty, toList)

main :: IO ()
main = getLine >>= \x -> wrapper (read x :: Int)

wrapper :: Int -> IO ()
wrapper x
  | x == 0 = return ()
  | otherwise = driver >> wrapper (x - 1)

driver :: IO ()
driver = getLine >> getLine >>= \x -> let arr = toArr x in print $ solve arr

toArr :: String -> [Int]
toArr = map (\x -> read x :: Int) . words

-- the value is the minimum of
solve :: [Int] -> Int
solve arr =
  let counts = toList $ getCounts arr
      mapF :: [(Int, Int)] -> Int -> Int
      mapF counts count =
        sum
          ( map
              ( \x ->
                  let count' = snd x
                   in if count' > count
                        then count' - count
                        else if count' == count then 0 else count'
              )
              counts
          )
   in minimum $ map (mapF counts) (nub $ map snd counts)

getCounts :: [Int] -> M.Map Int Int
getCounts = go M.empty
  where
    go m [] = m
    go m (x : xs) = go (M.alter f x m) xs

    f Nothing = Just 1
    f (Just x) = Just (x + 1)

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

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

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

type MonadHopper r m = MonadState [r] m

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

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

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

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

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

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

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

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow (solve n as)

solve n as = minimum $ go 0 0 0 (reverse counts) (tail $ reverse ss)
  where
    counts = countList $ map snd $ countList as

    ss = snd $ mapAccumL (\s (a, b) -> (s + a * b, s + a * b)) 0 counts

    go acc a0 b0 ((a, b) : _) [] = [acc + (a0 - a) * b0]
    go acc a0 b0 ((a, b) : cs) (s : ss) =
      let acc' = acc + (a0 - a) * b0
          a1 = a
          b1 = b0 + b in
        (acc' + s) : go acc' a1 b1 cs ss

countList :: (Ord a) => [a] -> [(a, Int)]
countList xs = Map.assocs $ foldl' addm Map.empty xs
  where
    addm m x | Map.member x m = Map.adjust (+ 1) x m
             | otherwise = Map.insert x 1 m

{-# LANGUAGE BangPatterns #-}
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 qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    a <- readInts
    let
      mkFreqMap li = M.fromListWith (+) $ zip li $ repeat 1
      freqs = M.elems $ mkFreqMap a
      --freqMap = [(head v, length v) | v <- group $ sort freqs]
      freqMap = M.assocs $ mkFreqMap freqs
      step (!prevCost, !remPop, !prevVal, !prevCt) (currVal, currCt) = let
        currCost = prevCost
          + prevCt * prevVal             -- send prevVals to 0...
          - remPop * (currVal - prevVal) -- ...but move the rest less
        newRemPop = remPop - currCt
        in  (currCost, newRemPop, currVal, currCt)
      options = scanl step (n, length freqs, 0, 0) freqMap
    putInts $ pure $ foldl' (\v (cost, _, _, _) -> min v cost) maxBound options

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 #-}
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 qualified Data.Map.Strict as M

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    a <- readInts
    let
      freqs = M.elems $ M.fromListWith (+) $ zip a $ repeat 1
      freqMap = [(head v, length v) | v <- group $ sort freqs]
      step (!prevCost, !remPop, !prevVal, !prevCt) (currVal, currCt) = let
        currCost = prevCost
          + prevCt * prevVal             -- send prevVals to 0...
          - remPop * (currVal - prevVal) -- ...but move the rest less
        newRemPop = remPop - currCt
        in  (currCost, newRemPop, currVal, currCt)
      options = scanl step (n, length freqs, 0, 0) freqMap
    putInts $ pure $ foldl' (\v (cost, _, _, _) -> min v cost) maxBound options

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 Control.Monad
import Data.List

solve :: IO ()
solve = do
    getLine
    as <- map read . words <$> getLine :: IO [Int]
    let cnts = reverse $ sort $ map length $ group $ sort as
        ans = minimum $ zipWith4 f [1..] cnts (scanl1 (+) cnts) (tail $ scanr (+) 0 cnts) where
            f i x sl sr = sl - i * x + sr
    print ans

main :: IO ()
main = readLn >>= flip replicateM_ solve

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

import Control.Applicative
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Bits
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

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

type MonadHopper r m = MonadState [r] m

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

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

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

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

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

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

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

run1 = do
  n <- popInt
  as <- popInts
  return $ bshow (solve n as)

solve n as = minimum $ go 0 0 0 (reverse counts) (tail $ reverse ss)
  where
    counts = countList $ map snd $ countList as

    ss = snd $ mapAccumL (\s (a, b) -> (s + a * b, a * b)) 0 counts

    go acc a0 b0 ((a, b) : _) [] = [acc + (a0 - a) * b0]
    go acc a0 b0 ((a, b) : cs) (s : ss) =
      let acc' = acc + (a0 - a) * b0
          a1 = a
          b1 = b0 + b in
        (acc' + s) : go acc' a1 b1 cs ss

countList :: (Ord a) => [a] -> [(a, Int)]
countList xs = Map.assocs $ foldl' addm Map.empty xs
  where
    addm m x | Map.member x m = Map.adjust (+ 1) x m
             | otherwise = Map.insert x 1 m


import Control.Monad

solve :: Int -> [Int] -> Int
solve x as = if  all (== x) as
  then  0
  else  if  elem x as
  then  1
  else  if  sum as == x * length as -- no overflow, inputs are small
  then  1
  else  2  -- infect one account round 1, the rest round 2
           -- always possible since n >= 2

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, x] <- map read . words <$> getLine
    as      <- map read . words <$> getLine
    print $ solve x as

import Data.List
import Data.Int
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int64
readInt = do
    line <- getLine
    return $ (read::String->Int64) $ line

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

f :: Int64 -> Int64 -> Int64
f curPower xLeft =
  let s = (curPower) * (curPower - 1) `div` 2 in
  if s > xLeft then 0 else 1 + f (curPower * 2) (xLeft - s)

solve :: IO ()
solve = do
    (n:x:_) <- readArray
    a <- readArray
    let s = sum a
    let cnt = (fromIntegral::Int->Int64) $ count x a
    if cnt == n then print 0 else if cnt > 0 then print 1 else if n * x == s then print 1 else print 2

main :: IO ()
main = do
    t <- readInt
    forM_ [0..t-1] $ (\i -> solve)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ if all (== k) as then 0 else if sum as == n * k || k `elem` as then 1 else 2

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

routine :: IO ()
routine = do
  [n,x ] <- (map read.words) <$> getLine
  as <- (map read.words) <$> getLine
  print $ solve n x as

solve :: Integer -> Integer -> [Integer] -> Integer
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | any (==x) as = 1
  | otherwise = 2

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ if all (== k) as then 0 else if sum as == n * k then 1 else 2

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

routine :: IO ()
routine = do
  [n,x ] <- (map read.words) <$> getLine
  as <- (map read.words) <$> getLine
  print $ solve n x as

solve :: Integer -> Integer -> [Integer] -> Integer
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | otherwise = 2

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

routine :: IO ()
routine = do
  [n,x ] <- (map read.words) <$> getLine
  as <- (map read.words) <$> getLine
  print $ solve n x as

solve :: Int -> Int -> [Int] -> Int
solve n x as
  | all (==x) as = 0
  | sum as == n*x = 1
  | otherwise = 2