{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Data.Array((!),listArray,Array,assocs)
import qualified Data.IntMap as M
import Control.Monad.State
import Data.Maybe
import Data.IORef

main :: IO ()
main = do
    n0 <- getLine
    let n :: Int = read n0
    nums0 <- getLine
    let nums :: [Int] = map read . words $ nums0
    -- result <- solveArr n nums
    putStrLn . show $ solve n nums

-- solve :: Int -> [Int] -> Int
-- solve n nums = dp ! n where
--     dp :: Array Int Int
--     dp = listArray (1,n) (map f [n,n-1..1])
--     f :: Int -> Int
--     f x
--         | x == n = 0
--         | otherwise = maximum $ map (\j -> sum (take j nums) - f j) [x..n]
--     get :: Int -> Int
--     get x = dp ! x

-- solveR :: Int -> Int -> [Int] -> Int
-- solveR x n nums
--     | x == n = 0
--     | otherwise = maximum $ map (\j -> sum (take j nums) - solveR j n nums) [x+1..n]

-- solveM :: Int -> [Int] -> Int
-- solveM n nums = evalState (f n) $ M.fromList [(n,0)] where
--     f :: Int -> State (M.IntMap Int) Int
--     f x = do
--         dp :: M.IntMap Int <- get
--         put $ foldl (\acc (Just (i,j)) -> M.insert i j acc) dp $ filter isJust $ map (attempt dp) [x+1..n]
--         -- dp <- get
--         return $ maximum $ map (\j -> sum (take j nums) - fromJust (dp M.!? j)) [x+1..n]
--         where
--             attempt :: M.IntMap Int -> Int -> Maybe (Int, Int)
--             attempt dp x = case M.lookup x dp of
--                     Just i -> Nothing
--                     Nothing -> Just (x, evalState (f x) dp)

-- solveM :: Int -> [Int] -> IO (Int)
-- solveM n nums = do
--     dpRef <- newIORef $ M.fromList [(n,0)]
--     f dpRef 1
--     where
--     f :: IORef (M.IntMap Int) -> Int -> IO (Int)
--     f dpRef x = foldl (\acc j -> do {a <- acc; b <- j; return $ if a > b then a else b}) a asd where
--         asd :: [IO Int]
--         (a:asd) = map (\j -> do {i <- attempt dpRef j; return $ sum (take j nums) - i } ) [x+1..n]
--     attempt :: IORef (M.IntMap Int) -> Int -> IO (Int)
--     attempt dpRef x = do
--         dp <- readIORef dpRef
--         case M.lookup x dp of
--             Just i -> return i
--             Nothing -> do
--                 i <- f dpRef x
--                 modifyIORef dpRef (\m -> M.insert x i m)
--                 return i

-- solveArr :: Int -> [Int] -> IO (Int)
-- solveArr n nums = do
--     dpRef :: IORef (Array Int (Maybe Int)) <- newIORef $ listArray (1,n) $ (replicate (n-1) Nothing) ++ [Just 0]
--     f dpRef 1
--     where
--     sums :: Array Int Int
--     sums = listArray (1,n) $ scanl (+) (head nums) (tail nums)
--     f :: IORef (Array Int (Maybe Int)) -> Int -> IO (Int)
--     f dpRef x = foldl (\acc j -> do {a <- acc; b <- j; return $ if a > b then a else b}) a asd where
--         asd :: [IO Int]
--         -- (a:asd) = map (\j -> do {i <- attempt dpRef j; return $ sum (take j nums) - i } ) [x+1..n]
--         (a:asd) = map (\j -> do {i <- attempt dpRef j; return $ sums!j - i } ) [x+1..n]
--     attempt :: IORef (Array Int (Maybe Int)) -> Int -> IO (Int)
--     attempt dpRef x = do
--         dp <- readIORef dpRef
--         case dp!x of
--             Just i -> return i
--             Nothing -> do
--                 i <- f dpRef x
--                 modifyIORef dpRef (\arr -> listArray (1,n) $ map (\(a,b) -> if a == x then Just i else b) $ assocs arr)
--                 return i

solve :: Int -> [Int] -> Int
solve n nums = foldl (\max x -> if max > x - max then max else x - max) s $ take (n-2) sums where
    (s:sums) = reverse . scanl (+) 0 $ nums

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Int] = map read . words $ line
    putStrLn . show $ solve nums

solve :: [Int] -> Int
solve (n:nums) = foldl (\acc x -> max acc (x - acc)) s sums where
    (s:sums) = reverse . tail . scanl (+) n $ nums

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

main :: IO ()
main = do
    n0 <- getLine
    let n :: Int = read n0
    nums0 <- getLine
    let nums :: [Int] = map read . words $ nums0
    putStrLn . show $ solve n nums

solve :: Int -> [Int] -> Int
solve n nums = foldl (\acc x -> max acc (x - acc)) s sums where
    (s:sums) = reverse . tail .scanl (+) 0 $ nums


import Control.Applicative
import Data.List
import Data.Ord
getList = fmap ((map read).words) getLine

f _ [] = 0
f k p = fst (minimumBy (comparing snd) (zipWith (\x y -> (fst y, snd x - snd y)) (drop k list) list)) + 1
  where list = scanl (\x y -> (fst y, snd x + snd y)) (0,0) p

main = do
  [_,k] <- getList
  p <- zip [1..] <$> getList
  putStrLn $ show $ f k p

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))

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

solve :: Int -> [Int] -> Int
solve k xs = snd . minimum $ flip zip [1..] sumsOfEachKElements
  where
     sumsOfEachKElements = uncurry (zipWith (-)) pairWithAndWithoutK
     pairWithAndWithoutK = (drop k &&& id) progressivSums
     progressivSums = scanl (+) 0 xs

import Data.Array
import Data.List
import Data.Maybe (fromJust)

{-solve k xs = go 0 start zs
  where go _ _ [(_,_)] = 1
        go ind val ys@((j, y):yss)
          | k == l = 1
          | j >= (l - k + 2) = ind
          | newval < val = go j newval yss
          | otherwise = go ind val yss
          where newval = sum . map snd . take k $ ys
        l = length xs
        zs = zip [1..] xs
        start = sum xs
-}
solve k xs = fmap (+1) (elemIndex m ds')
  where ys = listArray (0, l-1) xs
        l = length xs
        ds = listArray (1, l-k+1) [go i | i <- [1..(l-k+1)]]
        go 1 = sum . take k $ xs
        go n = ds ! (n-1) - ys ! (n-2) + ys ! (n-2+k)
        m = minimum ds'
        ds' = [ds ! n | n <- [1..(l-k+1)]]

main = do
    k <- fmap (last . map read . words) getLine :: IO Int
    ls <- fmap (map read . words) getLine :: IO [Int]
    print $ fromJust $ solve k ls

import Numeric
import Data.Array

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.snd.f. map fastRead .words

f (n:k:ns) = dp (listArray (1, n) ns) (zip [1..] [(k+1)..n]) ((sum (take k ns)), 1)

dp ns [] prev = prev
dp ns (a:as) prev = min prev (dp ns as (w, (i+1)))
  where w = (fst prev) + (ns ! j) - (ns ! i)
        i = fst a
        j = snd a

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
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 . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

solve :: Int -> Int -> [Int] -> Int
solve n k l = snd $ minimumBy cmpFst $ zip sums [1..]
    where
    sums = go (sum $ take k l) l (drop k l)
    go s _ []          = [s]
    go s (a:as) (b:bs) = s:go (s-a+b) as bs

main = do
    (n,k) <- readIntPair
    l <- readInts
    print $ solve n k l

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x1:x2:xs) = show $ (\ (a,b,c) -> b) $ foldl f (sum $ take x2 xs,1,sum $ take x2 xs) $  zip (zip  xs (drop (x2) xs)) [2..]
  where
  f (b1,b2,m) ((a1,a2),a3) = if b1+a2-a1<m then (b1+a2-a1, a3, b1+a2-a1) else (b1+a2-a1,b2, m)
  f2 (b1,b2) ((a1,a2),a3) = (b1+a2-a1, a3)

module Main where
import qualified Data.ByteString.Char8 as C
import Data.List
-- import Debug.Trace

solve hs k  =
    (\(_,_,j) -> j) $ foldl' (\(s, m, j) (x,y,i) ->
            let s' = s - x + y in -- trace (concatMap (( " "++).show) [s,s',x,y,m,j]) $
            if m > s'
                then (s', s', i)
                else (s', m, j)
          ) (f, f, 1)
           $ zip3 hs (drop k hs) [2..]
    where
        f = sum $ take k hs

main = do
    [n,k] <- map ( (read :: String -> Int) . C.unpack) .  C.words <$> C.getLine
    hs <- map ( (read :: String -> Int) . C.unpack) .  C.words <$> C.getLine
    print $ solve hs k

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate, minimumBy)

solve :: Int -> [Int] -> Int
solve k as  =  fst $ minimumBy snd $ zip [1..] a
  where
    d  =  scanl (+) 0 as
    a  =  zipWith (-) (drop k d) d
    snd (_, a) (_, b)  =  compare a b

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

  where
    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

module Main where
import Control.Applicative
import Data.List (minimumBy)
main :: IO ()
main = do
  [_,k] <- map read . words <$> getLine :: IO [Int]
  hs <- map read . words <$> getLine :: IO [Int]
  let preSums = scanl1 (+) $  hs
      diffs = zip [1..] $ map (uncurry (-)) $ zip (drop (k-1) preSums) $ 0:preSums
      ans = fst $ minimumBy (\a b -> compare (snd a) (snd b)) diffs
  -- print preSums
  -- print $ zip (drop k preSums) preSums
  -- print diffs
  print ans
  return ()

import Data.Array
import Debug.Trace

solve :: [[Int]] -> Int
solve [[n, k], h] =
  1 - k + (snd $ minimum $ drop (k - 1) $ zip (elems heightSums) [1..])
  where
    track q = trace (show q) q
    h' = listArray (1, n) h
    heightSums = listArray (1, n) [d i | i <- [1..n]]
    d 1 = head h
    d i | i <= k = h' ! i + heightSums ! (i - 1)
    d i | otherwise = h' ! i + heightSums ! (i - 1) - h' ! (i - k)

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

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))

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

