Once upon a time Petya and Gena gathered after another programming competition and decided to play some game. As they consider most modern games to be boring, they always try to invent their own games. They have only stickers and markers, but that won't stop them.The game they came up with has the following rules. Initially, there are n stickers on the wall arranged in a row. Each sticker has some number written on it. Now they alternate turn, Petya moves first.One move happens as follows. Lets say there are m ≥ 2 stickers on the wall. The player, who makes the current move, picks some integer k from 2 to m and takes k leftmost stickers (removes them from the wall). After that he makes the new sticker, puts it to the left end of the row, and writes on it the new integer, equal to the sum of all stickers he took on this move. Game ends when there is only one sticker left on the wall. The score of the player is equal to the sum of integers written on all stickers he took during all his moves. The goal of each player is to maximize the difference between his score and the score of his opponent.Given the integer n and the initial sequence of stickers on the wall, define the result of the game, i.e. the difference between the Petya's and Gena's score if both players play optimally.

The first line of input contains a single integer n (2 ≤ n ≤ 200 000) — the number of stickers, initially located on the wall. The second line contains n integers a1, a2, ..., an ( - 10 000 ≤ ai ≤ 10 000) — the numbers on stickers in order from left to right.

Print one integer — the difference between the Petya's score and Gena's score at the end of the game if both players play optimally.

NoteIn the first sample, the optimal move for Petya is to take all the stickers. As a result, his score will be equal to 14 and Gena's score will be equal to 0.In the second sample, the optimal sequence of moves is the following. On the first move Petya will take first three sticker and will put the new sticker with value  - 8. On the second move Gena will take the remaining two stickers. The Petya's score is 1 + ( - 7) + ( - 2) =  - 8, Gena's score is ( - 8) + 3 =  - 5, i.e. the score difference will be  - 3.

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

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

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

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

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

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

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

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

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

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

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

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


