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

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

qs :: String -> [Int]
qs = let
  step v '0' = v + if  v >= 0  then  1  else  0
  step _ '1' = 0
  step _ _ = error "bad input"
  in  tail . scanl step (0-1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, m] <- readInts
    s <- P.unpack <$> readLine
    let
      q1 = qs s
      q2 = reverse $ qs $ reverse s
      ok x = 0 <= x && x <= m
      ans = do
        (x, y) <- zip q1 q2
        pure $ if  (ok x || ok y) && (x /= y || x == 0)
          then  '1'
          else  '0'
    lift $ putStrLn ans

type SIO = StateT P.ByteString IO

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

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

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

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m] <- getInts
    as <- take n . C.unpack <$> C.getLine
    let result = func False (map (\s -> (head s, length s)) $ group as)
        f c
          | 2 * m <= c = replicate m '1' ++ replicate (c - 2 * m) '0' ++ replicate m '1'
          | odd c = replicate (c `div` 2) '1' ++ ['0'] ++ replicate (c `div` 2) '1'
          | otherwise = replicate c '1'
        func _ [] = []
        func True (('0', c) : []) = replicate (min c m) '1' ++ replicate (c - min c m) '0'
        func True (('0', c) : xs) = f c ++ func False xs
        func False (('0', c) : []) = replicate c '0'
        func False (('0', c) : xs) = replicate (c - min c m) '0' ++ replicate (min c m) '1' ++ func False xs
        func _ (('1', c) : xs) = replicate c '1' ++ func True xs
    return $ string7 result `mappend` charUtf8 '\n'
  hPutBuilder stdout output


module Main where

import Data.List (sortOn, foldl', maximumBy)
import Data.Ord (comparing)
import Data.Int (Int64)

main :: IO ()
main = interact $ solve . tail . words

solve :: [String] -> String
solve inputs = showSolution $ bestSolution solutions
  where
    postcard:envelopes = toEnvelopes 0 inputs
    sortedEnvelopes = sortOn square $ filter (`contain` postcard) envelopes
    solutions = foldl' solve0 [Solution 0 postcard []] sortedEnvelopes
    showSolution s = unlines [ show $ len s, unwords . map show . reverse . path $ s]

bestSolution :: [Solution] -> Solution
bestSolution = maximumBy (comparing len)

solve0 :: [Solution] -> Enverlope -> [Solution]
solve0 solutions envelop = case filter (contain envelop . env) solutions of
  [] -> solutions
  ss -> let Solution l _ p = bestSolution ss in Solution (l + 1) envelop (ei envelop:p):solutions

contain :: Enverlope -> Enverlope -> Bool
contain (Enverlope w1 h1 _) (Enverlope w2 h2 _) = w2 < w1 && h2 < h1

square :: Enverlope -> Int64
square (Enverlope w h _) = w * h

toEnvelopes :: Int -> [String] -> [Enverlope]
toEnvelopes _ [] = []
toEnvelopes i (w:h:rest) = Enverlope (read w) (read h) i : toEnvelopes (i + 1) rest

data Solution = Solution {
  len :: !Int,
  env :: Enverlope,
  path :: [Int]
} deriving (Show)

data Enverlope = Enverlope {
    ew :: !Int64,
    eh :: !Int64,
    ei :: !Int
  } deriving (Show, Eq, Ord)

import Data.List
import Data.Array.Unboxed
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd . foldl' folder (maxl, []) $ reverse ls
      where folder (curl, acc) (lvl, i) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
import Data.Array
import Control.Monad
import List
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

solve::[Int]->[Int]->[Int]->[(Int,(Int,Int),[Int])]->[Int]
solve [] _ _ ps = tail chain where (_,_,chain) = head  ps
solve (w:ws) (h:hs) (n:ns) ps = solve  ws hs ns $ (x+1,(w,h),n:chain):ps where
	(x,_,chain) = maximum $ (0,0,[]):[(y,head c,c) | (y,(w',h'),c) <- ps, w'>w && h'>h]

main = reader >>= writer .  solver
reader = getContents
writer = putStr
solver = runRead $ do
	n <- readm
	w <- readm
	h <- readm
	sizes <- mapM (\i-> (liftM3 (,,) readm readm (return i))) [1..n]
	let (ws,hs,ns)::([Int],[Int],[Int]) = unzip3 . sort $ sizes
	let solution = solve (reverse $ w:ws) (reverse $ h:hs) (reverse $ 0:ns) []
	return (show (length solution) ++ "\n" ++ (unwords . map show $ solution))
	--return (unlines . map unwords $ map (map show) [ws,hs,ns])

module Main where

import Control.Monad

pickBestChain chain =
    foldr (\(j, _, _, curr, currChain) (best, bestChain) ->
            if curr > best
                then (curr, currChain)
                else (best, bestChain)
        ) (0, []) chain

main = do
    [n, w0, h0] <- ( map read . words ) `liftM` getLine :: IO [Int]

    envs <- liftM (filter (\(_, w, h) -> w > w0 && h > h0)) $ forM [1..n] $ \i -> do
        [w, h] <- (map read . words ) `liftM` getLine
        return (i, w, h)

    --putStrLn $ show envs

    let chain = map (\(i, w, h) ->
                let (best, bestChain) = pickBestChain $ filter (\(_, w1, h1, _, _) -> w < w1 && h < h1) chain
                in (i, w, h, best+1, i:bestChain)
            ) envs
        (best, bestChain) = pickBestChain chain

    --putStrLn $ show chain
    putStrLn $ show best
    putStrLn $ unwords $ map show bestChain

import Data.List
import Data.Array.Unboxed
import Data.Function (on)
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.ST as ST
import qualified Data.Array.Unboxed as U
import Data.STRef

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))

    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat 2147483647) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd . foldr folder (maxl, []) $ ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array.Unboxed
import Data.Function (on)
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.ST as ST
import qualified Data.Array.Unboxed as U
import Data.STRef

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))

    {-
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat 2147483647) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2
    -}

    mainSALF envs = runST $ do
      arr <- ST.thaw (U.listArray (0, n) (repeat 2147483647) :: U.UArray Int Int) :: ST st (ST.STUArray st Int Int)

      let bs v ans l r
            | l > r = return ans
            | otherwise = do
              let m = (l + r) `div` 2
              mVal <- ST.readArray arr m
              if mVal >= v then bs v m l (m-1) else bs v ans (m+1) r

      maxl <- newSTRef (0 :: Int)
      ls <- forM envs $ \(_, h, i) -> do
             maxl' <- readSTRef maxl
             idx <- bs h 1 1 (maxl' + 1)
             ST.writeArray arr idx h
             modifySTRef maxl (max idx)
             return (idx, i)

      maxl' <- readSTRef maxl
      return ((0, maxl'), ls)

    printShit ((_, maxl), ls) = snd . foldr folder (maxl, []) $ ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w >= w0 && h >= h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat $ 10 ^ 9), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m > h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array hiding (indices)
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, h0, w0] : xs) =
  indices . foldl' folder initArr . majiqSort . bigEnough . pairIndex $ xs
  where
    pairIndex = zipWith (\i [h, w] -> (h, w, i)) [1..]
    bigEnough = filter (\(h, w, _) -> h > h0 && w > w0)
    majiqSort = sortBy (compare `on` (\(h, w, _) -> (h, -w)))
    indices = reverse . takeWhile (/= -1) . map snd . elems

    initArr = listArray (1, n) (repeat (10 ^ 8, -1)) :: Array Int (Int, Int)
    folder arr (_, w, i) = arr // [(bSearch 1 1 n, (w, i))]
      where bSearch ans l r
              | l > r = ans
              | fst (arr ! m) >= w = bSearch m l (m - 1)
              | otherwise = bSearch ans (m + 1) r
              where m = (l + r) `div` 2