solve :: Int -> [Int] -> Int
solve k = snd . minimum . flip zip [1..] . uncurry (zipWith (-)) . (drop k &&& id) . scanl (+) 0

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

process k s = zipWith (\a b -> b-a )  (0:s1)  (drop (k-1) s1)
   where s1 = scanl1 (+) s

--process 1 s _ = s
--process k s t = process (k-1) (zipWith (+) s (tail t)) (tail t)

main=do
  [n,k]<-map read <$> words <$> getLine::IO [Int]
  s1<-  C.words <$> C.getLine
  let s = map ( fst.fromJust.C.readInteger ) s1
  let ss = process k s
  print $ (+1) $ fromJust $ elemIndex (minimum ss) ss

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))
import Data.List (minimumBy)
import Data.Ord (comparing)

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

solve :: Int -> [Int] -> Int
solve k = fst . minimumBy (comparing snd) . zip [1..] . uncurry (zipWith (-)) . (drop k &&& id) . scanl (+) 0

main = interact $ show . solve . map read . tail . words
solve (w:hs) = minIndex . (zipWith (-) =<< drop w) . scanl (+) 0 $ hs
minIndex = go undefined maxBound 1 where
  go mi mv i (v:vs) | v < mv = go i v (i+1) vs
                    | otherwise = go mi mv (i+1) vs
  go mi _ _ _ = mi :: Int

import Control.Applicative
getList = fmap ((map read).words) getLine
solve k p = minimum (zipWith (-) (drop k list) list)
  where list = scanl1 (+) p
main = do
  [n,k] <- getList
  p <- getList
  putStrLn $ show $ solve k p

import Control.Applicative
import Data.List
import Data.Ord
getList = fmap ((map read).words) getLine
solve k p = snd (minimumBy (comparing fst) (zip (zipWith (-) (drop k list) list) [2..]))
  where list = scanl1 (+) p
main = do
  [n,k] <- getList
  p <- getList
  case n of
    1 -> putStr $ show $ head p
    otherwise -> putStrLn $ show $ solve k p

import Numeric
import Data.Array

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.snd.f. map fastRead .words

f (n:1:ns) = minimum (zip ns [1..])
f (n:k:ns) = dp (listArray (1, n) ns) (k+1) 1 n ((sum (take k ns)), 1)

dp :: Array Int Int -> Int -> Int -> Int -> (Int, Int) -> (Int, Int)
dp ns k n end ans
  | k <= end = dp ns (k+1) (n+1) end (min ans (i, (n+1)))
  | otherwise= ans
  where i = (fst ans) + (ns ! k) - (ns ! n)

import Numeric
import Data.Array

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.snd.f. map fastRead .words

f (n:k:ns) = dp (listArray (1, n) ns) (k+1) 1 n ((sum (take k ns)), 1)

dp ns k n end ans
  | k <= end = dp ns (k+1) (n+1) end (min ans (((fst ans) + (ns ! k) - (ns ! n)), (n+1)))
  | otherwise= ans

import Numeric
import Data.Array

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.snd.f. map fastRead .words

f (n:k:ns) = dp (listArray (1, n) ns) k 1 n ((sum (take k ns)), 1)

dp :: Array Int Int -> Int -> Int -> Int -> (Int, Int) -> (Int, Int)
dp ns k n end prev
  | k <= end = min prev (dp ns (k+1) (n+1) end (i, n))
  | otherwise= prev
  where i = (fst prev) + (ns ! k) - (ns ! n)

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ solve. concat. map (map read.words).take 2.lines
solve :: [Int]-> String
solve (x1:x2:xs) = show $ snd $ foldl f (sum $ take x2 xs,1) $  zip (zip  xs (drop (x2) xs)) [2..]
  where
  f (b1,b2) ((a1,a2),a3) = if a2-a1 < 0 then (b1+a2-a1, a3) else (b1,b2)

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

solve (a:b:c:hs) k min i j =
    let s = a+b+c in
    if (min > s)
        then solve (b:c:hs) k s (i+1) i
        else solve (b:c:hs) k min (i+1) j
solve _ _ _ _ j = j

main = do
    [n,k] <- map ( (read :: String -> Int) . C.unpack) .  C.words <$> C.getLine
    hs <- map ( (read :: String -> Int) . C.unpack) .  C.words <$> C.getLine
    print $ solve hs k (maxBound :: Int) 1 1

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

process k s = zipWith (\a b -> b-a )  (0:s1)  (drop (k-1) s1)
   where s1 = scanl1 (+) s

--process 1 s _ = s
--process k s t = process (k-1) (zipWith (+) s (tail t)) (tail t)

main=do
  [n,k]<-map read <$> words <$> getLine::IO [Int]
  s1<-  C.words <$> C.getLine
  let s = map ( fst.fromJust.C.readInteger ) s1
  let ss = process k s
  print ss
  print $ (+1) $ fromJust $ elemIndex (minimum ss) ss

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

process 0 s _ = s
process k s t = process (k-1) (zipWith (+) s (tail t)) (tail t)

main=do
  [n,k]<-map read <$> words <$> getLine::IO [Int]
  s<- map read <$> words <$> getLine::IO [Int]
  let ss = process k s s
  print $ fromJust $ elemIndex (minimum ss) ss

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))
import Data.List (minimumBy)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = print =<< solve <$> ((!!1) . map read . words <$> getLine) <*> (map (fst . fromJust . B.readInt) . B.words <$> B.getLine)

solve :: Int -> [Int] -> Int
solve k = fst . minimumBy (comparing snd) . zip [1..] . uncurry (zipWith (-)) . (drop (k - 1) &&& id) . scanl1 (+)

solve k xs = go 0 start zs
  where go _ _ [(_, _)] = 1
        go ind val ys@((j, y):yss)
          | j >= (l - k + 2) = ind
          | newval < val = go j newval yss
          | otherwise = go ind val yss
          where newval = sum . map snd . take k $ ys
        l = length xs
        zs = zip [1..] xs
        start = sum xs

main = do
    k <- fmap (last . map read . words) getLine :: IO Int
    ls <- fmap (map read . words) getLine :: IO [Int]
    print $ solve k ls

solve k xs = go 1 start zs
  where go _ _ [(_, _)] = 1
        go ind val ys@((j, y):yss)
          | j >= (l - k + 2) = ind
          | newval < val = go (ind+1) newval yss
          | otherwise = go ind val yss
          where newval = sum . map snd . take k $ ys
        l = length xs
        zs = zip [1..] xs
        start = sum xs

main = do
    k <- fmap (last . map read . words) getLine :: IO Int
    ls <- fmap (map read . words) getLine :: IO [Int]
    print $ solve k ls


{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Maybe

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

split = _split [] ""

_log2 !acc 1 = Just acc
_log2 !acc !curr
  | (curr `mod` 2 == 1) = Nothing
  | otherwise = _log2 (acc+1) (curr `div` 2)
log2 = _log2 (0 :: Integer)

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Integer]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          a:b:rest  ->
            let solve = (\big small ->
                  if big `mod` small > 0
                  then Nothing
                  else log2 (big `div` small)
                  )
                big = max a b
                small = min a b
                tmp = fromMaybe (-1) $ solve big small
                subres = if tmp == -1 then tmp else (tmp+2) `div` 3
            in Just (subres, rest)
        ) vals
  sequence_ (putStrLn . show <$> res)

import Data.Bits
import Control.Monad

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

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

solve :: Integer -> Integer -> Int
solve a b = if r == b then s else -1
  where
    d = myTr b - myTr a
    r = shift a d
    s = (abs d `div` 3) + fromEnum (abs d `mod` 3 /= 0)

myTr :: Integer -> Int
myTr a = until (testBit a) (+1) 0

import Data.Int

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

parse :: String -> (Int64, Int64)
parse = f . map read . words
  where
    f [x, y] = (x, y)

solve :: (Int64, Int64) -> Int
solve (a, b) = maybe (-1) ((`div` 3) . (+ 2)) (solve2 (min a b, max a b))

solve2 :: (Int64, Int64) -> Maybe Int
solve2 (a, b)
  | even a && even b = solve2 (a `div` 2, b `div` 2)
  | even a && odd b = Nothing
  | odd a && even b = succ <$> solve2 (a, b `div` 2)
  | odd a && odd b =
    if a == b
      then Just 0
      else Nothing

import Data.Int

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

parse :: String -> (Int64, Int64)
parse = f . map read . words
  where
    f [x, y] = (x, y)

solve :: (Int64, Int64) -> Int
solve (a, b) = maybe (-1) ((`div` 3) . (+ 2)) (f (min a b, max a b))
  where
    f :: (Int64, Int64) -> Maybe Int
    f (a, b)
      | a == b = Just 0
      | even a && even b = f (a `div` 2, b `div` 2)
      | odd a && even b = succ <$> f (a, b `div` 2)
      | otherwise = Nothing

module Main where
    get :: Integer -> Integer -> (Integer, Integer)
    get n pow =
        if n `mod` 2 == 0 then
            get (n `div` 2) (pow + 1)
        else
            (n, pow)

    solve :: IO ()
    solve = do
        s <- getLine
        let [a, b] = map (\x -> read x :: Integer) $ words s
            (ra, x) = get a 0
            (rb, y) = get b 0
        print $
            if ra /= rb then
                -1
            else
                (abs (x - y) + 2) `div` 3

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

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

solve :: Integer -> Integer -> Integer
solve a b
  | a == b = 0
  | a > b = solve b a
  | mod b a /= 0 = -1
  | twoIsTheOnlyFactor div' = minSteps div'
  | otherwise = -1
  where div' = div b a

twoIsTheOnlyFactor :: Integer -> Bool
twoIsTheOnlyFactor 1 = True
twoIsTheOnlyFactor n = (mod n 2 == 0) && twoIsTheOnlyFactor (div n 2)

minSteps :: Integer -> Integer
minSteps 1 = 0
minSteps x
  | x >= 8 = 1 + minSteps (div x 8)
  | x >= 4 = 1 + minSteps (div x 4)
  | x >= 2 = 1 + minSteps (div x 2)