There is a fence in front of Polycarpus's home. The fence consists of n planks of the same width which go one after another from left to right. The height of the i-th plank is hi meters, distinct planks can have distinct heights.    Fence for n = 7 and h = [1, 2, 6, 1, 1, 7, 1] Polycarpus has bought a posh piano and is thinking about how to get it into the house. In order to carry out his plan, he needs to take exactly k consecutive planks from the fence. Higher planks are harder to tear off the fence, so Polycarpus wants to find such k consecutive planks that the sum of their heights is minimal possible.Write the program that finds the indexes of k consecutive planks with minimal total height. Pay attention, the fence is not around Polycarpus's home, it is in front of home (in other words, the fence isn't cyclic).

The first line of the input contains integers n and k (1 ≤ n ≤ 1.5·105, 1 ≤ k ≤ n) — the number of planks in the fence and the width of the hole for the piano. The second line contains the sequence of integers h1, h2, ..., hn (1 ≤ hi ≤ 100), where hi is the height of the i-th plank of the fence.

Print such integer j that the sum of the heights of planks j, j + 1, ..., j + k - 1 is the minimum possible. If there are multiple such j's, print any of them.

NoteIn the sample, your task is to find three consecutive planks with the minimum sum of heights. In the given case three planks with indexes 3, 4 and 5 have the required attribute, their total height is 8.

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

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

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

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

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

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

import Numeric
import Data.Array

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Array
import Debug.Trace

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Numeric
import Data.Array

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

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

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

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

import Numeric
import Data.Array

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

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

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

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

import Numeric
import Data.Array

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


Johnny has recently found an ancient, broken computer. The machine has only one register, which allows one to put in there one variable. Then in one operation, you can shift its bits left or right by at most three positions. The right shift is forbidden if it cuts off some ones. So, in fact, in one operation, you can multiply or divide your number by $$$2$$$, $$$4$$$ or $$$8$$$, and division is only allowed if the number is divisible by the chosen divisor. Formally, if the register contains a positive integer $$$x$$$, in one operation it can be replaced by one of the following:   $$$x \cdot 2$$$  $$$x \cdot 4$$$  $$$x \cdot 8$$$  $$$x / 2$$$, if $$$x$$$ is divisible by $$$2$$$  $$$x / 4$$$, if $$$x$$$ is divisible by $$$4$$$  $$$x / 8$$$, if $$$x$$$ is divisible by $$$8$$$ For example, if $$$x = 6$$$, in one operation it can be replaced by $$$12$$$, $$$24$$$, $$$48$$$ or $$$3$$$. Value $$$6$$$ isn't divisible by $$$4$$$ or $$$8$$$, so there're only four variants of replacement.Now Johnny wonders how many operations he needs to perform if he puts $$$a$$$ in the register and wants to get $$$b$$$ at the end.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The following $$$t$$$ lines contain a description of test cases. The first and only line in each test case contains integers $$$a$$$ and $$$b$$$ ($$$1 \leq a, b \leq 10^{18}$$$) — the initial and target value of the variable, respectively.

Output $$$t$$$ lines, each line should contain one integer denoting the minimum number of operations Johnny needs to perform. If Johnny cannot get $$$b$$$ at the end, then write $$$-1$$$.

NoteIn the first test case, Johnny can reach $$$5$$$ from $$$10$$$ by using the shift to the right by one (i.e. divide by $$$2$$$).In the second test case, Johnny can reach $$$44$$$ from $$$11$$$ by using the shift to the left by two (i.e. multiply by $$$4$$$).In the third test case, it is impossible for Johnny to reach $$$21$$$ from $$$17$$$.In the fourth test case, initial and target values are equal, so Johnny has to do $$$0$$$ operations.In the fifth test case, Johnny can reach $$$3$$$ from $$$96$$$ by using two shifts to the right: one by $$$2$$$, and another by $$$3$$$ (i.e. divide by $$$4$$$ and by $$$8$$$).

import Data.Bits
import Control.Monad

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

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

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

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

import Data.Int

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

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

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

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

import Data.Int

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

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

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

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

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

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

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

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Maybe

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

split = _split [] ""

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

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

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

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

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

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

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

import Data.Bits
import Control.Monad

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

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

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

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

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

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

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


Artem is building a new robot. He has a matrix $$$a$$$ consisting of $$$n$$$ rows and $$$m$$$ columns. The cell located on the $$$i$$$-th row from the top and the $$$j$$$-th column from the left has a value $$$a_{i,j}$$$ written in it. If two adjacent cells contain the same value, the robot will break. A matrix is called good if no two adjacent cells contain the same value, where two cells are called adjacent if they share a side. Artem wants to increment the values in some cells by one to make $$$a$$$ good.More formally, find a good matrix $$$b$$$ that satisfies the following condition —   For all valid ($$$i,j$$$), either $$$b_{i,j} = a_{i,j}$$$ or $$$b_{i,j} = a_{i,j}+1$$$. For the constraints of this problem, it can be shown that such a matrix $$$b$$$ always exists. If there are several such tables, you can output any of them. Please note that you do not have to minimize the number of increments.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n, m$$$ ($$$1 \le n \le 100$$$, $$$1 \le m \le 100$$$)  — the number of rows and columns, respectively. The following $$$n$$$ lines each contain $$$m$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th line is $$$a_{i,j}$$$ ($$$1 \leq a_{i,j} \leq 10^9$$$).

For each case, output $$$n$$$ lines each containing $$$m$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th line is $$$b_{i,j}$$$.

NoteIn all the cases, you can verify that no two adjacent cells have the same value and that $$$b$$$ is the same as $$$a$$$ with some values incremented by one.

{-# LANGUAGE Safe #-}

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

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

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

import Data.List
import qualified Data.Set as Set

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

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

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

import Control.Arrow ((>>>))

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

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

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

import Data.List
import qualified Data.Set as Set

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

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

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


Autocomplete is a program function that enables inputting the text (in editors, command line shells, browsers etc.) completing the text by its inputted part. Vasya is busy working on a new browser called 'BERowser'. He happens to be working on the autocomplete function in the address line at this very moment. A list consisting of n last visited by the user pages and the inputted part s are known. Your task is to complete s to make it an address of one of the pages from the list. You have to find the lexicographically smallest address having a prefix s.

The first line contains the s line which is the inputted part. The second line contains an integer n (1 ≤ n ≤ 100) which is the number of visited pages. Then follow n lines which are the visited pages, one on each line. All the lines have lengths of from 1 to 100 symbols inclusively and consist of lowercase Latin letters only.

If s is not the beginning of any of n addresses of the visited pages, print s. Otherwise, print the lexicographically minimal address of one of the visited pages starting from s. The lexicographical order is the order of words in a dictionary. The lexicographical comparison of lines is realized by the '<' operator in the modern programming languages.

import Control.Monad
import Data.List

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

import Control.Monad
import List

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

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

module Main where

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

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

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

import Control.Monad
import Data.List

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

import Data.List
import System.IO

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

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

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

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

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

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

import Data.List

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

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

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

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

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

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

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

module Main where

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

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

module Main where

import Control.Arrow
import Data.List

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

module Main where

import Control.Arrow
import Data.List

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

module Main where

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

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

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

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

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

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

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

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

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

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


Given an array a1, a2, ..., an of n integers, find the largest number in the array that is not a perfect square.A number x is said to be a perfect square if there exists an integer y such that x = y2.

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of elements in the array. The second line contains n integers a1, a2, ..., an ( - 106 ≤ ai ≤ 106) — the elements of the array. It is guaranteed that at least one element of the array is not a perfect square.

Print the largest number in the array which is not a perfect square. It is guaranteed that an answer always exists.

NoteIn the first sample case, 4 is a perfect square, so the largest number in the array that is not a perfect square is 2.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Int

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


In this problem we consider a special type of an auction, which is called the second-price auction. As in regular auction n bidders place a bid which is price a bidder ready to pay. The auction is closed, that is, each bidder secretly informs the organizer of the auction price he is willing to pay. After that, the auction winner is the participant who offered the highest price. However, he pay not the price he offers, but the highest price among the offers of other participants (hence the name: the second-price auction).Write a program that reads prices offered by bidders and finds the winner and the price he will pay. Consider that all of the offered prices are different.

The first line of the input contains n (2 ≤ n ≤ 1000) — number of bidders. The second line contains n distinct integer numbers p1, p2, ... pn, separated by single spaces (1 ≤ pi ≤ 10000), where pi stands for the price offered by the i-th bidder.

The single output line should contain two integers: index of the winner and the price he will pay. Indices are 1-based.

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

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

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

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


Igor the analyst has adopted n little bunnies. As we all know, bunnies love carrots. Thus, Igor has bought a carrot to be shared between his bunnies. Igor wants to treat all the bunnies equally, and thus he wants to cut the carrot into n pieces of equal area. Formally, the carrot can be viewed as an isosceles triangle with base length equal to 1 and height equal to h. Igor wants to make n - 1 cuts parallel to the base to cut the carrot into n pieces. He wants to make sure that all n pieces have the same area. Can you help Igor determine where to cut the carrot so that each piece have equal area?  Illustration to the first example.

The first and only line of input contains two space-separated integers, n and h (2 ≤ n ≤ 1000, 1 ≤ h ≤ 105).

The output should contain n - 1 real numbers x1, x2, ..., xn - 1. The number xi denotes that the i-th cut must be made xi units away from the apex of the carrot. In addition, 0 < x1 < x2 < ... < xn - 1 < h must hold.  Your output will be considered correct if absolute or relative error of every number in your output doesn't exceed 10 - 6. Formally, let your answer be a, and the jury's answer be b. Your answer is considered correct if .

NoteDefinition of isosceles triangle: https://en.wikipedia.org/wiki/Isosceles_triangle.

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

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

import Data.List

fi=fromIntegral

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

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

import Control.Applicative

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

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

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

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

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


Erelong Leha was bored by calculating of the greatest common divisor of two factorials. Therefore he decided to solve some crosswords. It's well known that it is a very interesting occupation though it can be very difficult from time to time. In the course of solving one of the crosswords, Leha had to solve a simple task. You are able to do it too, aren't you?Leha has two strings s and t. The hacker wants to change the string s at such way, that it can be found in t as a substring. All the changes should be the following: Leha chooses one position in the string s and replaces the symbol in this position with the question mark "?". The hacker is sure that the question mark in comparison can play the role of an arbitrary symbol. For example, if he gets string s="ab?b" as a result, it will appear in t="aabrbb" as a substring.Guaranteed that the length of the string s doesn't exceed the length of the string t. Help the hacker to replace in s as few symbols as possible so that the result of the replacements can be found in t as a substring. The symbol "?" should be considered equal to any other symbol.

The first line contains two integers n and m (1 ≤ n ≤ m ≤ 1000) — the length of the string s and the length of the string t correspondingly. The second line contains n lowercase English letters — string s. The third line contains m lowercase English letters — string t.

In the first line print single integer k — the minimal number of symbols that need to be replaced. In the second line print k distinct integers denoting the positions of symbols in the string s which need to be replaced. Print the positions in any order. If there are several solutions print any of them. The numbering of the positions begins from one.

import Data.List

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

module Main where

import Data.List

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List

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

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

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

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

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

import Data.Foldable

main = interact foo

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

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

import Control.Monad
import Data.List

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

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

module Main where

import Data.List

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Foldable

main = interact foo

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

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


This time around, Baby Ehab will play with permutations. He has $$$n$$$ cubes arranged in a row, with numbers from $$$1$$$ to $$$n$$$ written on them. He'll make exactly $$$j$$$ operations. In each operation, he'll pick up $$$2$$$ cubes and switch their positions.He's wondering: how many different sequences of cubes can I have at the end? Since Baby Ehab is a turbulent person, he doesn't know how many operations he'll make, so he wants the answer for every possible $$$j$$$ between $$$1$$$ and $$$k$$$.

The only line contains $$$2$$$ integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 10^9$$$, $$$1 \le k \le 200$$$) — the number of cubes Baby Ehab has, and the parameter $$$k$$$ from the statement.

Print $$$k$$$ space-separated integers. The $$$i$$$-th of them is the number of possible sequences you can end up with if you do exactly $$$i$$$ operations. Since this number can be very large, print the remainder when it's divided by $$$10^9+7$$$.

NoteIn the second example, there are $$$3$$$ sequences he can get after $$$1$$$ swap, because there are $$$3$$$ pairs of cubes he can swap. Also, there are $$$3$$$ sequences he can get after $$$2$$$ swaps:  $$$[1,2,3]$$$,  $$$[3,1,2]$$$,  $$$[2,3,1]$$$.

import Data.Maybe
import Data.Array
import qualified Data.ByteString.Char8 as C
import Data.Int

parseInt = fst . fromJust . C.readInt
getInts = map parseInt . C.words <$> C.getLine

kMod :: Int
kMod = 10 ^ 9 + 7

toInt64 :: Int -> Int64
toInt64 = fromIntegral

fromInt64 :: Int64 -> Int
fromInt64 = fromIntegral

newtype Mint = Mint { mint :: Int }
  deriving (Eq, Ord)
instance Num Mint where
  (Mint a) + (Mint b) = Mint (let c = a + b in if c >= kMod then c - kMod else c)
  (Mint a) - (Mint b) = Mint a + Mint (kMod - b)
  (Mint a) * (Mint b) = Mint $ fromInt64 $ (toInt64 a * toInt64 b) `mod` (toInt64 kMod)
  fromInteger n = Mint (fromIntegral $ n `mod` fromIntegral kMod)
instance Show Mint where show = show . mint

main :: IO ()
main = do
  [n, k] <- getInts
  let m = 2 * k
      comb = listArray (0, m) $ 1 : [comb ! (i - 1) * Mint (n - i + 1) * Mint i ^ (kMod - 2) | i <- [1..m]]
      disord = listArray ((0, 0), (m, k)) [f i j | i <- [0..m], j <- [0..k]]
        where f 0 0 = 1
              f 0 _ = 0
              f 1 _ = 0
              f _ 0 = 0
              f i j = Mint (i - 1) * (disord ! (i - 2, j - 1) + disord ! (i - 1, j - 1))
      g = listArray (0, k) [sum [comb ! i * disord ! (i, j) | i <- [j..2*j]] | j <- [0..k]]
      results = [sum [g ! j | j <- [i, i - 2 .. 0]] | i <- [1..k]]
  putStrLn $ unwords $ map show results


Student Valera is an undergraduate student at the University. His end of term exams are approaching and he is to pass exactly n exams. Valera is a smart guy, so he will be able to pass any exam he takes on his first try. Besides, he can take several exams on one day, and in any order.According to the schedule, a student can take the exam for the i-th subject on the day number ai. However, Valera has made an arrangement with each teacher and the teacher of the i-th subject allowed him to take an exam before the schedule time on day bi (bi < ai). Thus, Valera can take an exam for the i-th subject either on day ai, or on day bi. All the teachers put the record of the exam in the student's record book on the day of the actual exam and write down the date of the mark as number ai.Valera believes that it would be rather strange if the entries in the record book did not go in the order of non-decreasing date. Therefore Valera asks you to help him. Find the minimum possible value of the day when Valera can take the final exam if he takes exams so that all the records in his record book go in the order of non-decreasing date.

The first line contains a single positive integer n (1 ≤ n ≤ 5000) — the number of exams Valera will take. Each of the next n lines contains two positive space-separated integers ai and bi (1 ≤ bi < ai ≤ 109) — the date of the exam in the schedule and the early date of passing the i-th exam, correspondingly.

Print a single integer — the minimum possible number of the day when Valera can take the last exam if he takes all the exams so that all the records in his record book go in the order of non-decreasing date.

NoteIn the first sample Valera first takes an exam in the second subject on the first day (the teacher writes down the schedule date that is 3). On the next day he takes an exam in the third subject (the teacher writes down the schedule date, 4), then he takes an exam in the first subject (the teacher writes down the mark with date 5). Thus, Valera takes the last exam on the second day and the dates will go in the non-decreasing order: 3, 4, 5.In the second sample Valera first takes an exam in the third subject on the fourth day. Then he takes an exam in the second subject on the fifth day. After that on the sixth day Valera takes an exam in the first subject.

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

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

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

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

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

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

import Data.List
import Numeric

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

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

parse = map (map fastRead.words)

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

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

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

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

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

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

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

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

import Data.List (foldl', sort)

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

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

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

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

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

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

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

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

process n m [] = m

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

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

import Data.List

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

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

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

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

import Data.List
import Numeric

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

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

parse = map (map fastRead.words)

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

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

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

import Data.List
import Numeric

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

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

parse = map (map fastRead.words)

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List

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

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

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

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


You have $$$n$$$ chains, the $$$i$$$-th chain consists of $$$c_i$$$ vertices. Vertices in each chain are numbered independently from $$$1$$$ to $$$c_i$$$ along the chain. In other words, the $$$i$$$-th chain is the undirected graph with $$$c_i$$$ vertices and $$$(c_i - 1)$$$ edges connecting the $$$j$$$-th and the $$$(j + 1)$$$-th vertices for each $$$1 \le j < c_i$$$.Now you decided to unite chains in one graph in the following way:   the first chain is skipped;  the $$$1$$$-st vertex of the $$$i$$$-th chain is connected by an edge with the $$$a_i$$$-th vertex of the $$$(i - 1)$$$-th chain;  the last ($$$c_i$$$-th) vertex of the $$$i$$$-th chain is connected by an edge with the $$$b_i$$$-th vertex of the $$$(i - 1)$$$-th chain.   Picture of the first test case. Dotted lines are the edges added during uniting process Calculate the length of the longest simple cycle in the resulting graph.A simple cycle is a chain where the first and last vertices are connected as well. If you travel along the simple cycle, each vertex of this cycle will be visited exactly once.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains the single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of chains you have. The second line of each test case contains $$$n$$$ integers $$$c_1, c_2, \dots, c_n$$$ ($$$2 \le c_i \le 10^9$$$) — the number of vertices in the corresponding chains. The third line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$a_1 = -1$$$; $$$1 \le a_i \le c_{i - 1}$$$). The fourth line of each test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$b_1 = -1$$$; $$$1 \le b_i \le c_{i - 1}$$$). Both $$$a_1$$$ and $$$b_1$$$ are equal to $$$-1$$$, they aren't used in graph building and given just for index consistency. It's guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case, print the length of the longest simple cycle.