main :: IO ()
main = do
  input <- getContents
  let ans = solve . map (map read . words) . lines $ input
  print $ length ans
  putStrLn $ unwords (map show ans)

import Data.List
import Data.Array hiding (indices)
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, h0, w0] : xs) =
  indices . foldl' folder initArr . majiqSort . bigEnough . pairIndex $ xs
  where
    pairIndex = zipWith (\i [h, w] -> (h, w, i)) [1..]
    bigEnough = filter (\(h, w, _) -> h > h0 && w > w0)
    majiqSort = sortBy (compare `on` (\(h, w, _) -> (h, -w)))
    indices = takeWhile (/= -1) . map snd . elems

    initArr = listArray (1, n) (repeat (10 ^ 8, -1)) :: Array Int (Int, Int)
    folder arr (_, w, i) = arr // [(bSearch 1 1 n, (w, i))]
      where bSearch ans l r
              | l > r = ans
              | fst (arr ! m) >= w = bSearch m l (m - 1)
              | otherwise = bSearch ans (m + 1) r
              where m = (l + r) `div` 2

main :: IO ()
main = do
  input <- getContents
  let ans = solve . map (map read . words) . lines $ input
  print $ length ans
  putStrLn $ unwords (map show ans)

import Data.List
import Data.Array
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w >= w0 && h >= h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

module Main where