parse :: String -> String
parse input = show $ solve a b
  where [a, b] = map (\x -> read x :: Integer) $ words input

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

import Data.Bits
import Control.Monad

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

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

solve :: Int -> Int -> Int
solve a b = if r == b then s else -1
  where
    d = countTrailingZeros b - countTrailingZeros a
    r = shift a d
    s = (abs d `div` 3) + fromEnum (abs d `mod` 3 /= 0)

solve :: Integer -> Integer -> Integer
solve a b
  | a == b = 0
  | a > b = solve b a
  | mod b a /= 0 = -1
  | mod div' 2 /= 0 = -1
  | otherwise = minSteps div'
  where div' = div b a

minSteps :: Integer -> Integer
minSteps 1 = 0
minSteps x
  | x >= 8 = 1 + minSteps (div x 8)
  | x >= 4 = 1 + minSteps (div x 4)
  | x >= 2 = 1 + minSteps (div x 2)

parse :: String -> String
parse input = show $ solve a b
  where [a, b] = map (\x -> read x :: Integer) $ words input

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


import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  map (words >>> map read) >>>
  process >>> map (map show >>> unwords) >>> unlines

process :: [[Int]] -> [[Int]]
process [] = []
process ([n, _]:xss) =
  let (xs, xss') = splitAt n xss
   in solve xs ++ process xss'

solve :: [[Int]] -> [[Int]]
solve = zipWith (\p -> zipWith f (drop p zo)) zo
  where
    zo = 0 : 1 : zo
    f p x
      | x `mod` 2 == p = x
      | otherwise = x + 1

import Data.List
import qualified Data.Set as Set

main = do
    contents <- getContents
    let notnull = filter (not . null) $ lines contents
    let input = map words notnull
    let res = go (drop 1 input)
    sequence res

go [] = []
go ((n:_):xs) =
    let (a, b) = splitAt (read n) xs
    in solve a:go b

solve arr =
    let solveA [] _     = []
        solveA (x:xs) y = sequence (solveB x y):solveA xs (y+1)
        solveB [] _ = [putStrLn ""]
        solveB (x:xs) y =
                let x' = read x
                in putStr (show (x' + ((x'+y) `mod` 2)) ++ " "):solveB xs (y+1)
    in sequence (solveA arr 0)

