import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    aLi <- replicateM n getInt
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi
      -- need: sizeof ok - sizeof notok >= k
      -- i.e.  sz - (n - sz) >= k, i.e.  2 * sz >= n + k,
      -- i.e. sz >= div (n + k + 1) 2
      tarSz = div (n + k + 1) 2
      sa :: UArray Int Int
      sa = listArray (1, n) $ sort $ elems a
      (x, y) = minimumBy (\(x0, y0) (x1, y1) -> compare (y0 - x0) (y1 - x1))
        $ [(sa ! (i - tarSz + 1), sa ! i) | i <- [tarSz .. n]]
      getrs :: Int -> Int -> Int -> Int -> [[Int]]
      getrs i _ _ 1 = [[i, n]]
      getrs i j 1 left = [i, j] : getrs (j+1) j 0 (left - 1)
      getrs i j net left = let  ajp = a ! (j + 1)
        in  if  inRange (x, y) ajp
        then  getrs i (j + 1) (net + 1) left
        else  getrs i (j + 1) (net - 1) left
    pure $ putInts [x, y] <> foldMap putInts (getrs 1 0 0 k)

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE RecordWildCards #-}
import Control.Monad
import qualified Data.Array as AR
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C
import Text.Printf (printf)

data TC = TC { n::Int, k::Int, a::[Int]}

main = do
  [tt] <- readInts
  replicateM_ tt solve

solve = do
  TC {..} <- tc

  let
    b = AR.listArray (0, n - 1) (sort a)
    ar = AR.listArray (0, n - 1) a
    inc = (n + k + 1) `div` 2

  -- traceIO $ show b

  let
    search i x y
      | i == (n - inc + 1) = (x, y)
      | otherwise =
        let
          l = b AR.! i
          r = b AR.! (i + inc - 1)
        in
          if r - l < y - x
            then search (i + 1) l r
            else search (i + 1) x y

  let (x, y) = search 0 (-1) (n + 1)

  printf "%d %d\n" x y

  let
    splitAR::Int -> Int -> Int -> Int -> IO Int
    splitAR i last mx cur
      | i == n = pure last
      | otherwise = do
        let cur1 = cur + (if x <= (ar AR.! i) && ar AR.! i <= y then 1 else -1)
        if cur1 > mx
          then
            if cur1 >= 1 && cur1 <= k - 1
              then do
                printf "%d %d\n" (last + 2) (i + 1)
                splitAR (i + 1) i cur1 cur1
              else splitAR (i + 1) last cur1 cur1
        else splitAR (i + 1) last mx cur1

  lst <- splitAR 0 (-1) 0 0
  printf "%d %d\n" (lst + 2) n

tc = do
  [n, k] <- readInts
  TC n k <$> readInts

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

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    k <- getInt
    aLi <- replicateM n getInt
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi
      -- need: sizeof ok - sizeof notok >= k
      -- i.e.  sz - (n - sz) >= k, i.e.  2 * sz >= n + k,
      -- i.e. sz >= div (n + k + 1) 2
      tarSz = div (n + k + 1) 2
      sa :: UArray Int Int
      sa = listArray (1, n) $ sort $ elems a
      (x, y) = minimumBy (\(x0, y0) (x1, y1) -> compare (y0 - x0) (x1 - y1))
        $ [(sa ! (i - tarSz + 1), sa ! i) | i <- [tarSz .. n]]
      getrs :: Int -> Int -> Int -> Int -> [[Int]]
      getrs i _ _ 1 = [[i, n]]
      getrs i j 1 left = [i, j] : getrs (j+1) j 0 (left - 1)
      getrs i j net left = let  ajp = a ! (j + 1)
        in  if  inRange (x, y) ajp
        then  getrs i (j + 1) (net + 1) left
        else  getrs i (j + 1) (net - 1) left
    pure $ putInts [x, y] <> foldMap putInts (getrs 1 0 0 k)

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp


import Data.List

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

solve :: Int -> [Int] -> (Int,[Int])
solve n as = ((n-1) `div` 2, merge bigs smalls)
  where
    as' = sort as
    (smalls,bigs) = splitAt ((n-1) `div` 2) as'

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a:b:merge as bs
merge as bs = as ++ bs

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

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

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

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

merge :: [a] -> [a] -> [a]
merge [] ys = ys
merge (x:xs) ys = x:(merge ys xs)

calc :: [Int64] -> Int64
calc (x:y:z:xs) = (if y < x && y < z then 1 else 0) + calc (z:xs)
calc _ = 0

solve :: IO ()
solve = do
    n <- readInt
    b <- readArray
    let a = reverse $ sort b
    let (large,small) = splitAt ((n + 1) `div` 2) a
    let res = merge large small
    let answer = calc res
    print answer
    forM_ res $ (\x -> print x)
    return ()

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

import Data.List

trySolve :: Int -> [Int] -> Int -> Maybe [Int]
trySolve n as k = if  k + k + 1 > n
  then  Nothing
  else  let
    (lows, nonlows) = splitAt k as
    (rev_his, mids) = splitAt (k+1) (reverse nonlows)
    his = reverse rev_his
  in  if  and $ zipWith (<) lows his
  then  Just $ stitch lows his ++ mids
  else  Nothing

stitch :: [Int] -> [Int] -> [Int]
stitch [] [] = []
stitch ps (q:qs) = q : stitch qs ps
stitch _ _ = error "stitch: invalid args"

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p = let
  go low top = if  low == top
    then  low
    else  let
    mid = div (low + top + 1) 2
    in  if  p mid
    then  go mid top
    else  go low (mid - 1)
  in  go

solve :: Int -> [Int] -> (Int, [Int])
solve n li = let
  p k = case  trySolve n li k  of
    Nothing -> False
    _ -> True
  ktar = binSearch p 0 (n + 100)
  in  case  trySolve n li ktar  of
    Nothing -> error "binSearch failed?"
    Just ans -> (ktar, ans)

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

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

main = do
  getLine
  as <- sort . map read . words <$> getLine :: IO [Integer]
  let solution = solve as
  print $ cheap solution
  putStrLn $ unwords $ map show solution

solve as
  | even $ length as = (\(a, b) -> [a, b]) =<< zip (as !! pred d : take (pred d) as) (drop d as)
  | otherwise = (as !! d :) $ (\(a, b) -> [a, b]) =<< zip (take d as) (drop (succ d) as)
  where
    d = length as `div` 2

cheap = length . filter (\(a, b, c) -> a > b && b < c) . (zip3 <*> tail <*> tail . tail)