NoteIn the first test case, the longest simple cycle is shown below:   We can't increase it with the first chain, since in such case it won't be simple — the vertex $$$2$$$ on the second chain will break simplicity.

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

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

inf :: Integer
inf = 4000000000

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

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

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

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

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

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

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

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

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

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

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

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

        printf "%lld\n" answer


Ancient Egyptians are known to have used a large set of symbols  to write on the walls of the temples. Fafa and Fifa went to one of the temples and found two non-empty words S1 and S2 of equal lengths on the wall of temple written one below the other. Since this temple is very ancient, some symbols from the words were erased. The symbols in the set  have equal probability for being in the position of any erased symbol.Fifa challenged Fafa to calculate the probability that S1 is lexicographically greater than S2. Can you help Fafa with this task?You know that , i. e. there were m distinct characters in Egyptians' alphabet, in this problem these characters are denoted by integers from 1 to m in alphabet order. A word x is lexicographically greater than a word y of the same length, if the words are same up to some position, and then the word x has a larger character, than the word y.We can prove that the probability equals to some fraction , where P and Q are coprime integers, and . Print as the answer the value , i. e. such a non-negative integer less than 109 + 7, such that , where  means that a and b give the same remainders when divided by m.

The first line contains two integers n and m (1 ≤ n,  m ≤ 105) — the length of each of the two words and the size of the alphabet , respectively. The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ m) — the symbols of S1. If ai = 0, then the symbol at position i was erased. The third line contains n integers representing S2 with the same format as S1.