{-# 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 (l : rest) = (isstolines.solve.linestoiss.(take n)) rest ++  (tcio.(drop n)) rest where [n,_] = linetois l
  linetoi = read; linetois = (map linetoi) . words; linestoiss = (map linetois)
  itoline = show; istoline = unwords . (map itoline); isstolines = (map istoline)

solve :: [[Int]] -> [[Int]]
solve ass = zipWith (zipWith update) ass altrep where
  altrep = cycle $ map cycle [[0,1],[1,0]]
  update a b | a `mod` 2 == b = a
             | otherwise      = a+1

import Data.List
import qualified Data.Set as Set

main = do
    contents <- getContents
    let notnull = filter (not . null) $ lines contents
    let input = map words notnull
    let res = go (drop 1 input)
    sequence res

go [] = []
go ((n:_):xs) =
    let (a, b) = splitAt (read n) xs
    in solve a:go b

solve arr =
    let solveA [] _     = []
        solveA (x:xs) y = sequence (solveB x y):solveA xs (y+1)
        solveB [] _ = [putStrLn ""]
        solveB (x:xs) y = putStr (show (read x + y) ++ " "):solveB xs (y+1)
    in sequence (solveA arr 0)


module Main where

import Control.Arrow
import Data.List

main = interact $ lines >>>
  (\ (s:_n:xs) -> ($ xs) $ filter (isPrefixOf s) >>> sort >>> (++[s]) >>> head)

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

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

main :: IO ()
main =
      do { input:n:ss <- lines <$> getContents
         ; let ret  = case find (eqPrefix input) (sort ss) of
                        (Just str) -> str
                        Nothing    -> input
         ; printf  "%s" ret
         }

eqPrefix pre s =
    and (zipWith (==) pre s)

import Control.Monad
import Data.List

main = do
	s <- getLine
	n <- fmap read getLine
	a <- replicateM n getLine
	putStrLn $ head $ (++[s]) $ sort $ filter (isPrefixOf s) a

import Control.Monad
import List

main = do
  xs <- getLine
  n  <- readLn
  ys <- replicateM n getLine
  putStrLn $ solve xs ys

solve xs ys = case ys' of [] -> xs; (k:ks) -> k
  where ys' = filter (isPrefixOf xs) $ sort ys

module Main where

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

main = do
    s <- getLine
    n <- read `liftM` getLine
    dict <- Set.fromList `liftM` replicateM n getLine

    let (_, hit, dictAfter) = Set.splitMember s dict
        out = if hit || Set.null dictAfter || not ( isPrefixOf s ( Set.findMin dictAfter ) )
            then s
            else Set.findMin dictAfter
    putStrLn out

import Control.Monad
import Data.List

main = do
  input <- getLine
  count <- fmap read getLine
  dict  <- replicateM count getLine
  putStrLn (head ((++[input]) (sort (filter (isPrefixOf input) dict))))

import Data.List
import System.IO

solve :: [String] -> String
solve (x:n:xs) = autocomplete x xs

autocomplete :: String -> [String] -> String
autocomplete x xs
    | null ms    = x
    | otherwise  = head ms
    where ms = filter (isPrefixOf x) $ sort xs

main = do
    input <- getContents
    putStrLn $ solve (lines input)

import Data.List (isPrefixOf, sort)
import Maybe (fromMaybe, listToMaybe)
import Monad (liftM)

solve :: String -> [String] -> String
solve s  =  fromMaybe s . listToMaybe . filter (isPrefixOf s) . sort

main :: IO ()
main  =  do
    s  <-  getLine
    n  <-  readLn
    xs  <-  liftM (take n . lines) getContents
    putStrLn $ solve s xs

import Data.List

solver s lines = head $ filter (\x -> (take (length s) x) == s) (lines ++ [s])

main = do
  s <- getLine
  n' <- getLine
  lines <- sequence $ take (read n'::Int) $ repeat getLine
  putStrLn $ solver s $ sort lines

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

import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

main = do
  word <- getLine
  n <- read `fmap` getLine :: IO Int
  lines <- replicateM n getLine
  case filter (word `isPrefixOf`) $ sort lines of
    [] -> putStrLn word
    (l:_) -> putStrLn l

import Data.List
main=interact$f.words
f(w:_:x)|null t=w|1>0=minimum t where t=filter(isPrefixOf w)x

module Main where

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

main = interact $ lines >>>
  (\ (s:_n:xs) -> ($ xs) $ filter (isPrefixOf s) >>> flip if' s <$> null <*> minimum)
  where if' x t f = if x then t else f

module Main where

import Control.Arrow
import Data.List

main = interact $ lines >>>
  (\ (s:_n:xs) -> let ss = filter (isPrefixOf s) xs in if null ss then s else minimum ss)

module Main where

import Control.Arrow
import Data.List
import Data.Maybe

main = interact $ lines >>>
  (\ (s:_n:xs) -> ($ xs) $ filter (isPrefixOf s) >>> sort >>> listToMaybe >>> maybe s id)

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

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

main :: IO ()
main =
      do { input:n:ss <- lines <$> getContents
         ; let ret  = case find (eqPrefix input) (sort ss) of
                        (Just str) -> str
                        Nothing    -> input
         ; print  ret
         }

eqPrefix pre s =
    and (zipWith (==) pre s)


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

solve (_:xs) = maximum $ filter (not . isPerfactSqure) xs
    where sqrtInt num = maximum $ takeWhile (\x -> x*x <= num) [0 .. ]
          isPerfactSqure num
              | num >= 0= let s = sqrtInt num in s*s == num
              | otherwise = False

-- isPerfactSqure num = [ ans | ans <- [0 .. num], num == ans * ans] /= []

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

solve = maximum . (filter $ not . (`elem` (map (^2) [0 .. 1000])))

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

solve xs = maximum $ filter (not . (`elem` (map (^2) [0 .. 1000]))) xs

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

solve (_:xs) = maximum $ filter (not . isPerfactSqure) xs
    where isPerfactSqure num = elem num $ takeWhile (<=num) $ map (^2) [0 .. ]

import Data.List
f :: Double->Bool
f x
  |x==0=True
  |x<0=False
  |(floor(sqrt(x))^2)==floor(x) =True
  |otherwise=False

main = do
       e1<-getLine
       es<-getLine
       let n=read e1::Int
           xs=map read (words es)::[Double]
           xs2=reverse $ sort xs
       print $ floor $ head $ dropWhile (f) xs2

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

main = print =<< sol <$> (getLine *> get)

get :: IO [Int]
get = fmap read . words <$> getLine

sol :: [Int] -> Int
sol = maximum . filter (not . ps)

ps = (==) <*> ((^2) . floor . sqrt . fromIntegral)

main = interact $ show . maximum . filter notSquare . map read . tail . words
notSquare i = (floor (sqrt (fromIntegral i)))^2 /= i

import Data.Int

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

solve:: [Int64] -> Int64
solve (_:as) = maximum $ filter check as

check a
  | a < 0 = True
  | otherwise = round (sqrt (fromIntegral a)) ^ 2 /= a

import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)
import Data.List
import Control.Applicative
import Control.Monad

main = do
  n <- readLn :: IO Int
  a <- sortBy (\x y -> compare y x) <$> getIntListBC
  print $ solve a

solve :: [Int] -> Int
solve (x:xs) = let y = floor . sqrt $ realToFrac x
               in if x == y^2
                    then solve xs
                    else x

bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

getIntListBC :: IO [Int]
getIntListBC = map bsToInt . BC.words <$> BC.getLine

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

main = B.interact solve
solve = doSolve . map (read . B.unpack) . B.words
doSolve input = B.pack $ show $ last $ filter (not . isSquare) $ sort $ tail input
isSquare x = not $ null $ filter square $ takeWhile (\n -> n * n <= x) $ iterate (+1) 0 where square n = n * n == x

main = print . maximum . filter (not . isSquare) . map (read :: String -> Int) . tail . words =<< getContents
isSquare x = x >= 0 && let s = round $ sqrt $ fromIntegral x in s * s == x

main = do
        ln1 <- getLine
        ln2 <- getLine
        putStrLn $ (show . maximum) [ i | i <- f ln2, k i]
          where f = (map (\x -> read x :: Int)) . words
                k s = let s' = fromIntegral s in truncate(sqrt s') * truncate(sqrt s') /= s

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

solve = maximum . (filter (`notElem` (map (^2) [0 .. 1000])))

import Data.List
f :: Double->Bool
f x
  |x<=0=False
  |(floor(sqrt(x))^2)==floor(x) =True
  |otherwise=False

main = do
       e1<-getLine
       es<-getLine
       let n=read e1::Int
           xs=map read (words es)::[Double]
           xs2=reverse $ sort xs
       print $ floor $ head $ dropWhile (f) xs2

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

main = print =<< sol <$> (getLine *> get)

get :: IO [Int]
get = fmap read . words <$> getLine

sol :: [Int] -> Int
sol = fromJust . find ps . sortBy (flip compare) . filter (>0)

ps = (==) <*> (floor . (^2) . sqrt . fromIntegral)

import Data.List
main = interact $ show . last . go 1 . sort . map read . tail . words
go i (x:xs) = case compare x (i^2) of LT -> x : go  i       xs
                                      EQ ->     go  i       xs
                                      GT ->     go (i+1) (x:xs)
go _ [] = []

import Data.List
main = interact $ show . last . go (-1000) . sort . map read . tail . words
go i (x:xs) = case compare x (i^2) of LT -> x : go  i       xs
                                      EQ ->     go  i       xs
                                      GT ->     go (i+1) (x:xs)
go _ [] = []

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

main = B.interact solve
solve = doSolve . map (read . B.unpack) . B.words
doSolve input = B.pack $ show $ last $ filter (not . isSquare) $ sort $ tail input
isSquare x = not $ null $ filter square $ takeWhile (\n -> n * n <= x) $ iterate (+1) 1 where square n = n * n == x


main = fmap (f . tail . map read . words) getContents >>= putStrLn
f :: [Int] -> [Char]
f xs = unwords [(show . succ . length . fst . span (maximum xs /=)) xs, (show . maximum . filter (maximum xs /=)) xs]

main = fmap (f 1 0 0 0 . tail . map read . words) getContents >>= putStrLn
f a b c d [] = show b ++ " " ++ show d
f a b c d (x:xs)
  | x > c = f (a + 1) a x c xs
  | x > d = f (a + 1) b c x xs
  | otherwise = f (a + 1) b c d xs

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

main = do
		n<-read <$> getLine ::IO Int
		s<-  map read <$> words <$> getLine ::IO [Int]
		let x=   take 2$ reverse  $ sortOn fst $ zip s [1..]
		putStr $ show $ snd $ head x
		putStr " "
		putStrLn $ show $ fst $ head $ tail x


import Data.List

fi=fromIntegral

solve h n = unwords $ map (\x->show(sqrt ((fi x)*((fi h)**2)/(fi n)))) [1..n-1]

main=do
	d<-getLine
	let [n,h]=map (\x->read x::Integer) (words d)
	putStrLn (solve h n)

import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Text.Printf

main = (fmap (map read. words) getLine :: IO [Double]) >>= \[n, h]->  putStrLn $ unwords $ map (printf "%0.10f". (\x -> h * sqrt (x / n))) [1, 2 .. n - 1]

import Control.Applicative

totArea :: Float -> Float
totArea h = 0.5 * 0.5 * h

areaToHt :: Float -> Float -> Float
areaToHt t area = sqrt $ 2 * area / t

main :: IO ()
main = do
    [ns, hs] <- words <$> getLine
    let n = (read :: String -> Int) ns
        h = (read :: String -> Float) hs
        t = 0.5 / h
        area = totArea h / (fromIntegral n)
        hts = map (\ x -> areaToHt t $ (fromIntegral x) * area) [1..(n - 1)]
    mapM_ (\ x -> putStr $ (show x) ++ " ") hts
    putStrLn ""

solve :: Double -> Double -> Double -> Double
solve h n i = sqrt $ (i * h^2) / n

main :: IO ()
main = do
  [n, h] <- map (read :: String -> Int) . words <$> getLine
  putStrLn $ unwords . map (show . solve (fromIntegral h) (fromIntegral n) . fromIntegral) $ [1..n-1]


import Data.Foldable

main = interact foo

foo :: String -> String
foo inp =
    let [s, t] = take 2 . drop 1 . lines $ inp
        aa = map (\ii -> drop ii t) [0..((length t)-(length s))]
        (p, q) = minimumBy (\(i, _) (j, _) -> compare i j) $ map (bar s) aa
    in unlines $ [show p, unwords . map show $ q]

bar :: String -> String -> (Int, [Int])
bar s t =
    let a = zip3 [1..] s t
    in Prelude.foldl (\(n, m) (i, c1, c2) -> if c1 == c2 then (n, m) else (n+1, i:m)) (0, []) a

import Control.Monad
import Data.Char
import Data.List
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

calc [] _ ps n = ps
calc _ [] ps n = [-1]
calc (x:xs) (y:ys) ps n
  | x == y = calc xs ys ps (n + 1)
  | otherwise = calc xs ys (n:ps) (n + 1)

get x [] = []
get [] x = []
get (x:xs) (y:ys)
  | x == -1 = (y:ys)
  | y == -1 = (x:xs)
  | length xs > length ys = (y:ys)
  | otherwise = (x:xs)

solve s [] = calc s [] [] 1
solve s (x:t) = get (solve s t) (calc s (x:t) [] 1)

main :: IO ()
main = do
  _ <- getLine
  s <- getLine
  t <- getLine
  let
    l = reverse $ solve s t
  putStrLn . show $ length l
  putStrLn $ unwords (map show l)

import Data.List

main = putStrLn . solve . tail . lines =<< getContents

solve [a, b] = ans where
  la = length a
  s = filter ((>= la) . length) $ map (take la) $ tails b
  f = length . filter id . zipWith (/=) a
  g x = (x, f x)
  h c x = if snd c < snd x then c else x
  k = fst $ foldl h ("", 1010) $ map g s
  t = filter (/= 0) $ zipWith3 u [1..] a k
  u x y z = if y == z then 0 else x
  ans = unlines $ [show (length t), unwords $ map show t]

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
import Data.List

main = putStrLn . solve . tail . lines =<< getContents

solve [a,b] = ans where
    la = length a
    s = filter ((>= la) . length) $ map (take la) $ tails b
    f = length . filter id . zipWith (==) a
    g x = (x, f x)
    h c x = if snd c > snd x then c else x
    k = fst $ foldl h ("",0) $ map g s
    r = if k /= a then k else '_':tail k
    t = filter (/= 0) $ zipWith3 u [1..] a k
    u x y z = if y == z then 0 else x
    ans = unlines $ [show (length t), unwords $ map show t]

import Control.Monad
import Data.List

compar :: String -> String -> Int -> [Int]
compar [] _ _ = []
compar (x:xs) (y:ys) pos
  | x == y = compar xs ys (pos + 1)
  | otherwise = pos : compar xs ys (pos + 1)

main = do
  getLine
  s <- getLine
  t <- getLine
  let x = length s
  let y = length t
  tmp <- forM [0..y-x] $ \pos -> return (compar s (drop pos t) 1)
  let ans = minimumBy (\x y -> compare (length x) (length y)) tmp
  print $ length ans
  putStrLn . unwords . map show $ ans

import Data.List

main :: IO ()
main = do
    getLine
    str1 <- getLine
    str2 <- getLine
    let diffPos = map (solve str1 str2) [0..length str2 - length str1]
    let lens = map length diffPos
    print $ minimum lens
    let Just idx = (elemIndex (minimum lens) lens)
    printNums $ diffPos!!idx
    where
        solve strA strB pos = loop (length strA - 1)
            where
            loop (-1) = []
            loop seek = if (strA!!seek) /= (strB!!(pos+seek)) then (seek+1):loop (seek-1) else loop (seek-1)
        printNums [] = return ()
        printNums (l:list) = do
            putStr $ show l
            putChar ' '
            printNums list

module Main where

import Data.List

cnt_diff :: String -> String -> Int
cnt_diff s t = sum (zipWith dif s t)
	where
		dif x y = if x /= y then 1 else 0

solve :: String -> String -> Int -> [Int]
solve s t ind
	| m < n   	= []
	| otherwise = (cnt_diff s $ take n t) : (solve s (drop 1 t) (ind + 1))
	where
		inf = 1000 * 1000 * 1000
		n = length s
		m = length t

get_ans :: String -> String -> (Int, [Int])
get_ans s t = (mn, map fst $ filter (\(_, x) -> x == mn) lst)
	where
		l = solve s t 0
		lst = zip [0,1..] l
		inf = 1000 * 1000 * 1000
		mn = foldl min inf l

diff :: String -> String -> [Int]
diff s t = map fst $ filter (\(_,x) -> x == 1) $ zip [1,2..] $ zipWith dif s t
	where
		dif x y = if x /= y then 1 else 0

main :: IO ()
main = do
	nms <- getLine
	s <- getLine
	t <- getLine
	let (n, l) = get_ans s t
	putStrLn . show $ n
	--mapM_ (putStr . (\x -> (show x) ++ " ")) l
	let ind = head l
	mapM_ (putStr . (\x -> (show x) ++ " ")) $ diff s $ drop ind t
	--print ind
	--print $ drop ind t
	--print $ diff s $ drop ind t
	putStr "\n"

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

main = getLine *> ((\s t -> minimumBy (comparing fst) $ map ((\is -> (length is, is)) . map (\(i, _, _) -> i) . filter (\(_, c, c') -> c /= c') . zip3 [1..] s) $ take (length t - length s + 1) $ tails t ) <$> getLine <*> getLine) >>= (\(a, b) -> putStr $ show a ++ "\n" ++ unwords (map show b))

import Data.List;main=interact(\h->let[_,s,t]=lines h;l=length;(a,b)=minimumBy(\(a,_)(b,_)->compare a b)$map(((,)=<<l).map(\(i,_,_)->i).filter(\(_,c,z)->c/=z).zip3[1..]s)$take(l t-l s+1)$tails t in show a++"\n"++unwords(map show b))

module Main where

import Data.List

cnt_diff :: String -> String -> Int
cnt_diff s t = sum (zipWith dif s t)
	where
		dif x y = if x /= y then 1 else 0

solve :: String -> String -> Int -> [Int]
solve s t ind
	| m < n   	= []
	| otherwise = (cnt_diff s $ take n t) : (solve s (drop 1 t) (ind + 1))
	where
		inf = 1000 * 1000 * 1000
		n = length s
		m = length t

get_ans :: String -> String -> (Int, [Int])
get_ans s t = (mn, map fst $ filter (\(_, x) -> x == mn) lst)
	where
		l = solve s t 0
		lst = zip [1,2..] l
		inf = 1000 * 1000 * 1000
		mn = foldl min inf l

main :: IO ()
main = do
	nms <- getLine
	s <- getLine
	t <- getLine
	let (n, l) = get_ans s t
	putStrLn . show $ n
	mapM_ (putStr . (\x -> (show x) ++ " ")) l
	putStr "\n"

import Control.Monad
import Data.Char
import Data.List
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

calc [] _ ps n = ps
calc _ [] ps n = [-1]
calc (x:xs) (y:ys) ps n
  | x == y = calc xs ys ps (n + 1)
  | otherwise = calc xs ys (n:ps) (n + 1)

get (x:xs) (y:ys)
  | x == -1 = (y:ys)
  | y == -1 = (x:xs)
  | length xs > length ys = (y:ys)
  | otherwise = (x:xs)

solve s [] = calc s [] [] 1
solve s (x:t) = get (solve s t) (calc s t [] 1)

main :: IO ()
main = do
  _ <- getLine
  s <- getLine
  t <- getLine
  let
    l = reverse $ solve s t
  putStrLn . show $ length l
  putStrLn $ unwords (map show l)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
import Data.List

main = putStrLn . solve . tail . lines =<< getContents

solve [a,b] = ans where
    la = length a
    s = filter ((>= la) . length) $ map (take la) $ tails b
    f = length . filter id . zipWith (==) a
    g x = (x, f x)
    h c x = if snd c > snd x then c else x
    k = fst $ foldl h ("",0) $ map g s
    r = if k /= a then k else '_':tail k
    t = filter (/= 0) $ zipWith3 u [1..] a r
    u x y z = if y == z then 0 else x
    ans = unlines $ [show (length t), unwords $ map show t]

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
import Data.List

main = putStrLn . solve . tail . lines =<< getContents

solve [a,b] = ans where
    s = tails b
    f = length . filter id . zipWith (==) a
    g x = (x, f x)
    h c x = if snd x > snd c then x else c
    k = fst $ foldl h ("",0) $ map g s
    t = filter (/= 0) $ zipWith3 u [1..] a k
    u x y z = if y == z then 0 else x
    ans = unlines $ [show (length t), unwords $ map show t]

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU
import Data.List

main = putStrLn . solve . tail . lines =<< getContents

solve [a,b] = ans where
    s = filter ((==) (length a) . length) $ tails b
    f = length . filter id . zipWith (==) a
    g x = (x, f x)
    h c x = if snd x > snd c then x else c
    k = fst $ foldl h ("",0) $ map g s
    t = filter (/= 0) $ zipWith3 u [1..] a k
    u x y z = if y == z then 0 else x
    ans = unlines $ [show (length t), unwords $ map show t]

import Data.Foldable

main = interact foo

foo :: String -> String
foo inp =
    let [s, t] = take 2 . drop 1 . lines $ inp
        aa = map (\ii -> (ii, s, drop ii t)) [0..((length t)-(length s))]
        (p, q) = minimumBy (\(i, _) (j, _) -> compare i j) $ map bar aa
    in unlines $ [show p, unwords . map show $ q]

bar :: (Int, String, String) -> (Int, [Int])
bar (i0, s, t) =
    let a = zip3 [i0..] s t
    in Prelude.foldl (\(n, m) (i, c1, c2) -> if c1 == c2 then (n, m) else (n+1, i:m)) (0, []) a


import Data.List
import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.g (-1) .sort.parse.tail.lines

parse = map (map fastRead.words)

g best [] = best
g best (x:xs)
  | best <= i = g i xs
  | otherwise = g j xs
  where j = maximum x
        i = minimum x

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn :: IO Int
  xys <- sort.perse.map readInt.B.words <$> B.getContents
  print $ solve xys

perse (x:y:xys) = (x,y) : perse xys
perse _ = []

solve :: [(Int,Int)] -> Int
solve xys = go 0 xys
   where
     go !acc ((x,y):rest)
       | acc <= y = go y rest
       | otherwise = go x rest
     go acc _ = acc

import Data.List
main=interact$show.foldl(\c->minimum.filter(>=c))0.sort.map(map read.words).tail.lines

import Data.List
main = interact $ show . solve . sort . map (map read . words) . tail . lines

solve = flip foldl 0 $ \c ab -> minimum $ filter (>=c) ab

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

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

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

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

  print $ foldl (\v [a, b] -> if b >= v then b else a) 0 (sort ps)

import Data.List (foldl', sort)

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

solve :: [[Integer]] -> Integer
solve = foldl' (\x xs -> minimum (filter (>=x) xs)) 0 . sort

import Data.List
main = interact $ show . last . solve 0 . sort . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve d ((a,b):ds) = d' : solve d' ds where
  d' | b < d = a
     | otherwise = b
solve _ _ = []

import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Ord (comparing)

main :: IO ()
main = do
  n <- read <$> getLine
  dates <- replicateM n ((map read . words <$> getLine) >>= \(a:b:_) -> return (a, b))
  print $ foldl pickExam 0 $ sortBy (comparing fst <> comparing snd) dates

  where
    pickExam last (new, newEarly) = if newEarly < last then new else newEarly

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

pair [] = []
pair (a:b:c) = (a,b): ( pair c)

process n m [] = m

process n m ((a,b):c) 	| b<m = process a  a c
			| otherwise = process a b c

main= do
	getLine
	x<-   map read  .  words   <$> getContents::IO [ Int ]
	let y = process 0 0 $ sort $ pair x
	print y

import Data.List

solve :: Int -> [[Int]] -> Int
solve (0) ([x, y]:xs) = solve (min x y) xs
solve curr ([x, y]:xs) = solve (if y >= curr then y else x) xs
solve curr _ = curr

ord :: [Int] -> [Int] -> Ordering
ord [x1, y1] [x2, y2]
    | x1 < x2 = LT
    | x1 == x2 = compare y1 y2
    | otherwise = GT

parseInput :: String -> [[Int]]
parseInput = map (map read . words) . lines

main = do
    getLine
    getContents >>= print . solve (0) . sortBy ord . parseInput

import Data.List
import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.g.parse.tail.lines

parse = map (map fastRead.words)

g x
  | (myzip a b []) == q = minimum (last q)
  | otherwise = head (last q)
  where i = myunzip x [] []
        a = sort (fst i)
        b = sort (snd i)
        q = sort x

myunzip [] l1 l2 = (l1, l2)
myunzip (x:xs) l1 l2 = myunzip xs ((head x):l1) ((last x):l2)

myzip [] [] ans = reverse ans
myzip (x:xs) (y:ys) ans = myzip xs ys ([x, y]:ans)

import Data.List
import Numeric

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.g.parse.tail.lines

parse = map (map fastRead.words)

g x
  | (myzip a b []) == q = minimum (last q)
  | otherwise = head (last q)
  where i = myunzip x [] []
        a = sort (fst i)
        b = sort (snd i)
        q = sort x

myunzip [] l1 l2 = (l1, l2)
myunzip (x:xs) l1 l2 = myunzip xs ((head x):l1) ((last x):l2)

myzip [] [] ans = reverse ans
myzip (x:xs) (y:ys) ans = myzip xs ys ([x, y]:ans)

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

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

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

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

  let
    ys = map (!!1) $ sort ps

  print $
    if and $ zipWith (<=) ys $ tail ys
       then last ys
       else last $ map (!!0) $ sort ps

import Control.Monad (replicateM)
import Data.List (sortOn)

main :: IO ()
main = do
  n <- read <$> getLine
  dates <- replicateM n ((map read . words <$> getLine) >>= \(a:b:_) -> return (a, b))
  print $ foldl pickExam 0 $ sortOn fst dates

  where
    pickExam last (new, newEarly) = if newEarly < last then new else newEarly

import Data.List

solve :: Int -> [[Int]] -> Int
solve (0) ([x, y]:xs) = solve (min x y) xs
solve curr ([x, y]:xs) = solve (if y >= curr then y else x) xs
solve curr _ = curr

ord :: [Int] -> [Int] -> Ordering
ord [x1, y1] [x2, y2] = compare x1 x2

parseInput :: String -> [[Int]]
parseInput = map (map read . words) . lines

main = do
    getLine
    getContents >>= print . solve (0) . sortBy ord . parseInput


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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    [cs, as, bs] <- replicateM 3 (fmap (map fromIntegral) getInts)
    let
      acc (p, opt) (c, a, b) = (p', opt')
        where
        p' = max (abs (a - b) + 1) (if a == b then 0 else p + min a b + c - max a b + 1)
        opt' = max opt (p + c)
      c' = head $ reverse cs
      g xs y = tail xs ++ [y]
      (_, result) = foldl' acc (-10 ^ 17 :: Int64, 0 :: Int64) $ zip3 cs (g as 1) (g bs c')
    C.putStrLn $ C.pack $ show result

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

inf :: Integer
inf = 4000000000

test :: IO ()
test = do
  _ <- getLine
  cs <- map read . words <$> getLine :: IO [Integer]
  as <- tail . map read . words <$> getLine :: IO [Integer]
  bs <- tail . map read . words <$> getLine :: IO [Integer]
  let ps = zip (subtract 1 <$> tail cs) (zipWith ((abs .) . (-)) as bs)
  print $ maximum $ scanl (\m (x, y) -> if y == 0 then x + 2 else max (m - y) y + x + 2) (- inf) ps

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace)
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

solve :: Int -> [Int64] -> [Int64] -> [Int64] -> Int64
solve n cs as bs = snd $ solve' cs (tail as) (tail bs)
    where
        solve' [c] [] [] = (c - 1 + 2, 0)
                -- `debug` ("solve' " ++ show [c] ++ " " ++ "[]" ++ " " ++ "[]" ++ " = " ++ show (c - 1 + 2, 0))
        solve' cs@(c:restCs) as@(a:restAs) bs@(b:restBs) = (currentHalfCycleLength, max nextCycleLength currentCycleLength)
                -- `debug` ("solve' " ++ show cs ++ " " ++ show as ++ " " ++ show bs ++ " = " ++ show (currentHalfCycleLength, max nextCycleLength currentCycleLength))
            where
                (nextHalfCycleLength, nextCycleLength) = solve' restCs restAs restBs
                currentHalfCycleLength = 2 + if a == b then c - 1 else max (c - 1) $ c - 1 - abs (a - b) + nextHalfCycleLength
                currentCycleLength = abs (a - b) + nextHalfCycleLength

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        cs <- B8.getLine <&> map readIntB8 . B8.words
        as <- B8.getLine <&> map readIntB8 . B8.words
        bs <- B8.getLine <&> map readIntB8 . B8.words

        let answer = solve n (map fromIntegral cs) (map fromIntegral as) (map fromIntegral bs)

        printf "%lld\n" answer


cnt s c = length $ filter (==c) s
g s t = foldr (||) False [cnt s c == 0 && cnt t c > 0 | c <- ['a'..'z']]
f s t
    | g s t == False = sum [min (cnt s c) (cnt t c) | c <- ['a'..'z']]
    | otherwise = -1
main = do
   s <- getLine
   t <- getLine
   print $ f s t

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

main = do
    bought   <- convert <$> getLine
    required <- convert <$> getLine
    print $ solve bought required

convert :: String -> [Int]
convert = map ((subtract 1) . length) . group . sort . (['a' .. 'z'] ++)

solve :: [Int] -> [Int] -> Int
solve [] [] = 0
solve (b:bought) (r:required)
    | b == 0 && r > 0 = -1
    | result /= -1    = (min b r) + result
    | otherwise       = -1
        where
            result = solve bought required

import Data.List

main = do
  n <- getLine
  m <- getLine
  print $ solve n m

solve :: String ->  String -> Int
solve n m = max(-1)$sum(zipWith (&) ns ms)
   where
     ns = map (cnt n) ['a'..'z']
     ms = map (cnt m) ['a'..'z']
     n & m | m <= n    = m
           | n == 0    = -10000
           | otherwise = n
     cnt cs c = length $ filter (c==) cs

import Data.List

main = do
  n <- getLine
  m <- getLine
  print $ solve n m

solve :: String ->  String -> Int
solve n m = case sum(zipWith (&) ns ms) of
              0 -> (-1)
              res -> res
   where
     ns = map (cnt n) ['a'..'z']
     ms = map (cnt m) ['a'..'z']
     n & m | m <= n    = m
           | otherwise = n
     cnt cs c = length $ filter (c==) cs


{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
data State s a = State {runState :: s->(a,s)}
instance Monad (State s) where
	return = State . (,)
	(State f1) >>= f2 = State $ uncurry (runState . f2) . f1
	(State f1) >> (State f2) = State $ f2 .snd . f1

repeatM a = mapM (const a) (repeat 1)
repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)
readchar = State (\s->(head s,tail s))
readall = State (,"")

runRead x s = fst $ runState x s

main = reader >>= writer  . solver
reader = getContents
writer = putStr
solver = runRead $ do
	n<-readm
	m<-readm
	let (portsi,portso,path) = solve n m
	return $ show (length portsi) ++ "\n" ++ (unlines . map showpp $ zip portsi portso) ++ (unlines . map showp $ path)

showp (a,b) = show a ++ " " ++ show b
showpp (a,b) = showp a ++ " " ++ showp b

flipp = uncurry (flip zip) . unzip

flippp (a,b,c) = (flipp a,flipp b,flipp c)
solve 1 2 = ([],[],[(1,1),(1,2),(1,1)])
solve 2 1 = flippp $ solve 1 2
solve 1 n = ([(1,n)],[(1,1)],[(1,i) | i<-[1..n] ++ [1]])
solve n 1 = flippp $ solve 1 n
solve n m = case (mod n 2,mod m 2) of
	(1,1) -> ([(n,m)],[(1,1)],concat [ zip (repeat i) $ (if mod i 2 == 1 then id else reverse) [1..m] | i<-[1..n]] ++ [(1,1)])
	(1,0) -> flippp $ solve m n
	(0,_) -> ([],[],
			[(1,1)] ++ concat [zip (repeat i) $ (if mod i 2 == 1 then id else reverse) [2..m] | i<-[1..n]] ++ zip (reverse [1..n]) (repeat 1)
		)


import Control.Applicative ((<$>))

import Data.Char (toLower)
import qualified Data.Map as Map
import Data.Tuple

main = do
	getLine
	pairs <- map ((\[to, _, from] -> (to, from)) . words) . lines . map toLower <$> getContents

	let distances =
			Map.fromList $ ("polycarp", 1) : (map (uncurry calc) pairs)
		where
			calc :: String -> String -> (String, Int)
			calc to from = (to, (distances Map.! from) + 1)

	print $ maximum $ map snd $ Map.toList distances

import Control.Applicative
import Data.Char
import Data.Map hiding (map)

main :: IO ()
main = do
  n <- read <$> getLine
  m <- go n $ singleton "polycarp" 1
  print $ maximum $ elems m
  where
  key = map toLower
  go 0 m = return m
  go i m = do
    [a, _, b] <- words <$> getLine
    go (i-1) $ insert (key a) (m!key b + 1) m

import Data.Char
main = do
	n<-getLine
	rest<-getContents
	putStrLn $ show $ solve ((map words (lines (map toLower rest)))) [("polycarp",1)]

solve [] acc = maximum $ map snd acc
solve (c:chain) acc = solve chain ((head c, getLevel (last c) acc +1):acc)

getLevel _ [] = 0
getLevel "polycarp" _ = 1
getLevel name (a:acc) | name == fst a = snd a
                      | otherwise = getLevel name acc

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (maximum1 $ rmap (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

rmap :: (a -> b) -> [a] -> [b]
rmap f []     = []
rmap f (x:xs) = f x `seq` ( (f x) : rmap f xs )

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Control.Monad
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Char (toLower)

toLowerS :: String -> String
toLowerS = map toLower

reposts :: [(String, [String])] -> Map String [String]
reposts = M.fromListWith (++)

maxreposts :: String -> Map String [String] -> Int
maxreposts key mapss = case M.lookup key mapss of
  Nothing -> 1
  Just values -> 1 + (maximum $ map (\k -> maxreposts k mapss) values)

main :: IO ()
main = do
  n <- readLn :: IO Int
  rawReposts <- replicateM n (getLine >>= \s -> do
                                 let ss = words s
                                 return (toLowerS (last ss), [toLowerS (head ss)]))
  print $ maxreposts "polycarp" $ reposts rawReposts

import Control.Applicative ((<$>))

import Data.Char (toLower)
import qualified Data.Map as Map
import Data.Tuple

main = do
	getLine
	pairs <- map ((\[to, _, from] -> (to, from)) . words) . lines . map toLower <$> getContents

	let distances =
			Map.fromList $ ("polycarp", 1) : (map (uncurry calc) pairs)
		where
			calc to from = (to, (distances Map.! from) + 1)

	print $ maximum $ map snd $ Map.toList distances

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum l str = case partition (\(_,x) -> x == str) l of
			([],_) -> 1
			(a,b)  -> 1 + (maximum1 $ map (trailNum b) (map fst a))

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ trailNum pairs "polycarp"

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum p   str = 1 + (x `seq` maximum1 x)
			where x = let (a,b) = partition (\(_,x) -> x == str) p
			          in map (trailNum b) (map fst a)

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 0
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [1])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 1
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum b) (map fst a)) ++ [0])
			where (a,b) = partition (\(_,x) -> x == str) p

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum1 $ map (trailNum b) (map fst a))
			where (a,b) = partition (\(_,x) -> x == str) p