{-# 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
  getLine
  as <- getInts
  m <- getLine

  let
    ls = scanl (+) 0 as
    rs = scanr (+) 0 $ zipWith (\a b -> if b == '1' then a else 0) as m
    r = maximum $ zipWith3 (\l a r -> if a == '1' then l + r else 0) ls m $ tail rs

  print $ max r $ head rs

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
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
--import System.IO

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

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

solution :: [Int] -> [Char] -> Int -> Int -> Int -> Int
solution [] _ acc curmax _  = max acc curmax
solution (a:as) ('0':bs)   acc curmax s = solution as bs acc curmax (s-a)
solution (a:as) ('1':bs)   acc curmax s = solution as bs (acc + a) (max curmax (acc+s')) s'
    where s' = s - a

main = do
    _ <- getLine
    a <- readsInt
    b <- getLine
    print $ solution (reverse a) (reverse b) 0 0 (sum a)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLn
    l <- readsLine
    m <- getLine
    print $ solve n l m

solve :: Int -> [Int] -> String -> Int
solve n l m = go (reverse l) (reverse m) (sum l) 0
    where
    go (a:as) ('0':m) !s !sm = go as m (s-a) sm
    go (a:as) ('1':m) !s !sm = go as m s     (max sm (s-a))
    go [] _ s sm = max sm s

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = 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)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLn
    l <- readsInt
    m <- getLine
    print $ solve n l m

solve :: Int -> [Int] -> String -> Int
solve n l m = go (reverse l) (reverse m) (sum l) 0
    where
    go (a:as) ('0':m) !s !sm = go as m (s-a) sm
    go (a:as) ('1':m) !s !sm = go as m s     (max sm (s-a))
    go [] _ s sm = max sm s

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

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

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let !l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 0 [] [] = 0
solve 1 [x] [b] = b * x
solve n xs bits = max (unsafeAt sumR 0).maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) bits :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

solve_ :: [Integer] -> String -> (Integer, Integer)
solve_ [] [] = (0, 0)
solve_ (x:xs) (y:ys)
        | y == '1'  = (max (x + ans) sum, x + sum)
        | otherwise = (ans, x + sum)
    where (ans, sum) = solve_ xs ys

solve :: String -> String -> Integer
solve a m = ans
    where (ans, sum) = solve_ (map read $ reverse $ words a) $ reverse m

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

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (m) (ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = maximum (r:ls)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m
          r = one b
          (_,_,ls) = foldl' (\(cums,rs,l) (x,h)-> (cums+x,if h then rs+x else rs,
                                        if h then ((r - rs - x)+cums):l else l))
                                        (0,0,[]) b

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = map fst $ takeWhile snd c
            s2 = one  . map (\(x,_) -> (x,True)) $ c
        in s2 - minimum s1

import System.IO

solution :: [Int] -> [Char] -> Int -> Int
solution [] _ acc = acc
solution a b acc = max s t
    where (a',b') = unzip $ dropWhile (\(_,bit) -> bit == '0') $ zip a b
          s = sum $ tail a'
          t = solution (tail a') (tail b') (acc + (head a'))

main = do
    _ <- getLine
    as <- getLine
    b <- getLine
    let a = map (\s -> read s :: Int) $ words as
        r = solution (reverse a) (reverse b) 0

    print r

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

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

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let !l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 1 [x] [b] = b * x
solve n xs bits = max (unsafeAt sumR 0).maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) xs :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

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

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

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  bits <- map digitToInt.B.unpack.fst.B.spanEnd (\c-> isSpace c || c == '0') <$> B.getLine
  let l = length bits
  print $ solve l (take l xs) bits

solve :: Int -> [Int] -> [Int] -> Int
solve 1 [x] [b] = b * x
solve n xs bits = maximum $ map f [0..n-1]
   where
     arr = listArray (0,n-1) xs :: UArray Int Int
     sumR = listArray (0,n-1) $ scanr1 (+) $ zipWith (*) xs bits :: UArray Int Int
     sumL = listArray (0,n-1) $ scanl1 (+) xs :: UArray Int Int
     f i
       | unsafeAt arr i == 0 = unsafeAt sumR 0
       | i == n-1  = unsafeAt sumL (i-1)
       | i == 0    = unsafeAt sumR (i+1)
       | otherwise = unsafeAt sumL (i-1) + unsafeAt sumR (i+1)

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = map fst $ takeWhile snd c
            s2 = one  . map (\(x,_) -> (x,True)) $ c
        in s2 - minimum s1

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInt) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush :: Int -> String -> [Int] -> Int
rush c m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one :: [(Int,Bool)] -> Int
one = foldl' (\a (l,b) -> if b then l + a else a) 0

two :: [(Int,Bool)] -> Int
two x = let c = dropWhile (not . snd) x
            s1 = (one . init . takeWhile snd) c
            s2 = one  . map (\(x,_) -> (x,True)) . dropWhile snd $ c
        in s1 + s2

module Main where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List (foldl')
main :: IO ()
main = do
  xs <- fmap BS.words BS.getContents
  let m = BS.unpack $ last xs
      c:ns = map (fst . fromJust . BS.readInteger) (init xs)
  print $ rush c (reverse m) (reverse ns)

rush _ m xs
  | '1' `notElem` m = 0
  | otherwise = max (one b) (two b)
    where b = zipWith (\n i -> if i == '1' then (n,True) else (n,False)) xs m

one = foldl' (\a (l,b) -> if b then l + a else a) 0

two x = let c = dropWhile (not . snd) x
            s1 = (one . init . takeWhile snd) c
            s2 = one  . map (\(x,_) -> (x,True)) . dropWhile snd $ c
        in s1 + s2


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

getInts :: IO [Int]
getInts = map (fst . fromJust . B.readInt) <$> B.words <$> B.getContents
parsePairs []       = []
parsePairs (x:y:rs) = (x, y) : parsePairs rs
clamp u v w = max u $ min v $ w

main = do
    _:f:xs <- getInts
    print $ solve f (parsePairs xs)

solve :: Int -> [(Int, Int)] -> Integer
solve f ps = base + bonus where
    base = sum . map toInteger $ [min u v | (u, v) <- ps]
    bonus = sum . map toInteger . take f . reverse . sort $ [clamp 0 u (v - u) | (u, v) <- ps]

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b - min a b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = min (2 * a) b + solution (n - 1) vs
  where ShopDay (_, a, b) = v

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.Int       (Int64)
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b - min a b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = min (2 * a) b + solution (n - 1) vs
  where ShopDay (_, a, b) = v

import Control.Applicative( (<$>))
import Control.Monad( replicateM, forM_)
import Data.ByteString.Char8( readInteger, readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)
import Data.List( sortBy)

main = do
    let
	getLine' = B.hGetLine stdin

	readPair::IO (Integer, Integer)
	readPair = do
	    Just (l,rest) <- readInteger <$> getLine'
	    let
		Just (r,_) = readInteger $ B.tail rest

	    return (l,r)

    Just (n_, rest) <- readInt <$> getLine'
    let
	Just (f_, _) = readInt $ B.tail rest

    klPairs_ <- replicateM (fromIntegral n_) readPair
    let
	sortedKlpairs = sortBy cmp klPairs_
	  where
	    cmp (k1,l1) (k2,l2) = let
				    mn l k = min (2*k) l
		in
		    compare ((mn l2 k2)-k2) ((mn l1 k1)-k1)

	sell::Int->Integer->[(Integer,Integer)]->[Integer]
	sell _ now [] = [now]
	sell 0 now ((k,l):kls) = sell 0 ((min k l)+now) kls
	sell f now ((k,l):kls)
	  | k>=l	= sell f (l+now) kls
	  | otherwise	= sell (f-1) ((min (2*k) l)+now) kls

    print . maximum $ sell f_ 0 sortedKlpairs

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến :: Int -> [(Int64, Int64)] -> Int64
chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l (2 * k) - min l k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . map fromIntegral . readInts <$> B.getLine)
  print $ chiến f kls

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

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