import Data.List (sortOn, foldl', maximumBy)
import Data.Ord (comparing)

main :: IO ()
main = interact $ solve . tail . words

solve :: [String] -> String
solve inputs = showSolution $ bestSolution solutions
  where
    postcard:envelopes = toEnvelopes 0 inputs
    sortedEnvelopes = sortOn square $ filter (`contain` postcard) envelopes
    solutions = foldl' solve0 [Solution 0 postcard []] sortedEnvelopes
    showSolution s = unlines [ show $ len s, unwords . map show . reverse . path $ s]

bestSolution :: [Solution] -> Solution
bestSolution = maximumBy (comparing len)

solve0 :: [Solution] -> Enverlope -> [Solution]
solve0 solutions envelop = case filter (contain envelop . env) solutions of
  [] -> solutions
  ss -> let Solution l _ p = bestSolution ss in Solution (l + 1) envelop (ei envelop:p):solutions

contain :: Enverlope -> Enverlope -> Bool
contain (Enverlope w1 h1 _) (Enverlope w2 h2 _) = w2 < w1 && h2 < h1

square :: Enverlope -> Int
square (Enverlope w h _) = w * h

toEnvelopes :: Int -> [String] -> [Enverlope]
toEnvelopes _ [] = []
toEnvelopes i (w:h:rest) = Enverlope (read w) (read h) i : toEnvelopes (i + 1) rest

data Solution = Solution {
  len :: !Int,
  env :: Enverlope,
  path :: [Int]
} deriving (Show)

data Enverlope = Enverlope {
    ew :: !Int,
    eh :: !Int,
    ei :: !Int
  } deriving (Show, Eq, Ord)


import System.IO
import Control.Monad
import qualified Data.Map as M
import Data.Array

-- LOGIC
getResults input requests = processRequests l requests tree where (tree, l) = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result' : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r <= x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r
middle l r = (r - l) `div` 2 + l

showTree (Leaf v) = show v
showTree (Tree v left right) = showTree left  ++ " + " ++ showTree right ++ " -> " ++ show v

buildTree input add return empty = (buildTree' 1 length', length')
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = middle lb rb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | rb <= m    = queryTree left   clb    m   lb rb add
    | m <  lb    = queryTree right (m + 1) crb lb rb add
    | otherwise  = add
                       (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = middle clb crb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

{-# LANGUAGE TupleSections #-}

import Control.Monad
import Data.List
import qualified Data.Map as M
import qualified Data.Sequence as S

input :: Read a => IO [a]
input = map read <$> words <$> getLine

output :: Show a => [a] -> IO ()
output = putStrLn <$> unwords <$> map show

step :: (Int, [(Int,Int)]) -> Int -> (Int, [(Int,Int)])
step (d, xcs) d2 = (d2, zipWith f xcs (drop d xcs)) where
  f (x1,c1) (x2,c2) = (x,c) where
    x = (x1 + x2) `mod` 10
    c = c1 + c2 + (if x1 + x2 >= 10 then 1 else 0)

makedb n s = M.fromList [(d, S.fromList db') | (d,db') <- scanl' step s0 powers] where
  powers = takeWhile (<= n) $ map (2^) [1..]
  s0 = (1, map (,0) s)

main = do
  [n] <- input
  s <- input :: IO [Int]
  let db = makedb n s
  [q] <- input
  replicateM_ q $ do
    [l,r] <- input :: IO [Int]
    let Just db' = M.lookup (r-l+1) db
    let Just (_,c) = S.lookup (l-1) db'
    print c

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
getResults :: (Array Int Int) -> [(Int, Int)] -> [Int]
getResults input requests = processRequests (length input) requests tree where tree = buildTree input candies asCandy 0

processRequests :: Int -> [(Int, Int)] -> Tree (Int, Int) -> [Int]
processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result : processRequests length rs tree
    where (_, result) = queryTree tree 1 length l r candies

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r < x then myLog' (r*2) else r

asCandy :: Int -> (Int, Int)
asCandy v = (v, 0)
candies (lv, lr) (rv, rr) = (s `mod` 10,  s `div` 10 + lr + rr) where s = lv + rv

buildTree :: (Array Int a) -> (b -> b -> b) -> (a -> b) -> a -> Tree b
buildTree input add return empty = buildTree' 1 length'
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb ((rb - lb) `div` 2 + lb)
                right = buildTree' ((rb - lb) `div` 2 + lb + 1) rb

queryTree :: Tree a -> Int -> Int -> Int -> Int -> (a -> a -> a) -> a
queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | m <  lb    = queryTree right (m+1) crb lb rb add
    | rb <= m    = queryTree left   clb  m   lb rb add
    | otherwise  = add (queryTree left clb m lb m add) (queryTree right (m + 1) crb (m + 1) rb add)
    where m = (crb - clb) `div` 2 + clb
queryTree tree clb crb lb rb _ = nodeValue tree

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
valuePrice :: Int -> Int -> (Int, Int)
valuePrice l r = (sum `mod` 10, sum `div` 10) where sum = l + r

--buildTree :: M.Map (Int, Int) (Int, Int) -> Int -> Int -> Int -> [Int] -> (M.Map (Int, Int) (Int, Int), (Int, Int))
buildTree c _ _ 1  _ = (c, (0, 0))
buildTree c l _ 2  s = (c, valuePrice (s!l) (s!(l+1)))
buildTree c lb rb l s =
    (c'', (v, p + pl + pr))
    where l' = l `div` 2
          (c' , (vl, pl)) = buildTreeCaching c  lb (rb - l') l' s
          (c'', (vr, pr)) = buildTreeCaching c' (lb + l') rb l' s
          (v,  p)  = valuePrice vl vr

buildTreeCaching :: M.Map (Int, Int) (Int, Int) -> Int -> Int -> Int -> Array Int Int -> (M.Map (Int, Int) (Int, Int), (Int, Int))
buildTreeCaching c lb rb l s =
    case M.lookup (lb, rb) c of
        (Just v) -> (c, v)
        Nothing  -> (M.insert (lb, rb) r c', r) where (c', r) = buildTree c lb rb l s

getResult c lb rb l s = (c', p) where (c', (_, p)) = buildTreeCaching c lb rb l s

-- getResults :: M.Map (Int, Int) (Int, Int) -> [Int] -> [(Int, Int)] -> [Int]
getResults c ar [] = []
getResults c ar ((l, r):rs) = result : (getResults c' ar rs)
    where
        length = r - l + 1
        (c', result) = getResult c l r length ar

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int) - 1) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults M.empty (listArray (0, length s - 1) s) (reverse r)

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
getResults input requests = processRequests (length input) requests tree where tree = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result' : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r < x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r

buildTree input add return empty = buildTree' 1 length'
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = (rb - lb) `div` 2 + lb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | m <  lb    = queryTree right (m+1) crb lb rb add
    | rb <= m    = queryTree left   clb  m   lb rb add
    | otherwise  = add (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = (crb - clb) `div` 2 + clb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

import System.IO
import Control.Monad
import qualified Data.Map as M
import Data.Array

-- LOGIC
getResults input requests = processRequests l requests tree where (tree, l) = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r <= x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r
middle l r = (r - l) `div` 2 + l

showTree (Leaf v) = show v
showTree (Tree v left right) = showTree left  ++ " + " ++ showTree right ++ " -> " ++ show v

buildTree input add return empty = (buildTree' 1 length', length')
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = middle lb rb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | rb <= m    = queryTree left   clb    m   lb rb add
    | m <  lb    = queryTree right (m + 1) crb lb rb add
    | otherwise  = add
                       (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = middle clb crb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r


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

import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import Data.Tuple(swap)
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
l2p :: [Int] -> (Int,Int)
l2p (a:b:_) = (a,b)
l2p _ = undefined

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = liftA2 (==) (findUF x st) (findUF y st)

main :: IO ()
main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

whenM :: Monad m => m Bool -> m () -> m ()
whenM m1 m2 = m1 >>= flip when m2

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i ->
            whenM ((==i) <$> findUF i st) $ writeArray ds i (diameter i)
        let getD x = findUF x st >>= readArray ds
            putD x d = findUF x st >>= flip (writeArray ds) d
            go [] = return []
            go ([1,x]:_qs) = liftA2 (:) (getD x) (go _qs)
            go ([2,x,y]:_qs) = do
                whenM (not <$> sameUF x y st) $ do
                    dx <- getD x
                    dy <- getD y
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                        dz = maximum [dx,dy,rx+ry+1]
                    mergeUF x y st
                    putD x dz
                go _qs
            go _ = undefined
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter = fst . f . snd . f where
        f = uncurry dfs . (((:[]).(,-1,0)) &&& (0,))
    dfs [] acc = acc :: (Int,Int)
    dfs ((v,pv,d):st) acc = dfs ((map (,v,d+1) $ filter (/=pv) (g ! v)) ++ st) (max (d,v) acc)

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

import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter v = d where
        (_,v1) = dfs [(v,-1,0)] (0,v)
        (d,v2) = dfs [(v1,-1,0)] (0,v1)
    dfs [] acc = acc
    dfs ((v,pv,d):st) !acc = dfs st' (max (d,v) acc) where
        st' = [(v',v,d+1) | v' <- g ! v, v' /= pv ] ++ st

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

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

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

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter v = d where
        (_,v1) = dfs [(v,-1,0)] (0,v)
        (d,v2) = dfs [(v1,-1,0)] (0,v1)
    dfs [] acc = acc
    dfs ((v,pv,d):st) !acc = dfs st' (max (d,v) acc) where
        st' = [(v',v,d+1) | v' <- g ! v, v' /= pv ] ++ st

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

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

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

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter i = d2 where
        (d1,v1) = go (-1) i
        (d2,v2) = go (-1) v1
        go pv v = maximum $ [(0,v)] ++ map (go v) (filter (/=pv) (g ! v))


import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[n] <- readv
  i <- binSearch 1 n
  di <- getLen i n
  let j=i+di+1
  dj <- getLen j n
  let k=j+dj
  putStr "! "
  printv [i,j,k]

query :: Int -> Int -> IO Integer
query lo hi = do
  putStrLn $ "? " ++ show lo ++ " " ++ show hi
  ~[ans] <- readv
  return ans

binSearch :: Int -> Int -> IO Int
binSearch lo hi
  | lo+1 == hi = return lo
  | otherwise = do
    let mid = lo + (hi - lo) `div` 2
    inv <- query lo mid
    if inv > 0 then binSearch lo mid else binSearch mid hi

getLen :: Int -> Int -> IO Int
getLen lo hi = do
  inv1 <- query lo hi
  inv2 <- query (lo+1) hi
  return $ fromIntegral $ inv1 - inv2

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[n] <- readv
  i <- binSearch 1 n
  di <- getLen i n
  let j=i+di+1
  dj <- getLen j n
  let k=j+dj
  putStr "! "
  printv [i,j,k]
  hFlush stdout

query :: Int -> Int -> IO Integer
query lo hi = do
  putStrLn $ "? " ++ show lo ++ " " ++ show hi
  hFlush stdout
  ~[ans] <- readv
  return ans

binSearch :: Int -> Int -> IO Int
binSearch lo hi
  | lo+1 == hi = return lo
  | otherwise = do
    let mid = lo + (hi - lo) `div` 2
    inv <- query lo mid
    if inv > 0 then binSearch lo mid else binSearch mid hi

getLen :: Int -> Int -> IO Int
getLen lo hi = do
  inv1 <- query lo hi
  inv2 <- query (lo+1) hi
  return $ fromIntegral $ inv1 - inv2

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve


#!/usr/bin/env runghc
import Data.List
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c1:c2:cs) = (:solve cs)$ intercalate "\n" [show . length $ s,unwords . map show $ s]
  where
    a = map (read::String->Int) . words $ c2
    (l,r) = foldl f ([],[]) . group . sort $ a
    l' = if null l || head l /= head r then l else tail l
    s = reverse l'++r
f (l,r) (n:ns)
  | null ns   = (  l,n:r)
  | otherwise = (n:l,n:r)

import Data.List
main = getContents >>= putStrLn . f . map (take 2) . group . sort . map read . tail . words
f :: [[Int]] -> [Char]
f x = unlines [show (length y), unwords (map show y)]
  where y = map head x ++ (reverse . concatMap tail . init) x

import Data.List
main = do
	n <- read `fmap` getLine ::IO Int
	as <- map read `fmap` words `fmap` getLine::IO [Int]
	let (u,v) = solution as in do
		print $ length u + length v
		putStrLn $ (write $ reverse u) ++ " " ++ write v
	where
		write = unwords . map show
		solution as = case snd $ foldl' walk ((-1, False),([], [])) $ sort as of
			((u:us),(v:vs)) | u == v -> ((u:us),vs)
			t 						 -> t
		walk ((prev, rep), (us,vs)) a | prev /= a = ((a,False),(a:us,vs))
									| rep 		= ((a,True) ,(us,vs))
									| otherwise = ((a,True) ,(us,a:vs))

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

main = do
    getLine
    bs <- group . sort <$> readInts
    let as = makeStairs bs
    print $ length as
    putStrLn $ unwords $ map show as

makeStairs :: [[Int]] -> [Int]
makeStairs bs = go [] [] bs
    where
        go l1 l2 [(b:_)] = reverse l1 ++ b : l2
        go l1 l2 ([b]:bs) = go (b:l1) l2 bs
        go l1 l2 ((b:_):bs) = go (b:l1) (b:l2) bs

import Data.List
import Data.Array

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]

    let (part1, part2) = foldr (\cur (p1, p2) -> if p1 /= [] && head p1 == cur
        then if p2 /= [] && head p2 == cur
            then (p1, p2)
            else (p1, cur : p2)
        else (cur : p1, p2) ) ([], []) li

    let final = part1 ++ reverse (if part1 /= [] && part2 /= [] && last part1 == last part2 then init part2 else part2)

    print $ length final
    putStrLn $ concatMap (\x -> show x ++ " ") final

import Data.List (group, sort)
import Control.Arrow ((&&&))

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

solve :: [Int] -> [Int]
solve = map head . group . uncurry (++) . (map head &&& map head . filter (not . null) . map tail . reverse) . group . sort

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

import Data.List (group, sort)
import Control.Arrow ((&&&))

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

solve :: [Int] -> [Int]
solve = uncurry (++) . (map head &&& concatMap (tail . take 2) . tail . reverse) . group . sort

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

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

main = replicateM 2 getLine >>= answer . solve . parse

parse :: [String] -> (Int, [[Int]])
parse [i, nums] = (read i, group . sort . map read $ words nums)

solve :: (Int, [[Int]]) -> [Int]
solve (_, []) = []
solve (i, nums)
      | i == length nums = reverse . map head $ nums
      | otherwise = (s nums) ++ (s . filter (not . null) . map tail . tail $ reverse nums)
      where
        s :: [[Int]] -> [Int]
        s = map head

answer :: [Int] -> IO ()
answer result = (print $ length result)
             >> (putStrLn $ unwords $ map show result)

import Data.List
main = do
	n <- read `fmap` getLine ::IO Int
	as <- map read `fmap` words `fmap` getLine::IO [Int]
	let (u,v) = solution as in do
		print $ length u + length v
		putStrLn $ (write $ reverse u) ++ " " ++ write v
	where
		write = unwords . map show
		solution as = case snd $ foldl' walk ((-1, False),([], [])) as of
			((u:us),(v:vs)) | u == v -> ((u:us),vs)
			t 						 -> t
		walk ((prev, rep), (us,vs)) a | prev /= a = ((a,False),(a:us,vs))
									| rep 		= ((a,True) ,(us,vs))
									| otherwise = ((a,True) ,(us,a:vs))

import Data.List
import Data.Array

uni :: (Eq t) => [t] -> [t]
uni [] = []
uni (x:[]) = [x]
uni (x0:x1:xs)
    | x0 == x1 = uni $ x1 : xs
    | otherwise = x0 : (uni $ x1 : xs)

plainPrint :: (Show t) => [t] -> IO ()
plainPrint = putStrLn . tail . concatMap (\x -> ' ' : show x)

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]
    let uli = uni $ li
    let rest = reverse $ uni $ li \\ (uli ++ [last uli])
    print $ length uli + length rest
    plainPrint $ uli ++ rest