maximum1 :: [Int] -> Int
maximum1 x = if x == [] then 0 else maximum x

import Data.List (partition)
import Data.Char (isUpper, toLower)

main = do
  n     <- fmap read getLine :: IO Int
  input <- fmap (map ifUpperLower) getContents
  let pairs = pairParse $ take n $ lines input
  putStrLn . show $ 1 + (trailNum pairs "polycarp")

ifUpperLower :: Char -> Char
ifUpperLower c = if isUpper c then toLower c else c

pairParse :: [String] -> [(String, String)]
pairParse = (map (\x -> (head x, last x))) . (map words)

trailNum :: [(String, String)] -> String -> Int
trailNum []  str = 0
trailNum [_] str = 1
trailNum p   str = 1 + (maximum $ (map (trailNum p) (map fst (filter (\(_,x) -> x == str) p))) ++ [0])


main :: IO()
main = do
    a <- getLine
    let n = read a :: Int
    if odd n
        then putStrLn "-1"
        else putStrLn $ unwords $ map show $ reverse [1..n]

import Control.Monad
import Data.List

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    if odd n
    then print (-1)
    else do
        let (evens, odds) = partition even [1..n]
        let soln = interleave evens odds
        forM_ soln $ \i -> putStr (show i) >> putChar ' '