Print the value , where P and Q are coprime and  is the answer to the problem.

NoteIn the first sample, the first word can be converted into (1) or (2). The second option is the only one that will make it lexicographically larger than the second word. So, the answer to the problem will be , that is 500000004, because .In the second example, there is no replacement for the zero in the second word that will make the first one lexicographically larger. So, the answer to the problem is , that is 0.

import Prelude hiding ((**),(+),(-),(*),(/))
import qualified Prelude as P ((**),(+),(-),(*),(/))
import System.IO
import Control.Arrow
import Data.List
import Control.Monad
import Control.Monad.Trans.State.Lazy

iLn :: IO [Integer]
iLn = getLine >>= (return . fmap (read) . words)

powMod :: Integral a => a -> a -> a -> a
powMod _ _ 0 = 1
powMod m x 1 = x `mod` m
powMod m x n
    | even n = powMod m modSquare (n`div`2)
    | otherwise = (x P.* powMod m modSquare ((n P.- 1)`div`2)) `mod` m
    where modSquare = x P.* (x `mod` m)

inv n = powMod 1000000007 n 1000000005

a / b = (`mod` 1000000007) (a P.* inv b)
a * b = (`mod` 1000000007) (a P.* b)
a + b = (`mod` 1000000007) (a P.+ b)
a - b = (`mod` 1000000007) (a P.- b)