import Data.List
import Data.Array

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]

    let (part1, part2) = foldr (\cur (p1, p2) -> if p1 /= [] && head p1 == cur
        then if p2 /= [] && head p2 == cur
            then (p1, p2)
            else (p1, cur : p2)
        else (cur : p1, p2) ) ([], []) li

    putStrLn $ concatMap (\x -> show x ++ " ") (part1 ++ reverse (if part1 /= [] && part2 /= [] && last part1 == last part2 then init part2 else part2))

import Data.List
import Data.Array

uni :: (Eq t) => [t] -> [t]
uni [] = []
uni (x:[]) = [x]
uni (x0:x1:xs)
    | x0 == x1 = uni $ x1 : xs
    | otherwise = x0 : (uni $ x1 : xs)

plainPrint :: (Show t) => [t] -> IO ()
plainPrint = putStrLn . tail . concatMap (\x -> ' ' : show x)

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]
    let uli = uni $ li
    let rest = reverse $ uni $ li \\ (uli ++ [last uli])
    plainPrint $ uli ++ rest

import Data.List (group)
import Control.Arrow ((&&&))

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

solve :: [Int] -> [Int]
solve = map head . group . uncurry (++) . (map head &&& map head . filter (not . null) . map tail . reverse) . group

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

#!/usr/bin/env runghc
import Data.List
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c1:c2:cs) = (:solve cs)$ intercalate "\n" [show . length $ s,unwords . map show $ s]
  where
    a = map (read::String->Int) . words $ c2
    (l,r) = foldl f ([],[]) . group . sort $ a
    s = reverse l++r
f (l,r) (n:ns)
  | null ns   = (  l,n:r)
  | otherwise = (n:l,n:r)


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

gao a = if n >= d then "LIVE" else "DEAD"
  where
    (n:d:_) = map sum $ transpose $ map (map read . tail) a

main = do
  n <- fmap read getLine
  a <- replicateM n $ fmap words getLine
  putStrLn $ gao $ filter ((=="1") . head) a
  putStrLn $ gao $ filter ((=="2") . head) a

import Control.Monad (liftM)

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: [(Int, Int, Int)] -> (Bool, Bool)
solve qs  =  (a, b)
  where
    a  =  live 1
    b  =  live 2
    live t  =  sum (map (\(_, a, _) -> a) qs') >= sum (map (\(_, _, b) -> b) qs')
      where
        qs'  =  filter (\(n, _, _) -> n == t) qs

parseQ :: String -> (Int, Int, Int)
parseQ line  =  case map read (words line) of
    [n, a, b]  ->  (n, a, b)

main :: IO ()
main  =  do
    n   <-  readLn
    qs  <-  mapM (\i -> liftM parseQ getLine) [1..n]
    let (a, b)  =  solve qs
    putStrLn $ "LIVE" <?> "DEAD" $ a
    putStrLn $ "LIVE" <?> "DEAD" $ b

main=interact$f 0 0 0 0.map read.tail.words
f a b totala totalb (1:x:_:rest) = f (a+x) b (totala+10) totalb rest
f a b totala totalb (_:x:_:rest) = f a (b+x) totala (totalb+10) rest
f a b totala totalb [] = g a totala ++g b totalb
g x totalx|x+x>=totalx ="LIVE\n"|0<1="DEAD\n"

import Data.List
import Control.Monad

main :: IO()
main = do
         num <- fmap read getLine
         input <- forM [1..num] (\x -> fmap (map read. words) getLine)
         let a = sum [ y | [x,y,z] <- input , x == 1]
         let b = sum [ y | [x,y,z] <- input, x == 2]
         let c = length [ y | [x,y,z] <-input, x == 1]
         let d = length [ y | [x,y,z] <- input, x == 2]

         if a >= (c*5)  then putStrLn "LIVE" else putStrLn "DEAD"
         if b >= (d*5)  then putStrLn "LIVE" else putStrLn "DEAD"

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