parsePairs :: [Int] -> [(Int, Int)]
parsePairs [] = []
parsePairs (x:y:xs) = (x, y) : parsePairs xs

clamp u v w = max u (min v w)

solve :: Int -> [(Int, Int)] -> Integer
solve f xs = base + extra
  where base = sum . map toInteger $  [min k l | (k, l) <- xs]
        extra = sum . map toInteger . take f . reverse . sort $ [clamp 0 k (l - k) | (k, l) <- xs]

main :: IO ()
main = do
  _:f:xs <- getInts
  print $ solve f (parsePairs xs)

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, f] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    days <- getDays n
    let newCustomers = (\(p, c) -> (max 0 (min p (c- p)), (p,c))) <$> days
        sorted = reverse $ sort newCustomers
        doubled = (\(a,(b, c)) -> min (a+b) c) <$> take f sorted
        normal = (\(a,(b, c)) -> min b c) <$> drop f sorted
    print $ sum doubled + sum normal

getDays :: Int -> IO [(Int64, Int64)]
getDays t = mapM (\_ -> do
    [a,b] <- liftM (\l -> (read :: String -> Int64) <$> words l) getLine
    return (a,b)) [1..t]

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến :: Int -> [(Int64, Int64)] -> Int64
chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l $ 2 * k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . map fromIntegral . readInts <$> B.getLine)
  print $ chiến f kls

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List
import Data.Ord

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến f = sum . map (\(i, (k, l)) -> min l $ if i <= f then 2 * k else k) . zip [1..] . sortBy (flip $ comparing (\(k, l) -> min l $ 2 * k))

main = do
  n:f:_ <- readInts <$> B.getLine
  kls <- replicateM n ((\(k:l:_) -> (k, l)) . readInts <$> B.getLine)
  print $ chiến f kls

import           Data.Functor
import           Data.List

getInts :: IO [Int]
getInts = map read <$> words <$> getContents
parsePairs []       = []
parsePairs (x:y:rs) = (x, y) : parsePairs rs
clamp u v w = max u $ min v $ w

main = getInts >>= print . go where
    go (_:f:xs) = solve f (parsePairs xs)

solve :: Int -> [(Int, Int)] -> Int
solve f ps = base + bonus where
    base = sum [min u v | (u, v) <- ps]
    bonus = sum . take f . reverse . sort $ [clamp 0 u (v - u) | (u, v) <- ps]

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, f] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    days <- getDays n
    let newCustomers = (\(p, c) -> (max 0 (min p (c- p)), (p,c))) <$> days
        sorted = reverse $ sort newCustomers
        doubled = (\(a,(b, c)) -> min (a+b) c) <$> take f sorted
        normal = (\(a,(b, c)) -> min b c) <$> drop f sorted
    print $ sum doubled + sum normal

getDays :: Int -> IO [(Int, Int)]
getDays t = mapM (\_ -> do
    [a,b] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    return (a,b)) [1..t]

import Data.Functor ((<$>))

newtype ShopDay = ShopDay (Int, Int, Int)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- loop n
  case f of
       0 -> putStrLn $ show $ solution f v
       _ -> putStrLn $ show $ solution f (qsr v)
  where readLine = map (read :: String -> Int) . words <$> getLine
        loop :: Int -> IO [ShopDay]
        loop 0 = return []
        loop n = do
          a:b:_ <- readLine
          rest <- loop $ n - 1
          return $ ShopDay (min (2 * a) b, a, b) : rest

solution :: Int -> [ShopDay] -> Int
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = a + solution (n - 1) vs
  where ShopDay (a, _, _) = v

qsr :: (Ord a) => [a] -> [a]
qsr [] = []
qsr (x:xs) = qsr (filter (>=x) xs) ++ [x] ++ qsr (filter (<x) xs)

import Control.Monad  (replicateM)
import Data.Functor   ((<$>))
import Data.Int       (Int64)
import Data.List      (sortBy)
import Data.Maybe     (fromMaybe)

import qualified Data.ByteString.Char8 as B

newtype ShopDay = ShopDay (Integer, Integer, Integer)
  deriving (Show, Eq, Ord)

main :: IO ()
main = do
  n:f:_ <- readLine
  v <- sortBy (flip compare) <$> replicateM (fromInteger n) readDay
  putStrLn $ show $ solution f v
  where readLine = map (fst . fromMaybe undefined . B.readInteger) <$> (B.words <$> B.getLine)
        readDay = do
          a:b:_ <- readLine
          return $ ShopDay (min (2 * a) b, a, b)

solution :: Integer -> [ShopDay] -> Integer
solution 0 v = sum $ map (\ (ShopDay (_, a, b)) -> min a b) v
solution n (v:vs) = a + solution (n - 1) vs
  where ShopDay (a, _, _) = v


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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int (Int64)

readInt = fst . M.fromJust . C.readInt

main = do
    (map readInt . C.words -> (_:(map fromIntegral -> [p :: Int64, q, r]))) <- B.getLine
    (map (fromIntegral . readInt) . C.words -> xs) <- B.getLine
    let ls = scanl1 (if p < 0 then min else max) xs
        rs = scanr1 (if r < 0 then min else max) xs
    print . maximum $ zipWith3 (\a b c -> p * a + q * b + r * c) ls xs rs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 solve p64 p64 p64 (replicateM n p64)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  p64 = fmap to64 poi
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve p q r = maximum . liftM3 (zipWith3 (\a b c -> a + b + c)) (scanl1 max . map (p*)) (map (q*)) (scanr1 max . map (r*))