main = do
  [n,m] <- iLn
  s1 <- iLn
  s2 <- iLn
  print $ solve m s1 s2

-- solve :: Integer -> [Integer] -> [Integer] -> Integer
solve m xs ys = fst . so m $ zip xs ys
so m = foldl1 g . map f
  where f (x,y) = case (x,y) of
                    (0,0) -> ((m-1)/2/m,1/m)
                    (x,0) -> ((x-1)/m,1/m)
                    (0,y) -> ((m-y)/m,1/m)
                    (x,y) -> (if x>y then 1 else 0,if x==y then 1 else 0)
        g (a,b) (c,d) = (a+(b*c),b*d)

import Prelude hiding ((**),(+),(-),(*),(/))
import qualified Prelude as P ((**),(+),(-),(*),(/))
import System.IO
import Control.Arrow
import Data.List
import Control.Monad
import Control.Monad.Trans.State.Lazy

iLn :: IO [Integer]
iLn = getLine >>= (return . fmap (read) . words)

powMod :: Integral a => a -> a -> a -> a
powMod _ _ 0 = 1
powMod m x 1 = x `mod` m
powMod m x n
    | even n = powMod m modSquare (n`div`2)
    | otherwise = (x P.* powMod m modSquare ((n P.- 1)`div`2)) `mod` m
    where modSquare = x P.* (x `mod` m)