process1 a b c d [] = x1 ++ x2
	where 	x1 =  if a>=b  then ["LIVE"] else ["DEAD"]
		x2 =  if c>=d  then ["LIVE"] else ["DEAD"]

process1 a b c d ([x,y,z]:zs) | x==1 = process1 (a+y) (b+z) c d zs
                              | otherwise = process1 a b (c+y) (d+z) zs

main = do
		c<-read <$> getLine ::IO Int
		x<-map (map read. words) <$> replicateM c getLine ::IO [[Int]]
		mapM_ putStrLn $ process1 0 0 0 0 x

isAlive :: Int -> [[Int]] -> Bool
isAlive t txys = sx >= sy
    where
        (sx,sy) = foldr f (0,0) txys
        f [t',x',y'] p@(sx',sy')
            | t' == t = ((x'+sx'),(y'+sy'))
            | otherwise = p

isAliveAll :: Int -> [[Int]] -> [Bool]
isAliveAll n txys = map (\t -> isAlive t txys) [1..n]

readInt :: String -> Int
readInt = read

showBool :: Bool -> String
showBool False = "DEAD"
showBool True = "LIVE"

main = do
    n <- fmap readInt getLine
    s <- fmap (map (map readInt.words).lines) getContents
    putStrLn.unlines.map showBool $ isAliveAll 2 s

main=interact$f False False . map read.tail.words
f a b (1:x:_:rest)
  | x>=5 = f True b rest
  | otherwise = f a b rest
f a b (_:x:_:rest)
  | x>=5 = f a True rest
  | otherwise = f a b rest
f a b [] = g a++g b
g True = "LIVE\n"
g _ = "DEAD\n"


import qualified Control.Monad as CM

solve :: IO ()
solve = do
  ~[x,y] <- readv
  printv [x^2, -y^2]

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve

import Control.Arrow ((>>>))

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

solve :: [Integer] -> [Integer]
solve [u, v] = [u^2, -v^2]

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [u, v] = map read $ words input
        (x, y) = findXY (u, v)
        output = unwords $ map show [x, y]

findXY :: (Integer, Integer) -> (Integer, Integer)
findXY (u, v) = (u ^ 2, -v ^ 2)


--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n,c], as] <- replicateM 2 ri
        return (c,as)
    mapM_ (putStrLn.show.solve) tcs

solve (c,as) = sum . map (min c . length) . L.group . L.sort $ as

import Control.Arrow ((>>>))
import Data.List (group, sort)

(>$>) = flip ($)
infixl 0 >$>

main :: IO ()
main = interact $ lines >>> tail >>> map (words >>> map read) >>> chunksOf 2 >>> map (solve >>> show) >>> unlines

solve :: [[Int]] -> Int
solve [[n, c], xs] = xs >$> sort >>> group >>> map (length >>> min c) >>> sum

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

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, c] -> map read . words <$> getLine >>= print . minCost n c

minCost :: Int -> Int -> [Int] -> Int
minCost n c as = let am = countF as
                     f acc (_, count) = acc + min count c
                 in
                   foldl f 0 am

-- max input is 100
countF :: [Int] -> [(Int, Int)]
countF as = let a = listArray (1, 100) [0, 0 ..]
                f a e = a//[(e, 1+a!e)]
            in
              assocs $ foldl f a as


{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
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 qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> [Int] -> Int
solve n as = digitPairsCount * 6
    where
        digitPairsCount = digitsCount * (digitsCount - 1) `div` 2
        digitsCount = (10 - L.length as)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer

import Data.Char

every2nd (x:y:xs) = x:(every2nd xs)
every2nd _ = []

solve k = max (k*(k-1)*3) 0

main = do
  rawInput <- getContents
  let input = tail . lines $ rawInput
  let ns = every2nd input
  let ans = map (solve . (10-) .  read)  ns
  mapM_ print ans

import Data.Char

every2nd (x:y:xs) = x:(every2nd xs)
every2nd _ = []

solve k = max (k*(k-1)*3) 0

main = do
  rawInput <- getContents
  let input = tail . lines $ rawInput
  let ns = every2nd input
  let ans = map (solve . (10-) .  read)  ns
  print(ans)


module Main where

import Data.List
import Data.Maybe

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep [] = []
sep (x:xs) = h:(sep t)
  where (h,t) = splitAt (read $ head $ words x) xs

parse :: [String] -> [[Int]]
parse = map (map fromEnum)

format = show

solve xs = minimum $ map distance $ pairs xs
  where pairs [] = []
        pairs (y:ys) = [(y,z) | z <- ys] ++ pairs ys
        distance (y,z) = sum $ map (abs . uncurry (-)) $ zip y z

import Data.List
import Data.Char
import Data.Array
import Control.Monad

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve number 0 = return ()
solve number current = do
	line <- getLine
	let ws = words line
	let n = (read . head) ws :: Int
	let m = (read . head . tail) ws :: Int
	ls <- replicateM n getLine
	putStrLn $ (show . minimum) $ lejat ls
	solve number (current - 1)

lejat :: [String] -> [Int]
lejat ss = do
		let kezya = zip ss [1..]
		(a, b) <- kezya
		(c, d) <- kezya
		True <- return $ b /= d
		return $ sosat a c

sosat :: String -> String -> Int
sosat left right = sum $ zipWith (\a -> \b -> abs $ (fromEnum a) - (fromEnum b)) left right

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

sol :: [String] -> Int
sol xs = minimum [f x y | (x, i) <- ps, (y, j) <- ps, i /= j]
  where
    f xs' ys' = sum (zipWith (\x y -> abs (ord x - ord y)) xs' ys')
    ps = zip xs [1 .. length xs]

readCase :: IO [String]
readCase = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  replicateM n getLine

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  cases <- replicateM t readCase
  putStrLn $ intercalate "\n" (map (show . sol) cases)

import Control.Monad (replicateM_, replicateM)

letterDiff :: Char -> Char -> Int
letterDiff c1 c2 = abs (fromEnum c1 - fromEnum c2)

wordDiff :: String -> String -> Int
wordDiff w1 w2 = sum $ zipWith letterDiff w1 w2

solve :: [String] -> [[Int]]
solve [] = []
solve (x:xs) = (map (wordDiff x) xs) : solve xs

main = do
  t <- readLn :: IO Int
  replicateM_ t $ do
    l <- getLine
    let [n, m] = (map read . words) l :: [Int]
    words <- replicateM n getLine
    print $ minimum $ concat $ drop 1 $ reverse $ solve words

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

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = map read . words <$> getLine >>=
             \([n, m]) -> replicateM n getLine >>=
             print . findmin (maxBound :: Int)

charDiff :: Char -> Char -> Int
charDiff c1 c2 = abs $ (ord c1) - (ord c2)

strDiff :: String -> String -> Int
strDiff s1 s2 = foldl (\acc (c1, c2)-> acc + charDiff c1 c2) 0 $ zip s1 s2

findmin :: Int -> [String] -> Int
findmin m [] = m
findmin m (x:xs) = let m1 = foldl (\a s -> min a (strDiff x s)) m xs in
                     findmin m1 xs

import Data.Char (ord)

distC :: Char -> Char -> Int
distC a b = abs $ ord a - ord b

dist :: String -> String -> Int
dist [] [] = 0
dist (x: xs) (y: ys) = distC x y + dist xs ys

readStr :: Int -> IO [String]
readStr 0 = pure []
readStr i = do
  s <- getLine
  ans <- readStr $ i - 1
  pure (s: ans)

calcH :: String -> [String] -> Int
calcH _ [] = 100000000
calcH s (x: xs) = min (dist s x) (calcH s xs)

calc :: [String] -> Int
calc [] = 100000000
calc (x: xs) = min (calcH x xs) (calc xs)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: _) <- map (\s -> read s :: Int) <$> (words <$> getLine)
  arr <- readStr n
  print $ calc arr
  for $ i - 1