{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import Data.Array ((!))
import Data.Array.ST (MArray (newArray), readArray, runSTArray, writeArray)
import qualified Data.ByteString.Char8 as C
import Data.Char (toLower)
import Data.Maybe (fromJust)
import Data.List (nub, sort)

data TC = TC {s :: String}

solve TC {..} = unique + allC
  where
    unique = length s
    allC = length $ nub $ sort s

main = C.interact $ runScanner scan >>> map solve >>> map (C.pack . show) >>> C.unlines

scan = numberOf $ int >> TC <$> C.unpack <$> str

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

module Main (main) where
import Numeric (showFFloat)
import Data.Char (toUpper)
import Control.Monad (forM_)
import qualified Data.Foldable as String

import qualified Data.Set as Set

-- reset && stack build && echo "success" && stack exec haskell-codeforces-exe && echo finished
--  gen-hie > hie.yaml

strToInt a = read a :: Int
strToFloat a = read a :: Float

pshow x = putStr (show x)
pfshow x = putStr (showFFloat (Just 2) x "")

solve :: IO()
solve = do
    _ <- getLine
    s <- getLine
    let cntUnique = Set.size $ Set.fromList s
    let cntTotal = String.length s
    print (cntUnique + cntTotal)

main :: IO ()
main = do
    n <- readLn
    forM_[1..n] $ \_ -> do
        solve

import Control.Monad (replicateM_)
import Data.List (nub)

main = do
    tests_n <- read <$> getLine
    replicateM_ tests_n $ do
        getLine
        s <- getLine
        print (findTotalBalloonsWon s)

findTotalBalloonsWon s = length s + length (nub s)

import Data.List

testcase 0 = return ()
testcase t = do
    getLine
    s <- getLine
    putStrLn $ show (length s + (length $ group $ sort s))
    testcase (t - 1)

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

module Main where

import Control.Monad (replicateM_, void)

import Data.Map (Map)
import qualified Data.Map as Map

testCase :: IO ()
testCase = do
    getLine
    line <- getLine

    let mp = foldr (flip (Map.insertWith (+)) 1) Map.empty line

    print $ length (Map.keys mp) + sum (Map.elems mp)

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

    replicateM_ t testCase

{-# LANGUAGE LambdaCase #-}

module Main where

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

--
import Data.List

solve :: C.ByteString -> Int
solve = sum . map (succ . length) . group . sort . C.unpack

input = int *> bstr

output = C.pack . show

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

-- Scanner

type Scanner = State [C.ByteString]

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

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith sp sc = evalState sc . sp

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

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&))

-- road map in reverse, and the number of cities, init pen state
type Domain = String
type CoDomain = Int
type Solver  = Domain -> CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

parse :: IO Domain
parse = do
  _ <- getLine
  line <- getLine
  -- putStrLn line
  return line

solve :: Solver
solve = uncurry (+) . ((length . nub) &&& (length))

main :: IO ()
main = do
  [n] <- readChar8
  replicateM_ n $ printAns =<< solve <$> parse
  return ()

import Control.Monad
import Data.List

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- (readLn :: IO Int)
                    line <- getLine
                    print $ n + length (group (sort line))

main :: IO ()
main = do n <- (readLn :: IO Int)
          forM_ [1 .. n] testCaseMain

import           Data.List
import qualified Data.Char as DC