inv n = powMod 1000000007 n 1000000005

a / b = (`mod` 1000000007) (a P.* inv b)
a * b = (`mod` 1000000007) (a P.* b)
a + b = (`mod` 1000000007) (a P.+ b)
a - b = (`mod` 1000000007) (a P.- b)

main = do
  [n,m] <- iLn
  s1 <- iLn
  s2 <- iLn
  print s1
  print s2
  print $ solve m s1 s2

-- solve :: Integer -> [Integer] -> [Integer] -> Integer
solve m xs ys = fst . so m $ zip xs ys
so m = foldl1 g . map f
  where f (x,y) = case (x,y) of
                    (0,0) -> ((m-1)/2/m,1/m)
                    (x,0) -> ((x-1)/m,1/m)
                    (0,y) -> ((m-y)/m,1/m)
                    (x,y) -> (if x>y then 1 else 0,if x==y then 1 else 0)
        g (a,b) (c,d) = (a+(b*c),b*d)


Once little Vasya read an article in a magazine on how to make beautiful handmade garland from colored paper. Vasya immediately went to the store and bought n colored sheets of paper, the area of each sheet is 1 square meter.The garland must consist of exactly m pieces of colored paper of arbitrary area, each piece should be of a certain color. To make the garland, Vasya can arbitrarily cut his existing colored sheets into pieces. Vasya is not obliged to use all the sheets to make the garland.Vasya wants the garland to be as attractive as possible, so he wants to maximize the total area of m pieces of paper in the garland. Calculate what the maximum total area of the pieces of paper in the garland Vasya can get.