main = do
  t <- readLn :: IO Int
  for t

import Data.List
import Data.Char
import Data.Array
import Control.Monad

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve number 0 = return ()
solve number current = do
	line <- getLine
	let ws = words line
	let n = (read . head) ws :: Int
	let m = (read . head . tail) ws :: Int
	ls <- replicateM n getLine
	let vars = lejat ls
	if length vars == 0 then putStrLn "0"
	else putStrLn $ (show . minimum) $ vars
	solve number (current - 1)

lejat :: [String] -> [Int]
lejat ss = do
		firstVar <- ss
		secondVar <- ss
		True <- return $ firstVar /= secondVar
		return $ sosat firstVar secondVar

sosat :: String -> String -> Int
sosat left right = sum $ zipWith (\a -> \b -> abs $ (fromEnum a) - (fromEnum b)) left right

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

sol :: [String] -> Int
sol xs = minimum [abs (x - y) | (x, i) <- ps, (y, j) <- ps, i /= j]
  where
    conv = foldl' (\acc x -> acc + ord x) 0
    ps = zip (map conv xs) [1 .. (length xs)]

readCase :: IO [String]
readCase = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  replicateM n getLine

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  cases <- replicateM t readCase
  putStrLn $ intercalate "\n" (map (show . sol) cases)


-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]
-- }}}

row :: Int -> [Int]
row 1 = [1]
row 2 = [3,4]
row 3 = [3,4,12]
row m = (m-2) : replicate (m-1) 2

table :: Int -> Int -> [[Int]]
table n m = [[x*y | y <- row m] | x <- row n]