solveCase :: IO ()
solveCase = do
    n <- fmap (read :: String -> Int) getLine
    s <- getLine
    putStrLn $ show $ length s + (length $ nub s)

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

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


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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func n
        | odd n = ((n - 1, n), -1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (n - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (n - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

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

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

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

run1 = B.unwords . map bshow . solve <$> popInt

solve n =
  let ms = (flip concatMap) [1 .. (n - 1) `quot` 2] $
           \d -> (flip map) [0 .. n - 1] $
           \i -> (i, (i + d) `rem` n)
      scores = listArray ((0, 0), (n - 1, n - 1)) (repeat 0) //
               concatMap (\(i, j) -> [((i, j), 1), ((j, i), -1)]) ms in
    (flip concatMap) [0 .. n - 1] $
    \i -> (flip map) [i + 1 .. n - 1] $
    \j -> scores ! (i, j)

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

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    let
      (wins, ties) = divMod (n-1) 2
      solve x y = if  y - x <= wins
        then  1
        else  if  y - x <= wins + ties
        then  0
        else  0-1
    putInts [solve x y | x <- [1..n], y <- [x+1 .. n]]

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 qualified Data.Set as S

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n - 1, n), -1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n, n - 1), 1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      func :: Int -> [((Int, Int), Int)]
      func 0 = []
      func 1 = []
      func x
        | odd x = ((n - 1, n), 1) : map (\i -> ((i, n), 1)) l1 ++ map (\i -> ((i, n), -1)) l2 ++ map (\i -> ((i, n - 1), -1)) l1 ++ map (\i -> ((i, n - 1), 1)) l2 ++ func (x - 2)
        | otherwise = ((n - 1, n), 0) : map (\i -> ((i, n - 1), 1)) l1 ++ map (\i -> ((i, n - 1), -1)) l2 ++ map (\i -> ((i, n), -1)) l1 ++ map (\i -> ((i, n), 1)) l2 ++ func (x - 2)
        where
        l1 = [1, 3 .. n - 2]
        l2 = [2, 4 .. n - 2]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map (show . snd) $ sort $ func n

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

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

type State = (S.Set (Int, Int), [((Int, Int), String)])

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let
      dfs :: Int -> [Int] -> State -> State
      dfs _ [] p = p
      dfs u (v : vs) p@(visits, results)
        | v == u || S.member e visits = dfs u vs p
        | otherwise = dfs u vs $ dfs v [1..n] (S.insert e visits, (e, r) : results)
        where
        (e, r) = (if u < v then ((u, v), "1") else ((v, u), "-1"))
      results
        | even n = snd $ dfs 1 [2..n] (S.fromAscList adjs, zip adjs (repeat "0"))
        | otherwise = snd $ dfs 1 [2..n] (S.empty, [])
        where
        adjs = map (\i -> (i, i + 1)) $ filter odd [1..n]
    C.putStrLn $ C.pack $ concat $ intersperse " " $ map snd results


import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe
import Data.Foldable
import Data.Monoid

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Sequence (Seq(Empty, (:<|), (:|>)))
import qualified Data.Sequence as Seq

invNum xs = if n == 1 then (xs, 0) else merge ls' rs' Seq.empty (accl + accr)
  where
    n = Seq.length xs
    m = n `div` 2
    (ls, rs) = Seq.splitAt m xs
    (ls', accl) = invNum ls
    (rs', accr) = invNum rs
    merge Empty Empty xs acc = (xs, acc)
    merge Empty (x :<| xss) ys acc = merge Empty xss (ys :|> x) acc
    merge (x :<| xss) Empty ys acc = merge xss Empty (ys :|> x) acc
    merge p@(l :<| lss) q@(r :<| rss) ys acc =
      if l > r then merge lss q (ys :|> l) acc
        else merge p rss (ys :|> r) (acc + Seq.length p)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    as <- listArray (1, m*n) <$> (getInts $ n * m) :: SP (UArray Int Int)
    let xs = Seq.fromList $ sortOn ((,)<$>(as!)<*>id) [1..n*m]
        ans = getSum $ foldMap (Sum . snd . invNum . Seq.sortOn ((,)<$>(as!)<*>negate)) $ Seq.chunksOf m xs
    pure $! putInts [ans]

type SP = State [P.ByteString]

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

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map readInt <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    [n, m] <- readMany :: IO [Int]
    as <- readMany :: IO [Int]
    let xss = map (map snd . sortOn (negate . fst) . reverse) $ chunksOf m $ reverse $ sort $ zip as [1 :: Int ..]
        f xs = sum [length $ filter (<i) xs' | (i:xs') <- tails xs]
    print $ sum $ map f xss

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go where
    go [] = []
    go xs = xs' : go xs'' where (xs', xs'') = splitAt n xs

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

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

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

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

data TC = TC {n :: Int, m :: Int, as :: [Int]}

input :: Scanner TC
input = do
  n <- int
  m <- int
  as <- (n * m) >< int
  return TC {..}

solve :: TC -> Int
solve TC {..} =
  fst
    . foldl update (0, [])
    . map (sort . map snd)
    . groupOn fst
    . sort
    $ zip as [1 ..]
  where
    update (acc, row) ixs = (acc + cost, tetris $ row ++ ixs)
      where
        cixs = take (m - length row) ixs
        cost = sum [countBy (< i) row | i <- cixs]

    tetris xs = let l = length xs in drop (l - l `mod` m) xs

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import qualified Data.Set as S
import Data.Function
import Data.Int

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = unfoldr $ \li -> do
  guard $ not $ null li
  pure $ splitAt n li

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    a <- getInts (n * m)
    let
      aips = sort $ zip a [1..]
      unsrows = chunksOf m aips
      soln row = do
        w <- groupBy ((==) `on` fst) row
        reverse $ map snd w
      rows = map soln unsrows
      cost :: [Int] -> Int64
      cost row = let
        incls = scanl' (flip S.insert) S.empty row
        in  foldl' (+) 0 $ do
        (i, s) <- zip row incls
        pure $ fromIntegral $ S.size $ fst $ S.split i s
    pure $ putInt64s [foldl' (\x y -> x + cost y) 0 rows]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


-- This is probably still a little too slow.
-- Let's see if the test data can prove it.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. maxa] -- another n vs maxa bug
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  factors :: Array Int (UArray Int Int)
  factors = let
    mkListArr :: [Int] -> UArray Int Int
    mkListArr li = listArray (1, length li) li
    in  fmap mkListArr $ accumArray (flip (:)) [] (1, maxa) $ do
      i <- [1 .. maxa]
      j <- [i, 2*i .. maxa]
      pure (j, i)

  getFactors :: Int -> [Int]
  getFactors ix = elems $ factors ! ix

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertSmall arr vals = fmap concat $ forM vals $ \x ->
    flip filterM (getFactors x) $ \y -> do
      prev <- readArray arr y
      writeArray arr y (prev + 1)
      pure $ prev == 0

  insertLarge :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i -> do
        readArray arr (q * i) >>= incrAt arr i
    pure [1 .. maxa]

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
    relixs <- if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

-- Resubmission, to see if 64-bit runtime is any help here, time-wise

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. maxa] -- another n vs maxa bug
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  factors :: Array Int (UArray Int Int)
  factors = let
    mkListArr :: [Int] -> UArray Int Int
    mkListArr li = listArray (1, length li) li
    in  fmap mkListArr $ accumArray (flip (:)) [] (1, maxa) $ do
      i <- [1 .. maxa]
      j <- [i, 2*i .. maxa]
      pure (j, i)

  getFactors :: Int -> [Int]
  getFactors ix = elems $ factors ! ix

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertSmall arr vals = fmap concat $ forM vals $ \x ->
    flip filterM (getFactors x) $ \y -> do
      prev <- readArray arr y
      writeArray arr y (prev + 1)
      pure $ prev == 0

  insertLarge :: STUArray s Int Int -> [Int] -> ST s [Int]
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i -> do
        readArray arr (q * i) >>= incrAt arr i
    pure [1 .. maxa]

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
    relixs <- if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

--import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. n]
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  getPrimeFactors :: Int -> [Int]
  getPrimeFactors 1 = []
  getPrimeFactors x = let
    px = spfs ! x
    in  px : getPrimeFactors (quot x px)

  getFactors :: Int -> [Int]
  getFactors x = let
    opts = map (scanl' (*) 1) $ group $ getPrimeFactors x
    in  foldr (liftM2 (*)) [1] opts

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s ()
  insertSmall arr vals = forM_ vals $ \x ->
    forM_ (getFactors x) $ \y -> incrAt arr y 1

  insertLarge :: STUArray s Int Int -> [Int] -> ST s ()
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot maxa q -- n vs maxa -- Too subtle for me!
      forM_ [start, start - 1 .. 1] $ \i ->
        readArray arr (q * i) >>= incrAt arr i

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
      relixs = if  isLarge
        then  [1 .. maxa]
        else  concatMap getFactors relas
    if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    --cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int

import Control.Monad.ST
  -- I need to re-use a large mutable array to get good complexity

--import Debug.Trace

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
infixl 7 *! -- Don't make typos in your operator precedence. Or else!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral $ x64 * y64 `rem` p64

getSPFs :: Int -> UArray Int Int
getSPFs n = accumArray (const id) 0 (1, n) $ do
  i <- [n, n-1 .. 2]
  j <- [i, 2*i .. n]
  pure (j, i)

getEulerPhi :: UArray Int Int -> UArray Int Int
getEulerPhi spfs = runSTUArray $ do
  let  (1, n) = bounds spfs
  ans <- newArray_ (1, n)
  writeArray ans 1 1
  forM_ [2 .. n] $ \x -> let
    px = spfs ! x
    y = quot x px
    py = spfs ! y
    in  do
    prev <- readArray ans y
    writeArray ans x $ prev * if  px == py  then  px  else  px - 1
  pure ans

solve :: Int -> [Int] -> Int
solve n aLi = let
  a :: UArray Int Int
  a = listArray (1, n) aLi
  maxa = foldl' max n $ elems a

  spfs = getSPFs maxa
  phi = getEulerPhi spfs

  primeList = filter (\q -> spfs ! q == q) [1 .. n]
  nPrimes = length primeList
  primes :: UArray Int Int
  primes = listArray (1, nPrimes) primeList

  getPrimeFactors :: Int -> [Int]
  getPrimeFactors 1 = []
  getPrimeFactors x = let
    px = spfs ! x
    in  px : getPrimeFactors (quot x px)

  getFactors :: Int -> [Int]
  getFactors x = let
    opts = map (scanl' (*) 1) $ group $ getPrimeFactors x
    in  foldr (liftM2 (*)) [1] opts

  incrAt :: STUArray s Int Int -> Int -> Int -> ST s ()
  incrAt arr ix amt = readArray arr ix >>= writeArray arr ix . (+ amt)

  insertSmall :: STUArray s Int Int -> [Int] -> ST s ()
  insertSmall arr vals = forM_ vals $ \x ->
    forM_ (getFactors x) $ \y -> incrAt arr y 1

  insertLarge :: STUArray s Int Int -> [Int] -> ST s ()
  insertLarge arr vals = do
    forM_ vals $ \x -> incrAt arr x 1
    forM_ (elems primes) $ \q -> do
      let  start = quot n q
      forM_ [start, start - 1 .. 1] $ \i ->
        readArray arr (q * i) >>= incrAt arr i

  in  runST $ do
  counts <- newArray (1, maxa) 0 :: ST s (STUArray s Int Int)
  (\fun -> foldM fun 0 [1 .. n]) $ \acc1 stride -> acc1 `seq` do
    let
      relas = map (a !) [stride, 2*stride .. n]
      isLarge = quot n stride >= 1000
      relixs = if  isLarge
        then  [1 .. maxa]
        else  concatMap getFactors relas
    if  isLarge
      then  insertLarge counts relas
      else  insertSmall counts relas
    cts <- getAssocs counts
    --traceShow ("stride", stride, "counts", cts, "acc1", acc1) $ pure ()
    newv <- (\fun -> foldM fun 0 relixs) $ \acc2 ix -> acc2 `seq` do
      ct <- readArray counts ix
      writeArray counts ix 0
      --traceShow ("ix", ix, "acc2", acc2, "ct", ct) $ pure ()
      pure $ acc2 +! phi ! ix *! ct *! ct
    --traceShow ("newv", newv) $ pure ()
    pure $ acc1 +! phi ! stride *! newv

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  aLi <- getInts n
  pure $ putInts [solve n aLi]

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


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

import Control.Applicative
import Control.DeepSeq (deepseq)
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 Data.STRef
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO
import System.Random

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

main = do
  s <- getLine

  let
    count "1" = 0
    count ('0':s) = 1 + count s
    count s = length s1 + 1 + count (if null s2 then "1" else '1':tail s2)
      where
        (s1, s2) = span (== '1') s

  print $ count $ reverse s

-- binares

solve ('1':[]) pl1 akk = akk+pl1
solve ('0':xs) pl1 akk = solve xs pl1 (akk+(1+pl1))
solve ('1':xs) pl1 akk = solve xs 1 (akk + (2-pl1))

main = do
			num <- getLine
			print $ solve (reverse num) 0 0

import Debug.Trace

solve :: [Int] -> Int
solve x = solve' (reverse x) 0
  where
    solve' [1] 0 = 0
    solve' [1] 1 = 1
    solve' (x:xs) c =
      case (x + c) of
        0 -> 1 + (solve' xs 0)
        1 -> 2 + (solve' xs 1)
        2 -> 1 + (solve' xs 1)

solver :: String -> String
solver str = show $ solve $ map (\x -> if x == '0' then 0 else 1) ((lines str) !! 0)

main :: IO ()
main = interact solver

import List (group)

solve :: String -> Int
solve  =  solve' 0 . group . reverse
  where
    solve' acc [x]
      | length x == 1  =  acc
      | otherwise  =  acc + 1 + length x
    solve' acc [x,y]  =  solve' (acc + length x) [y]
    solve' acc (x:y:z:xs)
      | head x == '0'  =  solve' (acc + length x) (y:z:xs)
      | otherwise  =  solve' (acc + 2 * length y + length x - 1) (('1':z):xs)

main :: IO ()
main  =  getLine >>= print . solve

countzero [] n = n
countzero ('0':xs) n = countzero xs (n+1)
countzero ('1':xs) n = countzero xs n

solve digits = let digits' = dropWhile (=='0') digits
               in
                 if digits' == "1" then
                     (length digits) -1
                 else
                     (length digits)+1+(countzero digits' 0)

main = getLine>>=print.solve.reverse

import qualified Data.Char as C

solve :: [Int] -> Int
solve = loop 0

loop acc [1] = acc
loop acc [0] = acc + 1
loop acc (0:foo) = loop (acc + 1) foo
loop acc foo@(1:_) = loop' (acc + 1) foo

loop' acc (1:foo) = loop' (1 + acc) foo
loop' acc (0:foo) = loop acc (1:foo)
loop' acc [] = loop acc [1]

parse :: String -> [Int]
parse = reverse . map C.digitToInt . filter (/= '\n')

main = interact (show . solve . parse)

module Main where

import Control.Monad
import Data.List

main = do
    s <- reverse `liftM` getLine

    let trailZero = length $ takeWhile (=='0') s
        s' = drop trailZero s
        res = trailZero + if null $ tail s'
            then 0
            else length ( filter (=='0') s' ) + length s' + 1

    putStrLn $ show res

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (C.takeWhile (/='\r') . head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	let o = C.count '1' input
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if o == 1 then 2 else 0

import Data.Char

main = do
	s <- getLine
	let a = map digitToInt $ reverse s
	print $ solve a 0

solve [1]    c 	    = c
solve (x:xs) c
	| x == c    = 1 + (solve xs c)
	| otherwise = 2 + (solve xs 1)

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let z = C.count '0' input
	let o = C.count '1' input
	let n = z + o
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if o == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	print n
	print z
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.Char

main = do
	input <- fmap (head . C.lines) $ C.hGetContents stdin
	let n = C.length input
	let z = C.count '0' input
	print $ ord $ C.index input 1
	putStrLn . show $ n + z + 1 - (fromJust . C.elemIndex '1' . C.reverse) input - if n - z == 1 then 2 else 0

-- binares

solve ('1':[]) pl1 akk = if (pl1 == 0) then akk else akk+1
solve ('0':xs) pl1 akk = if (pl1 == 0) then solve xs pl1 (akk+1) else solve ('1':xs) (pl1-1) (akk+1)
solve ('1':xs) pl1 akk = if (pl1 == 1) then solve xs (pl1-1) (akk + 1) else solve xs (pl1+1) (akk+2)

main = do
			num <- getLine
			print $ solve (reverse num) 0 0

import Data.Char

bToD [] n = n
bToD (x:xs) n = bToD xs (n*2+(ord x - ord '0'))

solve n = rec (bToD n 0) 0
    where
      rec x n |x<8 = ([0,0,1,3,2,5,4,4]!!x)+n
              |otherwise = case mod x 8 of
                             0 -> rec (div x 8) (n+3)
                             1 -> rec ((div x 8)+1) (n+6)
                             2 -> rec ((div x 8)+1) (n+5)
                             3 -> rec ((div x 8)+1) (n+5)
                             4 -> rec ((div x 8)+2) (n+5)
                             5 -> rec ((div x 8)+2) (n+6)
                             6 -> rec ((div x 8)+2) (n+5)
                             7 -> rec ((div x 8)+1) (n+4)

main = getLine>>=print.solve

import Data.Char

bToD [] n = n
bToD (x:xs) n = bToD xs (n*2+(ord x - ord '0'))

solve n = rec (bToD n 0) 0
    where
      rec x n |x<8 = ([0,0,1,3,2,5,4,4]!!x)+n
              |otherwise = case mod x 8 of
                             0 -> rec (div x 8) (n+3)
                             1 -> rec ((div x 8)+1) (n+6)
                             2 -> rec ((div x 8)+1) (n+5)
                             3 -> rec ((div x 8)+1) (n+5)
                             4 -> rec ((div x 8)+2) (n+5)
                             5 -> rec ((div x 8)+2) (n+6)
                             6 -> rec ((div x 8)+1) (n+4)
                             7 -> rec ((div x 8)+1) (n+4)
main = getLine>>=print.solve


import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = sqrt $ (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- tail . map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (2, []) poss
    print $ trd shortest

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

type Time = Double
type Distance = Double
type Estimatation = (Distance, Time)

conv :: Double -> Double -> (Double, Double) -> [Time] -> [Estimatation]
conv vb vs univ@(ux, uy) = do
  let distance sx = sqrt $ (ux - sx) ^ 2 + uy ^ 2
  let time (d, sx) = (d, sx / vb + d / vs)
  map (time . (distance >>= (,)))

check :: [Estimatation] -> String
check = do
  let epsilon = 1e-9
  let f (_, (d1, t1)) (_, (d2, t2))
        | abs (t2 - t1) <= epsilon = compare d1 d2
        | otherwise                = compare t1 t2

  (idx, _) <- minimumBy f . drop 1 . zip [1 ..]
  return $ show idx

solve :: [String] -> [String]
solve = fmap return $ do
  let toDoubles = map read . words . head
  [vb, vs] <- drop 1 . toDoubles
  ts       <- toDoubles . drop 1
  [ux, uy] <- toDoubles . drop 2
  let es = conv vb vs (ux, uy) ts
  return $ check es

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

import Control.Monad
import Data.List
import Data.Monoid
import Data.Ord

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $ fst $ head $ sortBy (comparing snd `mappend` flip (comparing fst) ) $ zip [2..]  $ map (\z -> z/vb  + (dist x y z)/vs  ) $ tail bs

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

type I  =  Integer

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

solve :: (Floating d, Ord d) => d -> d -> (d, d) -> [d] -> Int
solve vs vb (xu, yu) xs  =  solve' $ tail $ zip [1..] xs
  where
    solve' [(ni, xi)]  =  ni
    solve' ((ni, xi) : (nj, xj) : xs)
      | (xj - xi) / vs + sqrt ((xu - xj)^2 + yu^2) / vb <= sqrt ((xu - xi)^2 + yu^2) / vb
        =  solve' ((nj, xj) : xs)
      | otherwise  =  ni

main :: IO ()
main  =  do
    [n, vs, vb]  <-  reads
    xs  <-  reads
    [xu, yu]  <-  reads
    print $ solve vs vb (xu, yu) xs

import Control.Monad
import Data.List

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $  fst $ head $  sortOn snd $ zip [2..] $ map (\z -> z/vb  + (dist x y z)/vs  ) $ tail bs

import Control.Monad
import Data.List

double = read :: String -> Double
doubles = map double . words <$> getLine
dist x y b = sqrt $ ( b - x) **2 + y**2
main = do
    [[n,vb,vs],bs,[x,y]] <- replicateM 3 doubles
    print $ fst $ head $ sortOn snd $ zip [2..] $ map (\z -> z/vb + dist x y z ) $ tail bs

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest
  where

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb, - x, i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest
  where

import Data.Functor

type Pos = (Double, Double)

distance :: Pos -> Pos -> Double
distance (x1, y1) (x2, y2) = sqrt $ (x2 - x1) ^ 2 + (y2 - y1) ^ 2

trd :: (a, b, c) -> c
trd (_, _, c) = c

main = do
    n:vb:vs:_ <- map read . words <$> getLine
    poss <- map read . words <$> getLine
    xu:yu:_ <- map read . words <$> getLine
    let step (i, xs) x = (i + 1, f i x : xs)
        f i x = ((distance (xu, yu) (x, 0)) / vs + x / vb
                , distance (xu, yu) (x, 0), i)
        shortest = minimum $ snd $ foldl step (1, []) poss
    print $ trd shortest


import Control.Monad (forM_)
import qualified Data.Map as M (fromList, lookup)
import qualified Data.Sequence as S (fromList, lookup)
import Data.Maybe (fromMaybe)

main :: IO ()
main = do
  [n, q] <- pure . map read . words =<< getLine
  dct <- pure . M.fromList $ zip ['a'..'z'] [1..]
  arr <- pure . S.fromList
            . (0 :) . scanl1 (+) . fromMaybe []
            . sequence . map (flip M.lookup dct)
            =<< getLine
  forM_ [1..q] $ \_ -> do
    [l, r] <- pure . map read . words =<< getLine
    [t, b] <- pure . fromMaybe [0, 0] . sequence
            $ [S.lookup r arr, S.lookup (l - 1) $ arr]
    putStrLn . show $ t - b

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

printResult s n = do
    [l,r] <- readInts
    let
        a = listArray (0,n-1) $ map (\x -> ord x - 96) s
        b = array (0,n) ((0,0):[(i,a!(i-1)+b!(i-1))|i<-[1..n]])
    print $ b ! r - b ! (l-1)

main = do
    [n,q] <- readInts
    s <- getLine
    replicateM_ q $ printResult s n


{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F

import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

data Machine = Machine {
    mI :: (Int, Int)
    ,mN :: Int
    ,mT0 :: Int
    ,mT1 :: Int
} deriving (Eq, Show)

newtype Start = Start { unStart :: Machine } deriving (Eq, Show)
instance Ord Start where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT0 = aT} = unStart a
            Machine {mI = bI, mT0 = bT} = unStart b

newtype End = End { unEnd :: Machine } deriving (Eq, Show)
instance Ord End where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT1 = aT} = unEnd a
            Machine {mI = bI, mT1 = bT} = unEnd b

data Cadre = Cadre {
    cN :: Int
    ,cT :: Int
    ,cF :: Set Start
    ,cL :: Set End
} deriving (Eq, Show)

mkCadre :: Int -> Int -> Int -> Cadre
mkCadre cI n t = Cadre {
    cN = n
    ,cT = t
    ,cF = Set.empty
    ,cL = Set.fromList [End $ Machine {
        mI = (cI, i)
        ,mN = 0
        ,mT0 = 0
        ,mT1 = 0
    } | i <- [0..n-1]]
}

data Laundromat = Laundromat Int (Seq Cadre) deriving (Eq, Show)

mkLaundromat :: Int -> [Int] -> [Int] -> Laundromat
mkLaundromat k ns ts =
     Laundromat 0 . (!! k) . iterate (Seq.adjust (inc 0) 0) . Seq.fromList $ zipWith3 mkCadre [0..] ns ts

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run $ mkLaundromat k [n0, n1, n2] [t0, t1, t2]

run :: Laundromat -> Int
run l = case step l of
    Left t -> t
    Right l -> run l

next :: Seq Cadre -> Maybe Machine
next = fmap unStart . F.foldl' proc Nothing
    where
        proc Nothing c = start c
        proc (Just a) c = case start c of
            Nothing -> Just a
            Just b -> Just $ min a b

step :: Laundromat -> Either Int Laundromat
step (Laundromat t0 c0) = case next c0 of
    Nothing ->
        Left t0
    Just m@(Machine {mI = (cI, _), mT0}) ->
        let
            c = Seq.adjust (dec m) cI c0
            c1 = if cI+1 == Seq.length c then c else Seq.adjust (inc mT0) (cI+1) c
        in Right $ Laundromat mT0 c1

dec :: Machine -> Cadre -> Cadre
dec m0 c@(Cadre {cT}) = add m $ rm m0 c
    where
        m = case m0 of
            Machine {mN = 1} ->
                m0 {mN = 0, mT0 = 0, mT1 = 0}
            Machine {mN, mT0} ->
                m0 {mN = mN-1, mT0 = mT0+cT}

inc :: Int -> Cadre -> Cadre
inc t c@(Cadre {cT}) =add m $ rm m0 c
    where
        m0 = unEnd $ end c
        m = case m0 of
            Machine {mN = 0} ->
                m0 {mN = 1, mT0 = t+cT, mT1 = t+cT}
            Machine {mN, mT1} ->
                m0 {mN = mN+1, mT1 = mT1+cT}

start :: Cadre -> Maybe Start
start (Cadre {cF}) = if Set.null cF then Nothing else Just $ Set.findMin cF

end :: Cadre -> End
end = Set.findMin . cL

rm :: Machine -> Cadre -> Cadre
rm m c@(Cadre {cF, cL}) = c {cF = Set.delete (Start m) cF, cL = Set.delete (End m) cL}

add :: Machine -> Cadre -> Cadre
add m@(Machine {mN}) c@(Cadre {cF, cL}) = c {cF = f, cL = Set.insert (End m) cL}
    where f = if mN == 0 then cF else Set.insert (Start m) cF

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F
import qualified Data.Traversable as T

import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(..), ViewR(..), (|>))

data Cadre = Cadre {
    dt :: Int
    ,ts :: Seq Int
}

type Laundromat = [Cadre]

mkLaundromat :: [Int] -> [Int] -> Laundromat
mkLaundromat = zipWith $ \n t -> Cadre {dt = t, ts = Seq.replicate n 0}

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run k $ mkLaundromat [n0, n1, n2] [t0, t1, t2]

run :: Int -> Laundromat -> Int
run k cs = t
    where _ :> t = Seq.viewr . ts . last $ iterate step cs !! k

step :: Laundromat -> Laundromat
step cs = snd $ T.mapAccumL rot nextT cs
    where
        rot t c@(Cadre {dt, ts = ts0}) = (t + dt, c {ts = ts |> (t + dt)})
            where _ :< ts = Seq.viewl ts0
        nextT = fst $ F.foldl accT (0, 0) cs
        accT (t0, dt0) (Cadre {dt, ts}) = (max t0 (t - dt0), dt0 + dt)
            where t :< _ = Seq.viewl ts

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F

import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

data Machine = Machine {
    mI :: (Int, Int)
    ,mT :: Int
    ,mN :: Int
    ,mT0 :: Int
    ,mT1 :: Int
} deriving (Eq, Show)

newtype Start = Start { unStart :: Machine } deriving (Eq, Show)
instance Ord Start where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT0 = aT} = unStart a
            Machine {mI = bI, mT0 = bT} = unStart b

newtype End = End { unEnd :: Machine } deriving (Eq, Show)
instance Ord End where
    compare a b = compare (aT, aI) (bT, bI)
        where
            Machine {mI = aI, mT1 = aT} = unEnd a
            Machine {mI = bI, mT1 = bT} = unEnd b

data Cadre = Cadre {
    cN :: Int
    ,cT :: Int
    ,cF :: Set Start
    ,cL :: Set End
} deriving (Eq, Show)

mkCadre :: Int -> Int -> Int -> Cadre
mkCadre cI n t = Cadre {
    cN = n
    ,cT = t
    ,cF = Set.empty
    ,cL = Set.fromList [End $ Machine {
        mI = (cI, i)
        ,mT = t
        ,mN = 0
        ,mT0 = 0
        ,mT1 = 0
    } | i <- [0..n-1]]
}

data Laundromat = Laundromat Int (Seq Cadre) deriving (Eq, Show)

mkLaundromat :: Int -> [Int] -> [Int] -> Laundromat
mkLaundromat k ns ts =
     Laundromat 0 . (!! k) . iterate (Seq.adjust (inc 0) 0) . Seq.fromList $ zipWith3 mkCadre [0..] ns ts

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run $ mkLaundromat k [n0, n1, n2] [t0, t1, t2]

run :: Laundromat -> Int
run l = case step l of
    Left t -> t
    Right l -> run l

next :: Seq Cadre -> Maybe Machine
next = fmap unStart . F.foldl' proc Nothing
    where
        proc Nothing c = start c
        proc (Just a) c = case start c of
            Nothing -> Just a
            Just b -> Just $ min a b

step :: Laundromat -> Either Int Laundromat
step (Laundromat t0 c0) = case next c0 of
    Nothing ->
        Left t0
    Just m@(Machine {mI = (cI, _), mT0}) ->
        let
            c = Seq.adjust (dec m) cI c0
            c1 = if cI+1 == Seq.length c then c else Seq.adjust (inc mT0) (cI+1) c
        in Right $ Laundromat mT0 c1

dec :: Machine -> Cadre -> Cadre
dec m0 = add m . rm m0
    where m = case m0 of
            Machine {mN = 1} ->
                m0 {mN = 0, mT0 = 0, mT1 = 0}
            Machine {mT, mN, mT0} ->
                m0 {mN = mN-1, mT0 = mT0+mT}

inc :: Int -> Cadre -> Cadre
inc t c =
    let m@(Machine {mT, mN, mT0, mT1}) = unEnd $ end c
    in add (m {mN = mN+1, mT0 = if mN == 0 then t+mT else mT0, mT1 = mT1+mT}) $ rm m c

start :: Cadre -> Maybe Start
start (Cadre {cF}) = if Set.null cF then Nothing else Just $ Set.findMin cF

end :: Cadre -> End
end = Set.findMin . cL

rm :: Machine -> Cadre -> Cadre
rm m c@(Cadre {cF, cL}) = c {cF = Set.delete (Start m) cF, cL = Set.delete (End m) cL}

add :: Machine -> Cadre -> Cadre
add m@(Machine {mN}) c@(Cadre {cF, cL}) = c {cF = f, cL = Set.insert (End m) cL}
    where f = if mN == 0 then cF else Set.insert (Start m) cF

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -O2 #-}

import qualified Data.Foldable as F
import qualified Data.Traversable as T

import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(..), ViewR(..), (|>))

data Cadre = Cadre {
    dt :: Int
    ,ts :: Seq Int
}

type Laundromat = [Cadre]

mkLaundromat :: [Int] -> [Int] -> Laundromat
mkLaundromat = zipWith $ \n t -> Cadre {dt = t, ts = Seq.replicate n 0}

main = do
    [k, n0, n1, n2, t0, t1, t2] <- fmap (map read . words) getLine
    putStrLn . show . run k $ mkLaundromat [n0, n1, n2] [t0, t1, t2]

run :: Int -> Laundromat -> Int
run k cs = t
    where _ :> t = Seq.viewr . ts . last $ iterate step cs !! k

step :: Laundromat -> Laundromat
step cs = snd $ T.mapAccumL rot nextT cs
    where
        rot t c@(Cadre {dt, ts = ts0}) = (t + dt, c {ts = ts |> (t + dt)})
            where _ :< ts = Seq.viewl ts0
        nextT = fst $ F.foldl accT (0, 0) cs
        accT (t0, dt0) (Cadre {dt, ts}) = (max t0 (t - dt0 - dt), dt0 + dt)
            where t :< _ = Seq.viewl ts