interleave xs ys = f xs ys [] where
    f [] [] zs = zs
    f (x:xs) (y:ys) zs = x:y: f xs ys zs

gao [] = []
gao (i:j:k) = j:i:gao k

main = do
  n <- fmap read getLine
  putStrLn $ unwords $ map show $ if odd n then [-1] else gao [1 .. n]

import Data.List
import Data.List.Split

(|>) x f = f x
main = interact solve

solve contents = let
  n = contents |> lines |> head |> read :: Int
  in pp n

pp n = if odd n then "-1" else permute n

permute n = [1..n] |> chunksOf 2 |> map reverse |> concat |> map show |> unwords

main = do
    n <- getLine
    putStr $ unwords $ map show $ f $ (read n :: Int)

f :: Int -> [Int]
f n
    | (mod n 2)==1 = [-1]
    | otherwise = f1 1 n

f1 :: Int -> Int -> [Int]
f1 a 0 = []
f1 a n = (a+1):a:(f1 (a+2) (n-2))

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const

prints :: Show a => [a] -> IO ()
prints xs  =  mapM_ (putStr . (++ " ") . show) xs >> putStrLn ""

main :: IO ()
main  =  do
    n  <-  readLn
    (odd n) ? (putStrLn "-1") $ prints $ reverse [1..n]