main :: IO ()
main = do
	[n,m] <- inputInts
	let t = table n m in forM_ t $ \r -> putStrLn $ unwords (map show r)

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')*(sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')*(sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product $ fmap (\i -> i * i) sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product $ fmap (\i -> i * i) sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')*(sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')*(sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""


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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array.Base

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

main :: IO ()
main = do
  xs <- scanl1(+).f <$> getLine
  let arr = listArray (0,length xs-1) xs
  _ <- getLine
  lrs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show$solve arr lrs

solve :: UArray Int Int -> [Int] -> [Int]
solve arr lrs = go lrs
   where
     go (l:r:rest)
       | l==1 = unsafeAt arr (r-2) : go rest
       | otherwise = unsafeAt arr (r-2) - unsafeAt arr (l-2) : go rest
     go _ = []

f (x:y:z)
  | x==y = 1 : f (y:z)
  | otherwise = 0 : f (y:z)
f _ = []

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

solve :: String -> [(Int, Int)] -> [Int]
solve s qs  =  map solve' qs
  where
    n  =  length s
    solve' (l, r)  =  a ! r - a ! l
    a  =  listArray (1,n) $ scanl (+) 0 $ zipWith eqToInt s $ tail s
    eqToInt a b  =  if a == b then 1 else 0

main :: IO ()
main  =  do
    s  <-  getLine
    n  <-  readLn
    qs  <-  replicateM n readPair
    mapM_ print $ solve s qs

  where

    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

    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' (10 * a + fromIntegral (ord c - ord '0')) s

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

import Data.Array.Unboxed ((!), Array, listArray)

main :: IO ()
main = getLine >>= \s -> getContents >>= mapM_ print . solve s . map (map read . words) . tail . lines

solve :: String -> [[Int]] -> [Int]
solve s lrs = [ dp ! r - dp ! l | [ l, r ] <- lrs ]
  where dp :: Array Int Int
        dp = listArray (1, length s) $ scanl (+) 0 $ zipWith (\x y -> fromEnum (x == y)) s $ tail s

import qualified Data.IntMap as Map
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Array

cons :: BS.ByteString -> Array Int Int
cons s  = (extract . BS.foldl' f (1,' ',0,[])) s
  where
    extract (_,_,_,m) = array (1, fromIntegral $ BS.length s) m
    f (idx, before, count,m) c
      | before == c = (idx+1, c, count+1, (idx, count + 1): m)
      | otherwise = (idx + 1, c, count, (idx, count): m)

main :: IO ()
main = do
  (s:_:rest) <- liftM BS.lines BS.getContents
  let m = cons s
  mapM_ (print . rush m . readTuple) rest

readTuple :: BS.ByteString -> (Int, Int)
readTuple s = let (a, aRest) = fromJust $ BS.readInt s
                  rest = BS.dropWhile (== ' ') aRest
                  (b, _) = fromJust $ BS.readInt rest in (a,b)

rush :: Array Int Int -> (Int, Int) -> Int
rush m (l, r) = m!r - m!l

import Data.Array.Unboxed ((!), Array, listArray)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

main :: IO ()
main = B.getLine >>= \s -> B.getContents >>= mapM_ print . solve s . map (map (fst . fromJust . B.readInt) . B.words) . tail . B.lines

solve :: B.ByteString -> [[Int]] -> [Int]
solve s lrs = [ dp ! r - dp ! l | [ l, r ] <- lrs ]
  where dp :: Array Int Int
        dp = listArray (1, B.length s) $ scanl (+) 0 $ B.zipWith (curry (fromEnum . uncurry (==))) s $ B.tail s

import Data.Array.Unboxed
import Control.Monad
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = do
  s <- B.getLine
  let a = listArray (0,B.length s) $ scanl (+) 0 $
          B.zipWith ((fromEnum .) . (==)) s (B.tail s) :: UArray Int Int
  q <- readI <$> B.getLine
  replicateM_ q $ do
    [l,r] <- map readI . B.words <$> B.getLine
    print $ a!(r-1) - a!(l-1)

import Data.Array

getQu :: [String] -> [(Int, Int)]
getQu [] = []
getQu (sl : sr : xs) = (read sl, read sr) : (getQu xs)

getSufSum :: String -> [Int]
getSufSum [x] = [0]
getSufSum (x1 : x2 : xs) = ((if x1 == x2 then 1 else 0) + head t) : t
    where
        t = getSufSum (x2 : xs)

getAns :: Array Int Int -> (Int, Int) -> [String]
getAns sum (l, r) = [show $ (sum ! l)  - (sum ! r)]

handle :: [String] -> [[String]]
handle (s : _ : sq) = map (getAns (listArray (1, length(sum)) sum)) (getQu sq)
    where
        sum = getSufSum s

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

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

main= do
	s<-getLine
	let ls = length s
	let s1 = tail s
	let ls1 = length s1
	let ans = listArray (1,ls) $ scanl1 (+) $ [0]++ (zipWith (\a b-> if a==b then 1 else 0) s s1) ++[0]
	getLine
	q<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ intercalate "\n" $ map show$  map (\[x,y]->ans!y-ans!x) q

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

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

main :: IO ()
main = do
  s <- C.getLine
  let a = C.zipWith (\i j -> if i == j then 1 else 0) s $ C.tail s
      b :: UArray Int Int
      b = listArray (1, C.length s) $ scanl (+) 0 a
  q <- fmap (pairs . map readInt . tail . C.words) C.getContents
  putStr $ unlines $ map (\(i, j) -> show $ b!j - b!i) $ q

import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  s <- B.getLine
  let a = listArray (1, B.length s) $ scanl (+) 0 $ B.zipWith f s $ B.tail s
  B.getLine
  mapM_ (print . solve a . map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

f :: Char -> Char -> Int
f a b = fromEnum $ a == b

solve :: UArray Int Int -> [Int] -> Int
solve a [l, r] = a ! r - a ! l

import Data.Array.Unboxed

main = interact $ unlines.g.lines

f (x:[]) ans = reverse ans
f (x:y:xs) ans
  | x == y = f (y:xs) (1:ans)
  | otherwise = f (y:xs) (0:ans)

prefixsum [] sumsofar ans = reverse (sumsofar:ans)
prefixsum (x:xs) sumsofar ans = prefixsum xs (sumsofar+x) (sumsofar:ans)

query (a:b:[]) xs = (xs ! b) - (xs ! a)

g (x:y:xs) = map show (reverse (h k (trtd xs) []))
  where j = (prefixsum (f x []) 0 [])
        k = listArray (1, (length j)) j

h :: Array Int Int -> [[Int]] -> [Int] -> [Int]
h a [] ans = ans
h a (x:xs) ans = h a xs ((query x a):ans)

trtd = map (\x -> (map read (words x)) :: [Int])

import Data.Array.Unboxed
import Numeric

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

main = interact $ unlines.g.lines

f (x:[]) ans = reverse ans
f (x:y:xs) ans
  | x == y = f (y:xs) (1:ans)
  | otherwise = f (y:xs) (0:ans)

prefixsum [] sumsofar ans = reverse (sumsofar:ans)
prefixsum (x:xs) sumsofar ans = prefixsum xs (sumsofar+x) (sumsofar:ans)

query (a:b:[]) xs = (xs ! b) - (xs ! a)

g (x:y:xs) = map show (reverse (h k (trtd xs) []))
  where j = (prefixsum (f x []) 0 [])
        k = listArray (1, (length j)) j

h :: Array Int Int -> [[Int]] -> [Int] -> [Int]
h a [] ans = ans
h a (x:xs) ans = h a xs ((query x a):ans)

trtd = map (\x -> (map fastRead (words x)) :: [Int])

{-# 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
  s <- getLine

  let
    cs = listArray (1, length l) l :: UArray Int Int
      where
        l = scanl (+) 0 $ map fromEnum $ zipWith (==) s $ tail s

  m <- readLn

  qs <- replicateM m getInts

  putStrLn $ unlines $ map show $ map (\[l, r] -> cs!r - cs!l) qs

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.(\ (a1:a2:as)->a1:(take (read a2) as)). lines
solve :: [String]->String
solve (xx:xs) = unlines $ map show $ slv1 (ones2, xsnum)
  where
  ones1  = map fst $ scanl (\(b1,b2) a->if a==b2 then (b1,a) else (b1+1,a) ) (0,head xx) xx
  ones2  = array (1,length $ tail ones1) $ zip [1..length $ tail ones1] $ tail ones1
  xsnum  = map (map (read::String->Int).words) xs
slv1 (xs,yss)=[z|[y1,y2]<-yss, let z = y2-y1 - (xs!y2 -xs!y1)]

import Data.List
import Data.Maybe
import Data.Char
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.(\ (a1:a2:as)->a1:(take (read a2) as)). lines
solve :: [String]->String
solve (xx:xs) = unlines $ map show $ slv1 (ones1, xsnum)
  where
  ones1  = map fst $ scanl (\(b1,b2) a->if a==b2 then (b1,a) else (b1+1,a) ) (0,head xx) xx
  xsnum  = map (map (read::String->Int).words) xs
slv1 (xs,yss)=[z|[y1,y2]<-yss, let z = y2-y1]

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

main= do
	s<-getLine
	let s1 = tail s
	let ls1 = length s
	let ans = listArray (1,ls1) $ (zipWith (\a b-> if a==b then 1 else 0) s s1)++[0]
	print ans
	let ans2d = array ((1,1),(ls1,ls1)) $ [((i,j),(if i+1==j then ans!i else ans2d!(i+1,j)+ans!i ))| i<-[1..ls1],j<-[i+1..ls1]]
	getLine
	q<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ intercalate " " $ map show$  map (\[a,b]->ans2d!(a,b)) q


import Data.Map as M
import Data.List as L

fun :: Integer -> Integer
fun 1 = 0
fun n = (n*2 + 2*(n-2))*(div n 2) + fun (n-2)

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

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

import           Control.Arrow

main = interact $
  words >>> drop 1 >>> map (read >>> solve >>> show) >>> unlines

solve :: Integer -> Integer
solve n = 4 * (n2 * (n2 + 1) * (2*n2 + 1)) `div` 3
  where
    n2 = n `div` 2

import Control.Monad

type Test = Integer

getLines :: Int -> IO [String]
getLines count = replicateM count getLine

parseData :: [String] -> [Test]
parseData [] = []
parseData (first:rest) = (read first) : parseData rest

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = solve first : getAnswer rest

solve :: Integer -> Integer
solve 1 = 0
solve n = sideCells * middle + solve (n - 2)
    where middle = n `div` 2
          inner = (n - 2)^2
          sideCells = n^2 - inner

main :: IO ()
main = do
    count <- getLine
    tests <- getLines $ read count
    mapM_ print (getAnswer $ parseData tests)

import Control.Monad

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

routine :: IO ()
routine = do
    n <- (readLn :: IO Integer)
    let a = n `div` 2
    print $ 8 * (a * (a + 1) * (2*a + 1)) `div` 6


import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s
  | null fs = 0
  | otherwise = minimum $ map(\((a,la),(b,lb),(c,lc)) -> lb + 2 ) fs

  where
    ps = map (\x -> (head x,length x)) $ group s
    ts = zip3 ps (tail ps) (tail $ tail $ ps)
    fs = filter (\((a,la),(b,lb),(c,lc)) -> (length $ nub [a,b,c]) == 3) ts

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

prefixSum :: [Int] -> UArray Int Int
prefixSum lst = Ar.listArray (0,length lst) $ 0:go 0 lst
    where
        go aux (n:rest) = (aux+n): go (aux+n) rest

rangeQuery :: String -> Char -> Int -> Int -> Int
rangeQuery s = runner
    where
        runner ch start end
            | ch == '1' = prefix1 Ar.! end - (prefix1 Ar.! (start-1))
            | ch == '2' = prefix2 Ar.! end - (prefix2 Ar.! (start-1))
            | ch == '3' = prefix3 Ar.! end - (prefix3 Ar.! (start-1))
        charMapper c x
            | c == x    = 1
            | otherwise = 0
        prefix1 = prefixSum $ map (charMapper '1') s
        prefix2 = prefixSum $ map (charMapper '2') s
        prefix3 = prefixSum $ map (charMapper '3') s

validRange :: (Char -> Int -> Int -> Int) -> (Int, Int) -> Bool
validRange rqRunner (start, end) = validForChar '1' && validForChar '2' && validForChar '3'
    where
        validForChar c = 0 < rqRunner c start end
{-
solve :: String -> Int
solve s = minimum $ map (\(a,b) -> b-a) allValidRanges
    where
        rqRunner = rangeQuery s
        allPossibleRanges = (1,length s) : possibleRanges '1' ++ possibleRanges '2' ++ possibleRanges '3'
        allValidRanges = filter (validRange rqRunner) allPossibleRanges
        possibleRanges c = zip ind $ map pred $ tail ind
            where
                ind = map fst $ filter (\(i,x) -> x == c) $ zip [1..] s
-}

scan :: UArray Int Char -> (Int, Int) -> (Int, Int, Int) -> Int
scan arr (start, end) cnt@(cnt1, cnt2, cnt3)
    | valid cnt = min (cnt1+cnt2+cnt3) $ scan arr (start+1, end) $ sub1 (arr Ar.! start) cnt
    | otherwise = if finished then 5000000 else scan arr (start, end+1) $ add1 (arr Ar.! (end+1)) cnt
    where
        finished = end == snd (Ar.bounds arr)
        valid (cnt1, cnt2, cnt3) = cnt1 > 0 && cnt2 >0 && cnt3 > 0
        add n '1' (cnt1, cnt2, cnt3) = (cnt1+n, cnt2, cnt3)
        add n '2' (cnt1, cnt2, cnt3) = (cnt1, cnt2+n, cnt3)
        add n '3' (cnt1, cnt2, cnt3) = (cnt1, cnt2, cnt3+n)
        add1 = add 1
        sub1 = add (-1)

solve :: String -> Int
solve s =
    case scan (Ar.listArray (1,length s) s) (1,1) init of
        5000000 -> 0
        ans -> ans
    where
        init =
            case s of
                '1':_ -> (1,0,0)
                '2':_ -> (0,1,0)
                '3':_ -> (0,0,1)

test :: String -> Int
test s = scan (Ar.listArray (1,length s) s) (1,1) init
    where
        init =
            case s of
                '1':_ -> (1,0,0)
                '2':_ -> (0,1,0)
                '3':_ -> (0,0,1)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

minSize :: String -> (Int, Int, Int, Int)
minSize "" = (10000000, 10000000, 10000000, 10000000)
minSize (c:rest) =
    case c of
        '1' -> (0, f2+1, f3+1, min ans (2 + max f2 f3))
        '2' -> (f1+1, 0, f3+1, min ans (2 + max f1 f3))
        '3' -> (f1+1, f2+1, 0, min ans (2 + max f1 f2))
    where
        (f1,f2,f3, ans) = minSize rest

solve :: String -> Int
solve s
    | ans > 1000000 = 0
    | otherwise     = ans
    where
        (_,_,_,ans) = minSize s

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import Data.List (group)
main = interact $ unlines . map f . tail . lines

f x = show $ ans
  where g = map (\x -> (head x, length x)) (group x)
        inp = zip3 g (tail g) (tail (tail g))
        h = map (\((i, x), (j, y), (k, z)) -> if i == k then 0 else y+2) inp
        h1 = filter (/= 0) h
        ans = if (h1==[]) then 0 else minimum h1

import Data.List

inf = 300000

solve' :: (Int, Int, Int) -> String -> Int
solve' _ [] = inf
solve' cum (x:xs) = min (score u) nxt
    where nxt = solve' u xs
          u = upd cum x

score :: (Int, Int, Int) -> Int
score (a, b, c) = 1 + (maximum [a, b, c])

upd :: (Int, Int, Int) -> Char -> (Int, Int, Int)
upd (_, l2, l3) '1' = (0, l2 + 1, l3 + 1)
upd (l1, _, l3) '2' = (l1 + 1, 0, l3 + 1)
upd (l1, l2, _) '3' = (l1 + 1, l2 + 1, 0)

main :: IO ()
main = interact solve
    where solve = (intercalate "\n")
                  . (map show)
                  . (map $ \x -> if x >= inf then 0 else x)
                  . (map (solve' (inf, inf, inf)))
                  . (drop 1) . words

import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    replicateM_ n routine

routine = do
    s <- getLine
    print $ solve s

solve :: String -> Int
solve s
    | null total_ans = 0
    | otherwise = minimum $ map (\((a, la), (b, lb), (c, lc)) -> lb+2) total_ans
    where
        grouped_list = map (\x -> (head x, length x)) $ group s
        pre_now_next = zip3 grouped_list (tail grouped_list) (tail $ tail $ grouped_list)
        total_ans = filter (\((a, la), (b, lb), (c, lc)) -> length (nub [a, b, c]) == 3) pre_now_next

import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    replicateM_ n routine

routine = do
    s <- getLine
    print $ solve s

solve :: String -> Int
solve s
    | null total_ans = 0
    | otherwise = minimum $ map (\((a, la), (b, lb), (c, lc)) -> lb+2) total_ans
    where
        -- group_list = [(char, how_many)]
        grouped_list = map (\x -> (head x, length x)) $ group s
        -- pre_now_next = [(i-1, length), (i, length), (i+1, length)]
        pre_now_next = zip3 grouped_list (tail grouped_list) (tail $ tail $ grouped_list)
        -- total_ans = i-1 != i 's pair
        total_ans = filter (\((a, la), (b, lb), (c, lc)) -> length (nub [a, b, c]) == 3) pre_now_next

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s
  | null fs = 0
  | otherwise = minimum $ map (\((a,la),(b,lb),(c,lc)) -> lb + 2 ) fs

  where
    ps = map (\x -> (x,length x)) $ group s
    ts = zip3 ps (tail ps) (tail $ tail $ ps)
    fs = filter (\((a,la),(b,lb),(c,lc)) -> (length $ nub [a,b,c]) == 3) ts

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

minSize :: String -> (Int, Int, Int, Int)
minSize "" = (10000000, 10000000, 10000000, 10000000)
minSize (c:rest) =
    case c of
        '1' -> (0, f2+1, f3+1, 1 + min ans (max f2 f3))
        '2' -> (f1+1, 0, f3+1, 1 + min ans (max f1 f3))
        '3' -> (f1+1, f2+1, 0, 1 + min ans (max f1 f2))
    where
        (f1,f2,f3, ans) = minSize rest

solve :: String -> Int
solve s
    | ans > 1000000 = 0
    | otherwise     = ans
    where
        (_,_,_,ans) = minSize s

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine


import Data.List
import Data.Graph
import Data.Tree

makeG (a:lst) = buildG (1, a) . pair $ lst
	where pair [] = []; pair (a:b:cs) = (a,b) : (b,a) : pair cs

main = do
	input <- fmap lines $ readFile "input.txt"
	let n = read . head $ input
	let trees = map (makeG . map read . words) . take n . tail $ input
	writeFile "output.txt" . (++"\n") . show . sum . (map (\g -> maximum [ length . head . map levels $ dfs g [i] | i <- vertices g ] - 1)) $ trees