The first line contains a non-empty sequence of n (1 ≤ n ≤ 1000) small English letters ("a"..."z"). Each letter means that Vasya has a sheet of paper of the corresponding color. The second line contains a non-empty sequence of m (1 ≤ m ≤ 1000) small English letters that correspond to the colors of the pieces of paper in the garland that Vasya wants to make.

Print an integer that is the maximum possible total area of the pieces of paper in the garland Vasya wants to get or -1, if it is impossible to make the garland from the sheets he's got. It is guaranteed that the answer is always an integer.

NoteIn the first test sample Vasya can make an garland of area 6: he can use both sheets of color b, three (but not four) sheets of color a and cut a single sheet of color c in three, for example, equal pieces. Vasya can use the resulting pieces to make a garland of area 6.In the second test sample Vasya cannot make a garland at all — he doesn't have a sheet of color z.

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

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

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

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

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

import Data.List

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

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

import Data.List

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

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


The territory of Berland is represented by a rectangular field n × m in size. The king of Berland lives in the capital, located on the upper left square (1, 1). The lower right square has coordinates (n, m). One day the king decided to travel through the whole country and return back to the capital, having visited every square (except the capital) exactly one time. The king must visit the capital exactly two times, at the very beginning and at the very end of his journey. The king can only move to the side-neighboring squares. However, the royal advise said that the King possibly will not be able to do it. But there is a way out — one can build the system of one way teleporters between some squares so that the king could fulfill his plan. No more than one teleporter can be installed on one square, every teleporter can be used any number of times, however every time it is used, it transports to the same given for any single teleporter square. When the king reaches a square with an installed teleporter he chooses himself whether he is or is not going to use the teleport. What minimum number of teleporters should be installed for the king to complete the journey? You should also compose the journey path route for the king.

The first line contains two space-separated integers n and m (1 ≤ n, m ≤ 100, 2 ≤  n · m) — the field size. The upper left square has coordinates (1, 1), and the lower right square has coordinates of (n, m).

On the first line output integer k — the minimum number of teleporters. Then output k lines each containing 4 integers x1 y1 x2 y2 (1 ≤ x1, x2 ≤ n, 1 ≤ y1, y2 ≤ m) — the coordinates of the square where the teleporter is installed (x1, y1), and the coordinates of the square where the teleporter leads (x2, y2). Then print nm + 1 lines containing 2 numbers each — the coordinates of the squares in the order in which they are visited by the king. The travel path must start and end at (1, 1). The king can move to side-neighboring squares and to the squares where a teleporter leads. Besides, he also should visit the capital exactly two times and he should visit other squares exactly one time.

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

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

runRead x s = fst $ runState x s

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

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

flipp = uncurry (flip zip) . unzip

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