main=interact$f.read
f::Int->[Char]
f x=if odd x then "-1" else q x
q 2="2 1"
q x=q (x-2)++" "++show x++" "++show (x-1)

import Control.Applicative

solve :: Int -> [Int]
solve 0 = []
solve n = 2:1:map (+2) (solve $ n - 2)

main = do
    n <- read <$> getLine
    if n `mod` 2 == 1
        then print $ -1
        else putStrLn $ concatMap ((++" ").show) $ solve n

main=interact$unwords.map show.f.read
f n|odd n=[-1]|1>0=[1..n`div`2]>>= \i->[2*i,2*i-1]

main :: IO ()
main = readLn >>= putStrLn . unwords . map show . solve

solve :: Integer -> [Integer]
solve n | even n = concatMap (\i -> [ 2 * i, 2 * i - 1 ]) [ 1 .. n `div` 2 ]
        | otherwise = [ -1 ]

module Main where

import Control.Applicative

swapL [] = []
swapL (x:y:l) = y:x:swapL l

main = do
  n <- read <$> getLine
  if n `mod` 2 == 1
   then (putStrLn "-1")
   else (putStrLn . unwords . map show $ swapL [1..n])

main = do
  n <- readLn
  if odd n
    then print (-1)
    else putStrLn $ unwords $ map show $ solve n 1
solve n i | i >= n    = []
          | otherwise = i+1 : i : solve n (i+2)

main = interact $ unwords . map show . f . read
f n | odd n     = [-1]
    | otherwise = [1..div n 2] >>= (\x -> [2*x, 2*x-1])

main=readLn>>=putStrLn.unwords.map show.f
f n| odd n = [-1]
   | otherwise = [1..div n 2] >>= \i->[2*i,2*i-1]

import Control.Applicative
import Data.List

perm n = myswap [1..n]

myswap [] = []
myswap (a:b:cs) = b:a:(myswap cs)

main= do
	n<- read <$> getLine
	let x= if even n then perm n else [-1]
	putStrLn $ intercalate " " $ map show x

process :: Int -> [Int]
process n
    | odd n = [-1]
    | otherwise = concat $ map (\x -> [x,x-1]) [2,4..n]

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    putStrLn . unwords . map show $ process n

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

main :: IO()
main = do
  a <- getLine
  let b = read a::Int
  if (odd b)
    then putStrLn "-1"
    else putStrLn $ unwords $ map show $ f [1..b] 1

main = readLn >>= putStrLn . unwords . map show . f
f n
  | odd n = [-1]
  | otherwise = [1.. div n 2] >>= \i -> [2*i, 2*i-1]

main = putStrLn . unwords . map show . slv . read =<< getLine
slv 1 = [-1]
slv n
 | n `mod` 2 == 0 = [n,n-1..1]
 | True           = [-1]

import Data.List
perfectPerms n = [ p | p <- permutations [1..n],
                       i <- [1..n],
                       p !! (i-1) /= i,
                       p !! ((p !! (i-1)) - 1) == i]
p [] = "-1"
p a = unwords . map show $ a
main = interact $ p . perfectPerms . read

import Data.List
perfectPerms n = [ p | p <- permutations [1..n],
                       i <- [1..n],
                       p !! (i-1) /= i,
                       p !! ((p !! (i-1)) - 1) == i]
p [] = "-1"
p (a:as) = unwords . map show $ a
main = interact $ p . perfectPerms . read

main = putStrLn . unwords . map show . slv . read =<< getLine
slv 1 = [-1]
slv n = [n,n-1..1]


import Data.Int
import Control.Monad

main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \_ -> do
    [n, r] <- fmap (fmap read . words) getLine :: IO [Int64]
    let result = if r < n
                 then (r * (r + 1)) `div` 2
                 else ((n - 1) * n) `div` 2 + 1
    print result

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Monad (forM_, replicateM_)
import           Data.Word

sol n r =
  let p1 = if r < n
           then 0
           else 1
      p2 = if r >= n - 1
           then (n - 1) * n `div` 2
           else r * (r + 1) `div` 2 in
    p1 + p2

main = do
  t <- readLn
  replicateM_ t $ do
    [n, r] :: [Word64] <- map read . words <$> getLine
    print $ sol n r

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, r] <- map read . words <$> getLine :: IO [Integer]
    if r < n
      then
        print $ r * (r + 1) `div` 2
      else
        print $ n * (n - 1) `div` 2 + 1

{- 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, r] <- map read . words <$> getLine
  print $ if r < n then triangle r else triangle (n - 1) + 1

triangle n = (n * (n + 1)) `div` 2

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Monad (forM_, replicateM_)

sol n r =
  let p1 = if r < n
           then 0
           else 1
      p2 = if r >= n - 1
           then (n - 1) * n `div` 2
           else r * (r + 1) `div` 2 in
    p1 + p2

main = do
  t <- readLn
  replicateM_ t $ do
    [n, r] :: [Word] <- map read . words <$> getLine
    print $ sol n r

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, r] <- map read . words <$> getLine :: IO [Int]
    if r < n
      then
        print $ r * (r + 1) `div` 2
      else
        print $ n * (n - 1) `div` 2 + 1


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

sample1 0 _ = []
sample1 n m = [if even i then w else r |i<-[1..m]] : sample1 (n-1) m
            where
                w = if even n then 'W' else 'R'
                r = if even n then 'R' else 'W'

sample2 0 _ = []
sample2 n m = [if odd i then w else r |i<-[1..m]] : sample2 (n-1) m
            where
                w = if even n then 'W' else 'R'
                r = if even n then 'R' else 'W'

myZip _ '.' =  True
myZip '.' _ = True
myZip a b = a == b

solve [] [] = True
solve (a:as) (b:bs) = solve as bs && (and $ zipWith myZip a b)

printResult = do
    [n,m] <- readInts
    xs <- replicateM n getLine
    let a = sample1 n m
        b = sample2 n m
        ra = solve a xs
        rb = solve b xs
        r = ra || rb
    putStrLn $ if r then "YES" else "NO"
    if r then mapM_ putStrLn (if ra then a else b)
    else return ()

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

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: [BS.ByteString] -> Int
solve ss
    | all (ok 0) $ zip ss [0..] = 0
    | all (ok 1) $ zip ss [0..] = 1
    | otherwise = 2
    where
        ok i0 (s,i1) = all (\j -> ok2 (BS.index s j) (i0 `xor` i1 `xor` j)) [0..m-1]
            where
                m = BS.length s
                ok2 '.' _ = True
                ok2 'R' i = even i
                ok2 'W' i = odd i

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n, m] <- map parseInt . BS.words <$> BS.getLine
        grid <- replicateM n $ BS.pack . dropWhileEnd isSpace . BS.unpack <$> BS.getLine
        let r = solve grid
        if r == 2 then
            putStrLn "NO"
        else do
            putStrLn "YES"
            forM_ [0..n-1] $ \i -> do
                let x = i `mod` 2 == r
                let ss = if x then "RW" else "WR"
                let s = take m $ concat $ repeat ss
                putStrLn s


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

process [] n a | n>=0 = reverse ( (n+1) : (tail a))
               | otherwise= [-1]

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

check [] _ = True
check (s:ss) n	| n<0 =False
		| s==')' = check ss (n+1)
	       	| s=='(' = check ss (n-1)
	       	| otherwise = n>=0

main=do
	s<- getLine
	putStrLn $ if not (check (reverse s) 0) then "-1" else intercalate "\n"$ map show $ process s 0 []

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m n _ | m < 0 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) (min m n) x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.List (intercalate)

parse :: Int -> String -> Int
parse p (c:cs) | p < 0 = -1
               | c == '(' = parse (p+1) cs
               | otherwise = parse (p-1) cs
parse p _ = p

transform :: Int -> String -> String
transform n = snd . foldr f (False, "")
    where f c (r, cs) | c == '#' && r = (r, ')':cs)
                      | c == '#' = (not r, replicate n ')' ++ cs)
                      | otherwise = (r, c:cs)

solve :: String -> String
solve str | p < 0 || i < 0 = "-1"
          | otherwise = intercalate "\n" $ replicate h "1" ++ [show $ p + 1]
    where h = (subtract 1) $ length $ filter (== '#') str
          p = parse 0 str
          t = transform (p+1) str
          i = parse 0 t

main = getLine >>= putStrLn . solve

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  cs <- getLine
  putStr.unlines.map show.maybe[-1]id $ solve cs

solve :: String -> Maybe [Int]
solve cs = go0 0 (reverse cs) >>= go [] 0
   where
     go _ _ "(" = Nothing
     go res stk ('(':cs) = go res (stk+1) cs
     go res stk ('#':cs)
       | stk > 0 = go (1:res) (stk-1) cs
       | otherwise = Nothing
     go res stk (')':cs)
       | stk > 0 = go res (stk-1) cs
       | otherwise = Nothing
     go (r:res) stk [] = Just (reverse $ (r + stk) : res)
     go _ _ _ = Nothing

     go0 stk (')':cs) = go0 (stk+1) cs
     go0 stk ('(':cs)
        | stk > 0 = go0 (stk-1) cs
        | otherwise = Nothing
     go0 stk cs = Just $ reverse $ replicate stk ')' ++ cs

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m _ _ | m < 0 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) n x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.Maybe
main = interact $ unlines . map show . fromMaybe [-1] . f 0
f 0 [] = Just []
f _ [] = Nothing
f n ('(':y) = f (n+1) y
f n (')':y)
  | n > 0 = f (n-1) y
  | otherwise = Nothing
f n ('#':'#':y)
  | n > 0 = fmap (1:) $ f (n-1) ('#':y)
  | otherwise = Nothing
f n ('#':y)
  | n > length a = fmap (n-length a:) $ f 0 b
  | otherwise = Nothing
  where (a,b) = span (==')') y
f n (x:y) = f n y

main = getLine >>= putStr . unlines . map show . g . f 0 0
f m n _ | m < 0 || n < 1 = [-1]
f m n ('(':x) = f (m+1) n x
f m n (')':x) = f (m-1) (min (m-1) n) x
f m n ('#':x) = 1:f (m-1) m x
f m n [] | n > m = [m+1] | otherwise = [-1]
g x | last x == -1 = [-1] | otherwise = init (init x) ++ [last x]

import Data.List (intercalate)

parse :: String -> ([Int], Int, Int)
parse = foldl func ([], 0, 0)
    where func (xs, p, h) x =
            let (n, nh) | x == '#' = (p - 1, h + 1)
                        | x == '(' = (p + 1, h)
                        | x == ')' = (p - 1, h)
            in (n:xs, n, nh)

solve :: ([Int], Int, Int) -> String
solve ((x:_), _, h) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show $ x + 1]

main = getLine >>= putStrLn . solve . parse

import Data.List (intercalate)

parse :: Int -> Int -> String -> Maybe (Int, Int)
parse p h (c:cs) | p < 0 = Nothing
                 | c == '#' = parse (p-1) (h+1) cs
                 | c == '(' = parse (p+1) h cs
                 | c == ')' = parse (p-1) h cs
parse p h [] = if p < 0 then Nothing else Just (p, h)

solve :: Maybe (Int, Int) -> String
solve Nothing = "-1"
solve (Just (x, h)) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show $ x + 1]

main = getLine >>= putStrLn . solve . parse 0 0

import Data.List (intercalate)

parse :: String -> ([Int], Int, Int)
parse = foldl func ([], 0, 0)
    where func (xs, p, h) x =
            let (n, nh) | x == '#' = (p - 1, h + 1)
                        | x == '(' = (p + 1, h)
                        | x == ')' = (p - 1, h)
            in (n:xs, n, nh)

solve :: ([Int], Int, Int) -> String
solve ((x:_), _, h) =
    intercalate "\n" $ replicate (h - 1) "1" ++ [show x]

main = getLine >>= putStrLn . solve . parse

import Data.List (intercalate)

prepare :: Int -> Int -> [Int] -> String -> [Int]
prepare hashes prev res (c:cs)
    | c == '#' = prepare (hashes+1) next (next:res) cs
    | otherwise = prepare hashes next (next:res) cs
        where next = if c == '(' then prev + 1 else prev - 1
prepare h _ res _ = h : reverse res

solve :: [Int] -> [Int]
solve [h, x] = if x > 0 then [h, x] else [h, -1]
solve (h:x:xs) | x == -1 = [h, -1]
               | otherwise = solve (h:xs)

output :: [Int] -> String
output [_, -1] = "-1\n"
output [h, 0] = intercalate "\n" $ replicate h "1"
output [h, x] = intercalate "\n" $ replicate (h-1) "1" ++ [show (x+1)]

main = getLine >>= putStrLn . output . solve . prepare 0 0 []

import Data.List (intercalate)

prepare :: Int -> Int -> [Int] -> String -> [Int]
prepare hashes prev res (c:cs)
    | c == '#' = prepare (hashes+1) next (next:res) cs
    | otherwise = prepare hashes next (next:res) cs
        where next = if c == '(' then prev + 1 else prev - 1
prepare h _ res _ = h : reverse res

solve :: [Int] -> [Int]
solve [h, x] = if x >= 0 then [h, x] else [h, -1]
solve (h:x:xs) | x == -1 = [h, -1]
               | otherwise = solve (h:xs)

output :: [Int] -> String
output [_, -1] = "-1\n"
output [h, 0] = intercalate "\n" $ replicate h "1"
output [h, x] = intercalate "\n" $ replicate (h-1) "1" ++ [show (x+1)]

main = getLine >>= putStrLn . output . solve . prepare 0 0 []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  cs <- getLine
  putStr.unlines.map show.maybe[-1]id $ solve cs

solve :: String -> Maybe [Int]
solve cs = go [] 0 cs
   where
     go res stk ('(':cs) = go res (stk+1) cs
     go res stk ('#':cs)
       | stk > 0 = go (1:res) (stk-1) cs
       | otherwise = Nothing
     go res stk (')':cs)
       | stk > 0 = go res (stk-1) cs
       | otherwise = Nothing
     go (r:res) stk [] = Just (reverse $ (r + stk) : res)
     go _ _ _ = Nothing

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

process [] n a | n<0 = [-1]
               | otherwise= reverse ( (n+1) : (tail a))

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

main=do
	s<- getLine
	putStrLn $ intercalate "\n"$ map show $ process s 0 []

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

process [] n a | n==0 = reverse ( (n+1) : (tail a))
               | otherwise= [-1]

process (s:ss) n a	|n<0 = [-1]
			| s=='(' = process ss (n+1) a
			| s==')' = process ss (n-1) a
			| otherwise = process ss (n-1) (1:a)

main=do
	s<- getLine
	putStrLn $ intercalate "\n"$ map show $ process s 0 []


import Control.Monad
import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))

type Arr = A.UArray Int Int
type Dp = Arr

countLeft' :: [Int] -> (Int,Char) -> [Int]
countLeft' lst@(b:xb) (i,'+') | (even i) = ((b+1):lst)
countLeft' lst@(b:xb) (i,'-') | (even i) = ((b-1):lst)
countLeft' lst@(b:xb) (i,'+') | otherwise = ((b-1):lst)
countLeft' lst@(b:xb) (i,'-') | otherwise = ((b+1):lst)

countLeft :: String -> [Int]
countLeft s =
  reverse $ foldl countLeft' [0] (zip [0..] s)

toArray :: [Int] -> Arr
toArray a = A.array (0,(length a)-1) (zip [0..] a)

prepare :: String -> Dp
prepare x = toArray $ countLeft x

query' :: Int -> Int -> Dp -> Int
query' l r _ | l > r = 0
query' l r dp | odd l = (dp ! r) - (dp ! (l-1))
query' l r dp | otherwise = (dp ! (l-1)) - (dp ! r)

query :: Int -> Int -> Dp -> Int
query l r dp =
  let sum = query' l r dp
  in
    if sum == 0 then 0
    else if even (r-l+1) then 2
    else 1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,q] = map read $ words line :: [Int]
    str <- getLine
    --print str
    let dp = prepare str
    --print dp
    forM_ [1..q] $ \_ -> do
      line <- getLine
      let [l,r] = map read $ words line :: [Int]
      --print [l,r]
      let res = query l r dp
      print res

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

import Data.Array

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type Input = (String, [(Int, Int)])
type Output = [Int]

input :: Scanner Input
input = do
  str
  q <- int
  (,) <$> str <*> (q >< pair int int)

output :: Output -> C.ByteString
output = C.unlines . map showB

solve :: Input -> Output
solve (s, qs) = map query qs
  where
    conv c i = (if c == '+' then 1 else -1) * (if odd i then 1 else -1)

    pref = listArray (0, length s) $ scanl (+) 0 $ zipWith conv s [0..]
    rsum l r = pref ! r - pref ! (l - 1)

    query (l, r)
      | rsum l r == 0 = 0
      | odd (r - l + 1) = 1
      | otherwise = 2

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = (Int, Int, Int)
type OutType = Int

solve :: InType -> OutType
solve (l, r, a) = if x >= l then f x else f r
  where x = if r `mod` a == a - 1 then r else r - r `mod` a - 1
        f z = z `div` a + z `mod` a

receive :: [String] -> InType
receive [s] =
  case toArr s of
    [l, r, a] -> (l, r, a)
    _         -> error "input"

main :: IO ()
main = interact $ unlines . map (show . solve . receive) . chunksOf 1 . tail . lines

import Control.Arrow

main = interact $ lines >>> drop 1 >>> map processTest >>> unlines

processTest = words >>> map read >>> solve >>> show

solve [l, r, a]
  | not (l <= r) = solve [r, l, a]
  | div l a == div r a = f a r
  | mod r a == a - 1 = f a r
  | otherwise = f a (r - mod r a - 1)

f a x = div x a + mod x a

import Data.List ( sort )
solve :: [String] -> [String]
solve = map (show . func)

func b
    | (l `div` a) == (r `div` a) = uncurry (+) (r `divMod` a)
    | (r `mod` a) == a-1 = uncurry (+) (r `divMod` a)
    | otherwise = (r `div` a) + a - 2
    where
        [l,r,a] = map read $ words b

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

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = max (r `div` a + r `mod` a) (ll `div` a + ll `mod` a)
    where
        ll = max (r - (r `mod` a) - 1) l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = maximum [x `div` a + x `mod` a | x <- [r - (r `mod` a) - 1.. r]]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = maximum [x `div` a + x `mod` a | x <- [ll .. r]]
  where
    ll = if r - l < l then l else r - l

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [a, b, c] = (map read . words) l
        print $ solve a b c

import Control.Monad (forM_)

solve :: Int -> Int -> Int -> Int
solve l r a = max (b + c) (d + e)
    where
        b = r `mod` a
        c = r `div` a
        d = (r-1) `mod` a
        e = (r-1) `div` a

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [n, b, x] = (map read . words) l
        print $ solve n b x


-- https://codeforces.com/contest/1618/problem/A
import Control.Monad (replicateM)

answer [a,_,_,_, ac, bc,_] = show a ++ " " ++ show b ++ " " ++ show c where
    c = ac - a
    b = bc - c

main = getLine >>= flip replicateM run . read
run = do
    line <- (read <$>) . words <$> getLine
    putStrLn $ answer line

import Control.Monad (forM_)

solve :: (Eq a, Num a) => [a] -> [a]
solve arr =
    if a + b == c then [a, b, d] else [a, b, c]
  where
    (a : b : c : d : cs) = arr

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ unwords $ map show $ solve arr

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

solve :: IO ()
solve = do
    xs <- readInts
    let a = head xs
        b = a + minimum (map (subtract a) $ tail xs)
        c = last xs - a - b
    putStrLn $ unwords $ map show [a, b, c]

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts