You are given four distinct integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$. Timur and three other people are running a marathon. The value $$$a$$$ is the distance that Timur has run and $$$b$$$, $$$c$$$, $$$d$$$ correspond to the distances the other three participants ran. Output the number of participants in front of Timur.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of each test case consists of four distinct integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$ ($$$0 \leq a, b, c, d \leq 10^4$$$).

For each test case, output a single integer — the number of participants in front of Timur.

NoteFor the first test case, there are $$$2$$$ people in front of Timur, specifically the participants who ran distances of $$$3$$$ and $$$4$$$. The other participant is not in front of Timur because he ran a shorter distance than Timur.For the second test case, no one is in front of Timur, since he ran a distance of $$$10000$$$ while all others ran a distance of $$$0$$$, $$$1$$$, and $$$2$$$ respectively.For the third test case, only the second person is in front of Timur, who ran a total distance of $$$600$$$ while Timur ran a distance of $$$500$$$.

testcase :: [Int] -> Int
testcase xs = length . filter (\x -> x > a) $  xs
    where (a:_) = xs

solve :: [Int] -> [Int]
solve [] = []
solve xs = (testcase $ take 4 xs) : (solve $ drop 4 xs)

main = interact $ unlines . map show . solve . tail . map read . words

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

solve :: Int -> [Int] -> Int
solve _ [] = 0
solve n (x:xs) = if x > n then 1 + solve n xs else solve n xs

rep 0 = return ()
rep x = do
    t <- getLine
    -- print (words t)
    let arr = map (read :: String -> Int) (words t)
    let s = head arr
    print (solve s arr)
    rep (x-1)

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

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

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

cmp a b = if a < b then 1 else 0

solve :: SP Builder
solve = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    a <- getInt
    b <- getInt
    c <- getInt
    d <- getInt
    let x = (cmp a b) + (cmp a c) + (cmp a d)
    pure $ putInts $ [x]

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 solve inp
  P.putStr $ toLazyByteString outp

main :: IO ()
main = do
    t <- getLine >>= (return . (read :: String -> Int))
    let
       toInt str = (read :: String -> Int) str
       bigger b a = if a > b then 1 else 0
       work :: Int -> IO ()
       work n = do
           if n > 0 then do
               arr <- getLine >>= (return . words)
               a <- return $ toInt $ arr !! 0
               b <- return $ toInt $ arr !! 1
               c <- return $ toInt $ arr !! 2
               d <- return $ toInt $ arr !! 3
               putStrLn (show $ bigger a b + bigger a c + bigger a d)
               work $ n - 1
           else
               return ()
    work t

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad

solve = do
    s <- C.getLine

    let xs = map (fst . fromJust . C.readInt) (C.words s)

    C.putStrLn (C.pack $ show $ length $ filter (>(xs !! 0)) xs)

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) solve

module Main where

main = do
  tStr <- getLine
  input <- getContents
  mapM_ (print . solve) $ take (read tStr :: Int) $ lines input

solve :: String -> Int
solve s = sum $ map (fromEnum . (>a)) others
  where a:others = map read (words s) :: [Int]

module Main where

import Control.Monad (replicateM_)

getNumbers :: IO [Int]
getNumbers = map read . words <$> getLine

solution :: IO ()
solution = do
  [a, b, c, d] <- getNumbers
  print $ length $ filter (>= a) [b, c, d]

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

import Control.Monad (replicateM, replicateM_)
import Control.Monad.Identity (Identity)
import Control.Monad.Trans.State.Lazy (StateT, evalState, state)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char (isSpace)
import Data.Maybe (fromJust)

type ParserT = StateT C.ByteString

type Parser = ParserT Identity

main :: IO ()
main = do
  q <- fst . fromJust . C.readInt <$> C.getLine
  replicateM_ q solve

solve :: IO ()
solve = do
  (t : ts) <- evalState (replicateM 4 getInt) <$> C.getLine
  f . length . filter (> t) $ ts

getInt :: Parser Int
getInt = state $ fromJust . C.readInt . C.dropWhile isSpace

f :: Int -> IO ()
f = L.putStrLn . B.toLazyByteString . B.intDec

main :: IO ()
main = interact start

start :: String -> String
start s =
    let (_:tests) = lines s
     in unlines $ map (show . solve . parse) tests

parse :: String -> (Int, Int, Int, Int)
parse s =
    let [a, b, c, d] = map read $ words s
     in (a, b, c, d)

solve :: (Int, Int, Int, Int) -> Int
solve (a, b, c, d) = sum $ map (`isInFront` a) [b, c, d]

isInFront :: Int -> Int -> Int
isInFront a b = if a < b then 0 else 1

inp = "4\n2 3 4 1\n10000 0 1 2\n500 600 400 300\n0 9999 10000 9998\n"

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

check :: Int -> Int -> Int
check a b = if a < b
  then 1
  else 0

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  (a: b: c: d: _) <- readArr
  print $ check a b + check a c + check a d
  solve $ i - 1

main :: IO ()
main = do
  n <- readLn :: IO Int
  solve n

testcase :: [Int] -> Int
testcase xs = length . filter (\x -> x > a) $  xs
    where (a:_) = xs

solve :: [Int] -> [Int]
solve [] = []
solve xs = (testcase $ take 4 xs) : (solve $ drop 4 xs)

main = interact $ show . solve . tail . map read . words

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

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

cmp a b = if a < b then 1 else 0

solve :: SP Builder
solve = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    a <- getInt
    b <- getInt
    c <- getInt
    d <- getInt
    let x = (cmp a b) + (cmp a c) + (cmp a d)
    pure $ intDec x

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

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


You are given two integers $$$n$$$ and $$$m$$$. You have to construct the array $$$a$$$ of length $$$n$$$ consisting of non-negative integers (i.e. integers greater than or equal to zero) such that the sum of elements of this array is exactly $$$m$$$ and the value $$$\sum\limits_{i=1}^{n-1} |a_i - a_{i+1}|$$$ is the maximum possible. Recall that $$$|x|$$$ is the absolute value of $$$x$$$.In other words, you have to maximize the sum of absolute differences between adjacent (consecutive) elements. For example, if the array $$$a=[1, 3, 2, 5, 5, 0]$$$ then the value above for this array is $$$|1-3| + |3-2| + |2-5| + |5-5| + |5-0| = 2 + 1 + 3 + 0 + 5 = 11$$$. Note that this example doesn't show the optimal answer but it shows how the required value for some array is calculated.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^9$$$) — the length of the array and its sum correspondingly.

For each test case, print the answer — the maximum possible value of $$$\sum\limits_{i=1}^{n-1} |a_i - a_{i+1}|$$$ for the array $$$a$$$ consisting of $$$n$$$ non-negative integers with the sum $$$m$$$.

NoteIn the first test case of the example, the only possible array is $$$[100]$$$ and the answer is obviously $$$0$$$.In the second test case of the example, one of the possible arrays is $$$[2, 0]$$$ and the answer is $$$|2-0| = 2$$$.In the third test case of the example, one of the possible arrays is $$$[0, 2, 0, 3, 0]$$$ and the answer is $$$|0-2| + |2-0| + |0-3| + |3-0| = 10$$$.

import           Control.Arrow

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

solve [1,m] = 0
solve [2,m] = m
solve [_,m] = 2*m

import Control.Monad

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

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

solve :: Integer -> Integer -> Integer
solve n m
  | n == 1 = 0
  | n == 2 = m
  | otherwise = 2*m

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

onecase = do
		[n,k]<- map read <$> words <$> getLine::IO [Int]
		print $ if n==1 then 0 else if n==2 then k else k*2
main = do
	n<- read <$> getLine ::IO Int
	replicateM_ n onecase

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

sum':: [Integer] -> Integer
sum' xs = sum [abs (x - y) | (x, y) <- L.zip xs (tail xs)]

fun :: Integer -> Integer -> Integer
fun 1 _ = 0
fun 2 m = m
fun _ m = 2*m

parseInput :: String -> (Integer, Integer)
parseInput raw = (n, m)
                  where n = read n' :: Integer
                        m = read m' :: Integer
                        [n', m'] = words raw

solve :: String -> String
solve input = show (fun n m)
  where (n, m) = parseInput input

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


Mishka is trying really hard to avoid being kicked out of the university. In particular, he was doing absolutely nothing for the whole semester, miraculously passed some exams so that just one is left.There were $$$n$$$ classes of that subject during the semester and on $$$i$$$-th class professor mentioned some non-negative integer $$$a_i$$$ to the students. It turned out, the exam was to tell the whole sequence back to the professor. Sounds easy enough for those who attended every class, doesn't it?Obviously Mishka didn't attend any classes. However, professor left some clues on the values of $$$a$$$ to help out students like Mishka:   $$$a$$$ was sorted in non-decreasing order ($$$a_1 \le a_2 \le \dots \le a_n$$$);  $$$n$$$ was even;  the following sequence $$$b$$$, consisting of $$$\frac n 2$$$ elements, was formed and given out to students: $$$b_i = a_i + a_{n - i + 1}$$$. Professor also mentioned that any sequence $$$a$$$, which produces sequence $$$b$$$ with the presented technique, will be acceptable.Help Mishka to pass that last exam. Restore any sorted sequence $$$a$$$ of non-negative integers, which produces sequence $$$b$$$ with the presented technique. It is guaranteed that there exists at least one correct sequence $$$a$$$, which produces the given sequence $$$b$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the length of sequence $$$a$$$. $$$n$$$ is always even. The second line contains $$$\frac n 2$$$ integers $$$b_1, b_2, \dots, b_{\frac n 2}$$$ ($$$0 \le b_i \le 10^{18}$$$) — sequence $$$b$$$, where $$$b_i = a_i + a_{n - i + 1}$$$. It is guaranteed that there exists at least one correct sequence $$$a$$$, which produces the given sequence $$$b$$$.

Print $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^{18}$$$) in a single line. $$$a_1 \le a_2 \le \dots \le a_n$$$ should be satisfied. $$$b_i = a_i + a_{n - i + 1}$$$ should be satisfied for all valid $$$i$$$.

import Data.List

f::[Integer]->[Integer]->[Integer]->[Integer]
f [] xs ys=(reverse xs)++ys
f (x:xs) [] []=f xs (0:[]) (x:[])
f (x:xs) (l:ls) (r:rs)
       |(x-l)<=r=f xs (l:l:ls) ((x-l):r:rs)
       |otherwise=let t=x-r
                      t2=if l<=t then t else l
                  in f xs (t2:l:ls) ((x-t2):r:rs)

main = do
       e<-getLine
       es<-getLine
       let xs=map read (words es)::[Integer]
       putStrLn $ unwords $ map show $ f xs [] []


After a hard day Vitaly got very hungry and he wants to eat his favorite potato pie. But it's not that simple. Vitaly is in the first room of the house with n room located in a line and numbered starting from one from left to right. You can go from the first room to the second room, from the second room to the third room and so on — you can go from the (n - 1)-th room to the n-th room. Thus, you can go to room x only from room x - 1.The potato pie is located in the n-th room and Vitaly needs to go there. Each pair of consecutive rooms has a door between them. In order to go to room x from room x - 1, you need to open the door between the rooms with the corresponding key. In total the house has several types of doors (represented by uppercase Latin letters) and several types of keys (represented by lowercase Latin letters). The key of type t can open the door of type T if and only if t and T are the same letter, written in different cases. For example, key f can open door F.Each of the first n - 1 rooms contains exactly one key of some type that Vitaly can use to get to next rooms. Once the door is open with some key, Vitaly won't get the key from the keyhole but he will immediately run into the next room. In other words, each key can open no more than one door.Vitaly realizes that he may end up in some room without the key that opens the door to the next room. Before the start his run for the potato pie Vitaly can buy any number of keys of any type that is guaranteed to get to room n.Given the plan of the house, Vitaly wants to know what is the minimum number of keys he needs to buy to surely get to the room n, which has a delicious potato pie. Write a program that will help Vitaly find out this number.

The first line of the input contains a positive integer n (2 ≤ n ≤ 105) — the number of rooms in the house. The second line of the input contains string s of length 2·n - 2. Let's number the elements of the string from left to right, starting from one.  The odd positions in the given string s contain lowercase Latin letters — the types of the keys that lie in the corresponding rooms. Thus, each odd position i of the given string s contains a lowercase Latin letter — the type of the key that lies in room number (i + 1) / 2. The even positions in the given string contain uppercase Latin letters — the types of doors between the rooms. Thus, each even position i of the given string s contains an uppercase letter — the type of the door that leads from room i / 2 to room i / 2 + 1.

Print the only integer — the minimum number of keys that Vitaly needs to buy to surely get from room one to room n.

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

main :: IO ()
main = getLine >> getLine >>= print . solve 0 M.empty . map toLower

solve :: Int -> M.Map Char Int -> String -> Int
solve n m (y:z:ys) | y == z = solve n m ys
                   | M.findWithDefault 0 z m > 0 = solve n (M.insertWith (+) y 1 (M.adjust pred z m)) ys
                   | otherwise = solve (n + 1) (M.insertWith (+) y 1 m) ys
solve n _ _ = n

import Data.Char
import qualified Data.Map as M
main=getLine>>getLine>>=print.f M.empty.map toLower
f m (y:z:u)|M.findWithDefault 0 z b>0=f(M.adjust pred z b) u|1>0=1+f b u where b=M.insertWith(+)y 1 m
f _ _=0

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

main :: IO ()
main = getLine >> getLine >>= print . solve M.empty . map toLower

solve :: M.Map Char Int -> String -> Int
solve m (y:z:ys) | y == z = solve m ys
                 | M.findWithDefault 0 z m > 0 = solve (M.insertWith (+) y 1 (M.adjust pred z m)) ys
                 | otherwise = 1 + solve (M.insertWith (+) y 1 m) ys
solve _ _ = 0

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
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.Strict 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

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

solve cs = go 0 M.empty cs
   where
     go !res keys (k:c:rest)
       | Just v<-M.lookup (toLower c) keys', v > 0 = go res (M.adjust pred (toLower c) keys') rest
       | otherwise = go (res+1) keys' rest
      where
        !keys' = M.insertWith (+) k 1 keys
     go res _ _ = res

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
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 #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import Data.Char
import Data.List

o x = (ord x) - (ord 'a')

solve :: [Int] -> String -> Int
solve _ [] = 0
solve ks (k:d:ds)
    | k == d = solve ks ds
    | x > 0 = solve (l''++(z+1):r'') ds
    | otherwise = 1 + solve (l'++(y+1):r') ds
    where
        ks' = (l++(x-1):r)
        (l,x:r) = splitAt (o d) ks
        (l'',z:r'') = splitAt (o k) ks'
        (l',y:r') = splitAt (o k) ks

main = getLine >> getLine >>= print . solve (map (const 0) [1..26]) . map toLower

import Control.Applicative
import Data.List
import Data.Char

upd s bbc x = (take bbc s) ++[(s!!bbc)+x]  ++(drop  (bbc+1)  s)

process n s [] =n
process n s (a:b:cs) | a== bb   = process n s cs
                     | s!!bbc >0 = process n (upd (upd s bbc (-1)) aa 1) cs
                     | otherwise = process (n+1) (upd s aa 1) cs
		where bb = toLower b
                      bbc = ord bb - ord 'a'
	              aa = ord a - ord 'a'

main= do
	getLine
	s<- getLine
	print $ process 0 (replicate 26 0)  s

import Data.Char
import Data.List

minBalance :: String -> Char -> Int
minBalance s c = snd $ foldl' addChar (0, 0) s
    where
        addChar acc@(cur, low) x
            | x == c = (cur - 1, min (cur - 1) low)
            | x == toLower c = (cur + 1, low)
            | otherwise = acc

main = do
    _ <- getLine
    s <- getLine
    print $ sum $ map (abs . minBalance s) ['A'..'Z']

import Data.Char
import qualified Data.Map as M
main=getLine>>getLine>>=print.f M.empty.map toLower
f m (y:z:u)|M.findWithDefault 0 z b>0=f(M.adjust pred z b) u|1>0=1+f b u where b=M.insertWith(+)y 1 m;f _ _=0

import Data.Char
import Data.List

solve :: String -> String -> Int
solve _ [] = 0
solve ks (k:d:ds)
    | k == d = solve ks ds
    | d `elem` ks = solve (delete d ks) ds
    | otherwise  = 1 + solve (k:ks) ds

main = getLine >> getLine >>= print . solve [] . map toLower

import Data.Char
import Data.List

solve :: String -> String -> Int
solve _ [] = 0
solve ks (k:d:ds)
    | toUpper k == d = solve ks ds
    | toLower d `elem` ks = solve (delete k ks) ds
    | otherwise  = 1 + solve (k:ks) ds

main = getLine >> getLine >>= print . solve []

import Data.Char
import Data.List

o x = (ord x) - (ord 'a')

solve :: [Int] -> String -> Int
solve _ [] = 0
solve ks (k:d:ds)
    | k == d = solve ks ds
    | x > 0 = solve (l++(x-1):r) ds
    | otherwise = 1 + solve (l'++(y+1):r') ds
    where
        (l,x:r) = splitAt (o d) ks
        (l',y:r') = splitAt (o k) ks

main = getLine >> getLine >>= print . solve (map (const 0) [1..26]) . map toLower

import Control.Applicative
import Data.List
import Data.Char

upd s bbc x = (take (bbc-1) s) ++[(s!!bbc)+x]  ++(drop bbc s)

process n _ [] =n
process n s (a:b:cs) | a== bb   = process n s cs
                     | s!!bbc >0 = process n (upd s bbc (-1)) cs
                     | otherwise = process (n+1) (upd s bbc 1) cs
		where bb = toLower b
                      bbc = ord bb - ord 'a'

main= do
	getLine
	s<- getLine
	print $ process 0 (replicate 26 0)  s

import Control.Applicative
import Data.List
import Data.Char

upd s bbc x = (take (bbc-1) s) ++[(s!!bbc)+x]  ++(drop bbc s)

process n _ [] =n
process n s (a:b:cs) | a== bb   = process n s cs
                     | s!!bbc >0 = process n (upd s bbc (-1)) cs
                     | otherwise = process (n+1) (upd s aa 1) cs
		where bb = toLower b
                      bbc = ord bb - ord 'a'
	              aa = ord a - ord 'a'

main= do
	getLine
	s<- getLine
	print $ process 0 (replicate 26 0)  s

import Control.Applicative
import Data.List
import Data.Char

upd s bbc x = (take bbc s) ++[(s!!bbc)+x]  ++(drop  (bbc+1)  s)

process n s [] =n
process n s (a:b:cs) | a== bb   = process n s cs
                     | s!!bbc >0 = process n (upd s bbc (-1)) cs
                     | otherwise = process (n+1) (upd s aa 1) cs
		where bb = toLower b
                      bbc = ord bb - ord 'a'
	              aa = ord a - ord 'a'

main= do
	getLine
	s<- getLine
	print $ process 0 (replicate 26 0)  s


You are given a 0-1 rectangular matrix. What is the number of squares in it? A square is a solid square frame (border) with linewidth equal to 1. A square should be at least 2 × 2. We are only interested in two types of squares:   squares with each side parallel to a side of the matrix;  squares with each side parallel to a diagonal of the matrix. For example the following matrix contains only one square of the first type: 0000000 0111100 0100100 0100100 0111100The following matrix contains only one square of the second type:00000000010000010100000100000000000Regardless of type, a square must contain at least one 1 and can't touch (by side or corner) any foreign 1. Of course, the lengths of the sides of each square should be equal.How many squares are in the given matrix?

The first line contains integer t (1 ≤ t ≤ 10000), where t is the number of test cases in the input. Then test cases follow. Each case starts with a line containing integers n and m (2 ≤ n, m ≤ 250), where n is the number of rows and m is the number of columns. The following n lines contain m characters each (0 or 1). The total number of characters in all test cases doesn't exceed 106 for any input file.

You should output exactly t lines, with the answer to the i-th test case on the i-th line.

import Control.Monad (liftM, replicateM, replicateM_)
import Data.Array
import Data.List (intercalate)
import Prelude hiding (reads)

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

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

type Matrix  =  Array (Int, Int) Bool

readTest :: IO Matrix
readTest  =  do
    [n, m]  <-  reads
    ss  <-  replicateM n getLine
    return $ getMatrix n m ss
  where
    getMatrix n m ss  =  accumArray (||) False ((0, 0), (n+1, m+1)) [((i, j), ss !! (i-1) !! (j-1) == '1') | i <- [1..n], j <- [1..m]]

isLine :: Bool -> Matrix -> (Int, Int) -> (Int, Int) -> Bool
isLine flag array (i1, j1) (i2, j2)
    =  all (== flag)
        [array ! (i1 + dx*w, j1 + dy*w) | w <- [0 .. max (abs (i2-i1)) (abs (j2-j1))]]
  where
    dx  =  if not (dy == 0 || i2 == i1 || abs (i2 - i1) == abs (j2 - j1)) then error "" else signum (i2 - i1)
    dy  =  signum (j2 - j1)

isSquareI :: Bool -> Matrix -> (Int, Int) -> Int -> Bool
isSquareI _ _ _ 0  =  True
isSquareI flag array (i, j) size  =  and
  [
    isLine flag array (i, j) (i, j + size - 1),
    isLine flag array (i, j) (i + size - 1, j),
    isLine flag array (i, j + size - 1) (i + size - 1, j + size - 1),
    isLine flag array (i + size - 1, j) (i + size - 1, j + size - 1)
  ]

squaresI :: Matrix -> Int
squaresI a  =  length $ do
    i  <-  [1 .. n]
    j  <-  [1 .. m]
    if isTopLeftAngle i j
      then do
        let w  =  length $ takeWhile (\k -> a ! (i, k)) [j..]
        let h  =  length $ takeWhile (\k -> a ! (k, j)) [i..]
        if w > 1 && w == h && isSquare i j w
            then return (i, j, w)
            else fail ""
      else fail ""
  where
    n  =  fst (snd (bounds a)) - 1
    m  =  snd (snd (bounds a)) - 1
    isTopLeftAngle i j
      =  and [a ! (i, j), not (a ! (i-1, j)), not (a ! (i, j-1))]
    isSquare i j w
      =  isSquareI True a (i, j) w
      && isSquareI False a (i+1, j+1) (w-2)
      && isSquareI False a (i-1, j-1) (w+2)

isSquareII :: Bool -> Matrix -> (Int, Int) -> Int -> Bool
isSquareII _ _ _ 0  =  True
isSquareII flag array (i, j) w
  =  isLine flag array (i, j) (i + w - 1, j + w - 1)
  && isLine flag array (i+w-1,j+w-1) (i+2*w-2, j)
  && isLine flag array (i+2*w-2, j) (i+w-1,j-w+1)
  && isLine flag array (i+w-1,j-w+1) (i,j)

squaresII :: Matrix -> Int
squaresII a  =  length $ do
    i  <-  [1..n]
    j  <-  [1..m]
    if isTopAngle i j
        then do
            let w  =  length $ takeWhile (\k -> a ! (i+k, j+k)) [0..]
            let h  =  length $ takeWhile (\k -> a ! (i+k, j-k)) [0..]
            if w > 1 && h == w && isSquare i j w
                then return (i, j, w)
                else fail ""
        else fail ""
  where
    n  =  fst $ snd $ bounds a
    m  =  snd $ snd $ bounds a
    isTopAngle i j  =  and
        [a ! (i, j), not (a ! (i-1, j-1)), not (a ! (i-1, j+1))]
    isSquare i j w
      =  isSquareII True a (i, j) w
      && isSquareII False a (i-1, j) (w+1)
      && isLine False a (i-1, j+1) (i+w-2, j+w)
      && isLine False a (i-1, j-1) (i+w-2, j-w)
      && isLine False a (i+w, j-w) (i+2*w-1, j-1)
      && isLine False a (i+w, j+w) (i+2*w-1, j+1)
      && isSquareII False a (i+1, j) (w-1)
      && isSquareII False a (i+2, j) (w-2)

solve :: Matrix -> Int
solve array  =  squaresI array + squaresII array

main :: IO ()
main  =  do
    n  <-  readLn
    replicateM_ n (readTest >>= print . solve)

import Control.Monad (liftM, replicateM, replicateM_)
import Data.Array
import Data.List (intercalate)
import Prelude hiding (reads)

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

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

type Matrix  =  Array (Int, Int) Bool

readTest :: IO Matrix
readTest  =  do
    [n, m]  <-  reads
    ss  <-  replicateM n getLine
    return $ getMatrix n m ss
  where
    getMatrix n m ss  =  accumArray (||) False ((0, 0), (n+1, m+1)) [((i, j), ss !! (i-1) !! (j-1) == '1') | i <- [1..n], j <- [1..m]]

isLine :: Bool -> Matrix -> (Int, Int) -> (Int, Int) -> Bool
isLine flag array (i1, j1) (i2, j2)
    =  all (== flag)
        [array ! (i1 + dx*w, j1 + dy*w) | w <- [0 .. max (abs (i2-i1)) (abs (j2-j1))]]
  where
    dx  =  signum (i2 - i1)
    dy  =  signum (j2 - j1)

isSquareI :: Bool -> Matrix -> (Int, Int) -> Int -> Bool
isSquareI _ _ _ 0  =  True
isSquareI flag array (i, j) size  =  and
  [
    isLine flag array (i, j) (i, j + size - 1),
    isLine flag array (i, j) (i + size - 1, j),
    isLine flag array (i, j + size - 1) (i + size - 1, j + size - 1),
    isLine flag array (i + size - 1, j) (i + size - 1, j + size - 1)
  ]

squaresI :: Matrix -> Int
squaresI a  =  length $ do
    i  <-  [1 .. n]
    j  <-  [1 .. m]
    if isTopLeftAngle i j
      then do
        let w  =  length $ takeWhile (\k -> a ! (i, k)) [j..]
        let h  =  length $ takeWhile (\k -> a ! (k, j)) [i..]
        if w > 1 && w == h && isSquare i j w
            then return (i, j, w)
            else fail ""
      else fail ""
  where
    n  =  fst (snd (bounds a)) - 1
    m  =  snd (snd (bounds a)) - 1
    isTopLeftAngle i j
      =  and [a ! (i, j), not (a ! (i-1, j)), not (a ! (i, j-1))]
    isSquare i j w
      =  isSquareI True a (i, j) w
      && isSquareI False a (i+1, j+1) (w-2)
      && isSquareI False a (i-1, j-1) (w+2)

isSquareII :: Bool -> Matrix -> (Int, Int) -> Int -> Bool
isSquareII _ _ _ 0  =  True
isSquareII flag array (i, j) w
  =  isLine flag array (i, j) (i + w - 1, j + w - 1)
  && isLine flag array (i+w-1,j+w-1) (i+2*w-2, j)
  && isLine flag array (i+2*w-2, j) (i+w-1,j-w+1)
  && isLine flag array (i+w-1,j-w+1) (i,j)

squaresII :: Matrix -> Int
squaresII a  =  length $ do
    i  <-  [1..n]
    j  <-  [1..m]
    if isTopAngle i j
        then do
            let w  =  length $ takeWhile (\k -> a ! (i+k, j+k)) [0..]
            let h  =  length $ takeWhile (\k -> a ! (i+k, j-k)) [0..]
            if w > 1 && h == w && isSquare i j w
                then return (i, j, w)
                else fail ""
        else fail ""
  where
    n  =  fst $ snd $ bounds a
    m  =  snd $ snd $ bounds a
    isTopAngle i j  =  and
        [a ! (i, j), not (a ! (i-1, j-1)), not (a ! (i-1, j+1))]
    isSquare i j w
      =  isSquareII True a (i, j) w
      && isSquareII False a (i-1, j) w
      && isLine False a (i-1, j+1) (i+w-2, j+w)
      && isLine False a (i-1, j-1) (i+w-2, j-w)
      && isLine False a (i+w, j-w) (i+2*w-1, j-1)
      && isLine False a (i+w, j+w) (i+2*w-1, j+1)
      && isSquareII False a (i+1, j) (w-1)
      && isSquareII False a (i+2, j) (w-2)

solve :: Matrix -> Int
solve array  =  squaresI array + squaresII array

main :: IO ()
main  =  do
    n  <-  readLn
    replicateM_ n (readTest >>= print . solve)


Suppose you have two polynomials  and . Then polynomial  can be uniquely represented in the following way:This can be done using long division. Here,  denotes the degree of polynomial P(x).  is called the remainder of division of polynomial  by polynomial , it is also denoted as . Since there is a way to divide polynomials with remainder, we can define Euclid's algorithm of finding the greatest common divisor of two polynomials. The algorithm takes two polynomials . If the polynomial  is zero, the result is , otherwise the result is the value the algorithm returns for pair . On each step the degree of the second argument decreases, so the algorithm works in finite number of steps. But how large that number could be? You are to answer this question. You are given an integer n. You have to build two polynomials with degrees not greater than n, such that their coefficients are integers not exceeding 1 by their absolute value, the leading coefficients (ones with the greatest power of x) are equal to one, and the described Euclid's algorithm performs exactly n steps finding their greatest common divisor. Moreover, the degree of the first polynomial should be greater than the degree of the second. By a step of the algorithm we mean the transition from pair  to pair .

You are given a single integer n (1 ≤ n ≤ 150) — the number of steps of the algorithm you need to reach.

Print two polynomials in the following format. In the first line print a single integer m (0 ≤ m ≤ n) — the degree of the polynomial.  In the second line print m + 1 integers between  - 1 and 1 — the coefficients of the polynomial, from constant to leading.  The degree of the first polynomial should be greater than the degree of the second polynomial, the leading coefficients should be equal to 1. Euclid's algorithm should perform exactly n steps when called using these polynomials. If there is no answer for the given n, print -1. If there are multiple answer, print any of them.

NoteIn the second example you can print polynomials x2 - 1 and x. The sequence of transitions is(x2 - 1, x) → (x,  - 1) → ( - 1, 0).There are two steps in it.

type Poly = [Int]

add :: Poly -> Poly -> Poly
add p q = map (\(x,y) -> mod (x + y) 2) $ zip (p ++ replicate (l - length p) 0) (q ++ replicate (l - length q) 0) where l = max (length p) (length q)

genPoly :: Poly -> Poly -> Poly
genPoly p q = ([0] ++ p) `add` q

infList = [[1], [0,1]] ++ goInf [1] [0,1]
          where goInf q p = [r] ++ goInf p r
                  where r = genPoly p q

sPoly :: Poly -> String
sPoly [] = ""
sPoly (x:xs) = (show x) ++ " " ++ sPoly xs

main = do
        n_ <- getLine
        let n = read n_ :: Int
        print n
        putStrLn $ sPoly $ infList !! n
        print (n - 1)
        putStrLn $ sPoly $ infList !! (n-1)

{-# LANGUAGE BangPatterns #-}

type Poly = [Rational]

normPoly :: Poly -> Poly
normPoly p = reverse $ delz $ reverse p
             where delz :: Poly -> Poly
                   delz [] = []
                   delz a@(x:xs) = if x == 0 then delz xs else a

minus :: Poly -> Poly -> Poly
minus p q = map (\(x,y) -> x - y) $ zip p q

add :: Poly -> Poly -> Poly
add p q = map (\(x,y) -> fromIntegral $ mod (floor x + floor y) 2) $ zip (p ++ replicate (l - length p) 0) (q ++ replicate (l - length q) 0) where l = max (length p) (length q)

remPoly :: Poly -> Poly -> Poly
remPoly p q
    | null q                     = undefined
    | null p                     = []
    | last p == 0 || last q == 0 = remPoly (normPoly p) (normPoly q)
    | length p < length q        = p
    | otherwise                  = let dp = length p - 1
                                       dq = length q - 1
                                       lp = last p
                                       lq = last q
                                       q' = replicate (dp - dq) 0 ++ map (* (lp/lq)) q
                                   in remPoly (p `minus` q') q

gcdPoly :: Poly -> Poly -> Int
gcdPoly p q
    | null p || null q = 0
    | otherwise        = 1 + gcdPoly q (p `remPoly` q)

genPoly :: Poly -> Poly -> Poly
genPoly p q = ([0] ++ p) `add` q

infList = [[1], [0,1]] ++ goInf [1] [0,1]
          where goInf q p = [r] ++ goInf p r
                  where r = genPoly p q

sPoly :: Poly -> String
sPoly [] = ""
sPoly (x:xs) = (show $ floor x) ++ " " ++ sPoly xs

main = do
        n_ <- getLine
        let n = read n_ :: Int
        print n
        putStrLn $ sPoly $ infList !! n
        print (n - 1)
        putStrLn $ sPoly $ infList !! (n-1)

import Data.List

vectorAdd :: [Int] -> [Int] -> [Int]
vectorAdd [] y = y
vectorAdd x [] = x
vectorAdd (a:x) (b:y) = mod (a + b) 2 : vectorAdd x y

f :: Int -> [Int] -> [Int] -> [Int]
f 0 a b = a
f 1 a b = b
f n a b = f (n-1) b $ vectorAdd a (0:b)

fib n = f n [1] [0,1]

toString xs = concat $ intersperse " " $ map (show :: Int -> String) xs

main = do
    line <- getLine
    print (read line :: Int)
    putStrLn (toString (fib (read line :: Int)))
    print (pred $ read line :: Int)
    putStrLn (toString (fib $ pred (read line :: Int)))


There are $$$n$$$ coins labeled from $$$1$$$ to $$$n$$$. Initially, coin $$$c_i$$$ is on position $$$i$$$ and is facing upwards (($$$c_1, c_2, \dots, c_n)$$$ is a permutation of numbers from $$$1$$$ to $$$n$$$). You can do some operations on these coins. In one operation, you can do the following:Choose $$$2$$$ distinct indices $$$i$$$ and $$$j$$$.Then, swap the coins on positions $$$i$$$ and $$$j$$$.Then, flip both coins on positions $$$i$$$ and $$$j$$$. (If they are initially faced up, they will be faced down after the operation and vice versa)Construct a sequence of at most $$$n+1$$$ operations such that after performing all these operations the coin $$$i$$$ will be on position $$$i$$$ at the end, facing up.Note that you do not need to minimize the number of operations.

The first line contains an integer $$$n$$$ ($$$3 \leq n \leq 2 \cdot 10^5$$$) — the number of coins. The second line contains $$$n$$$ integers $$$c_1,c_2,\dots,c_n$$$ ($$$1 \le c_i \le n$$$, $$$c_i \neq c_j$$$ for $$$i\neq j$$$).

In the first line, output an integer $$$q$$$ $$$(0 \leq q \leq n+1)$$$ — the number of operations you used. In the following $$$q$$$ lines, output two integers $$$i$$$ and $$$j$$$ $$$(1 \leq i, j \leq n, i \ne j)$$$ — the positions you chose for the current operation.

NoteLet coin $$$i$$$ facing upwards be denoted as $$$i$$$ and coin $$$i$$$ facing downwards be denoted as $$$-i$$$.The series of moves performed in the first sample changes the coins as such:  $$$[~~~2,~~~1,~~~3]$$$  $$$[-3,~~~1,-2]$$$  $$$[-3,~~~2,-1]$$$  $$$[~~~1,~~~2,~~~3]$$$ In the second sample, the coins are already in their correct positions so there is no need to swap.

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

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

import Data.Array.Unboxed
import Data.Array.ST.Safe
import qualified Control.Monad.ST.Lazy as L

cycles :: UArray Int Int -> [[Int]]
cycles fun = let
  go :: Int -> Int -> [Int]
  go startIx ix = ix : let
    next = fun ! ix
    in  if  next == startIx  then  []  else  go startIx next
  tryGo :: STUArray s Int Bool -> Int -> L.ST s ([[Int]] -> [[Int]])
  tryGo vis ix = do
    skip <- L.strictToLazyST $ readArray vis ix
    if  skip
      then  pure id
      else  do
      let  res = go ix ix
      L.strictToLazyST $ forM_ res $ \i -> writeArray vis i True
      pure (res :)
  in  L.runST $ do
  vis <- L.strictToLazyST $ newArray (bounds fun) False
  foldr (<*>) (pure []) $ map (tryGo vis) $ range $ bounds fun

getSpare :: Int -> Int -> Int
getSpare p q = head [x | x <- [1..3], x /= p && x /= q]

solve :: [[Int]] -> [(Int, Int)]
solve ((x:xs) : (y:ys) : later)
  = (x, y) : map ((,) x) ys ++ map ((,) y) xs ++ (x, y) : solve later
solve [[x, y]] = let
  z = getSpare x y
  in  [(x, z), (y, z), (x, z)]
solve [x : y : z : rest]
  = (y, z) : map ((,) y) rest ++ [(x, z), (x, y), (y, z)]
solve [] = []
solve _ = error "expected only proper cycles"

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  c <- readInts
  let  ans = solve $ filter ((> 1) . length) $ cycles $ listArray (1, n) c
  putInts [length ans]
  forM_ ans $ \(x, y) -> putInts [x, y]

type SIO = StateT P.ByteString IO

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

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

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


Gerald has n younger brothers and their number happens to be even. One day he bought n2 candy bags. One bag has one candy, one bag has two candies, one bag has three candies and so on. In fact, for each integer k from 1 to n2 he has exactly one bag with k candies. Help him give n bags of candies to each brother so that all brothers got the same number of candies.

The single line contains a single integer n (n is even, 2 ≤ n ≤ 100) — the number of Gerald's brothers.

Let's assume that Gerald indexes his brothers with numbers from 1 to n. You need to print n lines, on the i-th line print n integers — the numbers of candies in the bags for the i-th brother. Naturally, all these numbers should be distinct and be within limits from 1 to n2. You can print the numbers in the lines in any order.  It is guaranteed that the solution exists at the given limits.

NoteThe sample shows Gerald's actions if he has two brothers. In this case, his bags contain 1, 2, 3 and 4 candies. He can give the bags with 1 and 4 candies to one brother and the bags with 2 and 3 to the other brother.

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

  let ps = unfoldr (\xs -> if null xs then Nothing else Just $ splitAt n xs) $ concat $ zipWith (\a b -> [a, b]) [1..n^2`div`2] $ reverse [n^2`div`2..n^2]

  putStr $ unlines $ map (unwords . map show) ps

import Data.List
import Control.Monad
showL = concat . intersperse " " . map show

f _ [] [] = [ return ()]
f n a b =
    let m = n `div` 2
        (ha,ta) = splitAt m a
        (hb,tb) = splitAt m b
    in (putStrLn $ showL ha ++ " " ++ showL hb) : f n ta tb

main = do
    n <- readLn :: IO Int
    let m = n^2`div`2
    sequence_ $ f n [m,m-1..1] [m+1..n*n]

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

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

solve :: Int -> [[Int]]
solve n  =  map (solve' 1) [1..n]
  where
    solve' j i
      | j > n   =  []
      | odd j   =  ((j - 1) * n + i) : solve' (j + 1) i
      | even j  =  (j * n - (i - 1)) : solve' (j + 1) i

print' :: [[Int]] -> IO ()
print' xs  =  mapM_ (\x -> putStrLn $ intercalate " " $ map show x) xs

main :: IO ()
main  =  do
    --n  <-  liftM (read . head . words) $ readFile "input.txt"
    n  <-  readLn
    print' $ solve n

import Control.Applicative

main = answer.read <$> getLine >>= mapM_ (putStrLn.show')

show' = tail.foldl (\x y -> x++(' ':show y)) []

answer :: Int -> [[Int]]
answer n = distribute (div n 2) [1..div (n^2) 2]

distribute :: Int -> [Int] -> [[Int]]
distribute  _ [] = []
distribute k xs = [ps++ps']++(distribute k $ drop k xs)  where
	ps = take k xs
	ps' = map (\x -> (k*2)^2-x+1) ps

import qualified Data.ByteString.Lazy.Char8 as B
import Control.Applicative

main = do
  n <- read <$> getLine :: IO Int
  let n2 = n*n
      sol = concat [[j,n2-j+1] | j <- [1..(n2 `div` 2 )]]
  println n 1 sol

println _ _ []     = return ()
println n i (x:xs) = do
  if rem i n == 0
  then print x
  else putStr $ show x ++ " "
  println n (i+1) xs

import Data.List

solve :: Int -> [[Int]]
solve n = take n $ map (concatMap pairToList) $ splitIn (n `div` 2) xs
  where m = n ^ 2
        xs = zip [1 .. m] (reverse [1 .. m])

pairToList :: (a, a) -> [a]
pairToList (x, y) = [x, y]

splitIn :: Int -> [a] -> [[a]]
splitIn _ [] = []
splitIn n xs = let (left, right) = splitAt n xs
               in left:splitIn n right

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

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

solve :: Integer -> [[Integer]]
solve n = [ [ k, k + n .. a `div` 2 - n + k ] ++ [ b - k, b + n - k .. a + 1 - k ] | k <- [1..n] ]
  where a = n * n; b = a - a `div` 2 + n + 1

import Data.List (unfoldr)

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

solve :: Int -> [[Int]]
solve n = map concat $ splitN (n `div` 2) $ map (\x -> [ x, n * n + 1 - x ]) [1 .. n * n `div` 2]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

import Data.List
main = interact $ unlines . map (unwords . map show) . solve . read
solve n = transpose $ zipWith ($) (cycle [id,reverse]) $ chunksOf n [1..n^2]
chunksOf n = go where
  go [] = []
  go xs = l : go r where (l,r) = splitAt n xs

import Data.List (intercalate)

string2int str = (read str :: Int)
get_nxn x = [1..x^2]

solve n [] = []
solve n a = do
    (take n a) ++ (take n $ reverse a) ++ (solve n $ (reverse $ drop n $ reverse $ drop n a))

main :: IO ()
main = do
    str <- getLine
    putStrLn $ intercalate " " (map show $ solve (floor ((fromIntegral (string2int str)) / (fromIntegral (2 :: Int)))) $ (get_nxn $ string2int str))

import Control.Applicative
import Data.List

main = do
    n <- read <$> getLine
    let xxs = solve n
    mapM_ (putStrLn . intercalate " " . map show) xxs

solve :: Int -> [[Int]]
solve n = map (\x -> [x, n^2-x+1]) [1 .. n^2 `div` 2]

solve :: Int -> [[Int]]
solve n = [ solveLine n i  | i <- [1..n] ]

solveLine n i = [ 1 + ((i+j) `mod` n) + (j-1) * n | j <- [1..n]]

main :: IO ()
main = do nSt <- getLine
          let res = solve (read nSt :: Int)
              resSt = map (\ls -> (map (\x -> (show x)) ls)) res
          putStr $ unlines (map unwords resSt)

import Data.List
main=interact$unlines.map(unwords.map show).f.read
f :: Int -> [[Int]]
f n=transpose.zipWith($)(cycle [id,reverse]) $ slices n[1..n*n]

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

import Control.Applicative
import Data.List

chunks x [] = []
chunks x n = (take x n) : (chunks x ( drop x n))

altrev [] = []
altrev (x:y:zs) = (x:(reverse y) : (altrev zs))

myprint x1 = putStrLn $ intercalate " " $ map show x1

main= do
	n<-  read <$> getLine  ::IO Int
	let x=  transpose $ altrev $ chunks n [1..n*n]
	mapM_  myprint x

-- Candy bags

main :: IO ()
main = fmap read getLine >>= putStrLn . prettyPrint . rush

prettyPrint :: [[Int]] -> String
prettyPrint = unlines . map (unwords . map show)

rush :: Int -> [[Int]]
rush n = map f [1..n]
  where f x = [((x - 1)*h + 1)..(x*h)] ++ [(ns - x * h + 1)..(ns - (x - 1) * h)]
        h = n `div` 2
        ns = n * n

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

  let ps = zip [1..n] $ reverse [n+1..n^2]

  putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) ps

import Data.List
import Control.Monad
f n = zipWith (\a b -> show a ++ " " ++ show b) [n,n-1..1] [n+1..]
main = mapM_ putStrLn . f =<< (readLn :: IO Int)

import Data.List

solve n = (uncurry zip) ys
  where m = n ^ 2
        xs = splitAt n [1 .. m]
        ys = (fst xs, reverse $ snd xs)

showPair (x, y) = show x ++ " " ++ show y

main = interact $ unlines . map showPair . solve . read


There are times you recall a good old friend and everything you've come through together. Luckily there are social networks — they store all your message history making it easy to know what you argued over 10 years ago.More formal, your message history is a sequence of messages ordered by time sent numbered from 1 to n where n is the total number of messages in the chat.Each message might contain a link to an earlier message which it is a reply to. When opening a message x or getting a link to it, the dialogue is shown in such a way that k previous messages, message x and k next messages are visible (with respect to message x). In case there are less than k messages somewhere, they are yet all shown.Digging deep into your message history, you always read all visible messages and then go by the link in the current message x (if there is one) and continue reading in the same manner.Determine the number of messages you'll read if your start from message number t for all t from 1 to n. Calculate these numbers independently. If you start with message x, the initial configuration is x itself, k previous and k next messages. Messages read multiple times are considered as one.

The first line contains two integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ n) — the total amount of messages and the number of previous and next messages visible. The second line features a sequence of integers a1, a2, ..., an (0 ≤ ai < i), where ai denotes the i-th message link destination or zero, if there's no link from i. All messages are listed in chronological order. It's guaranteed that the link from message x goes to message with number strictly less than x.

Print n integers with i-th denoting the number of distinct messages you can read starting from message i and traversing the links while possible.

NoteConsider i = 6 in sample case one. You will read message 6, then 2, then 1 and then there will be no link to go.In the second sample case i = 6 gives you messages 5, 6, 7 since k = 1, then 4, 5, 6, then 2, 3, 4 and then the link sequence breaks. The number of distinct messages here is equal to 6.

{-# LANGUAGE OverloadedStrings #-}

import Data.List (foldl')
import Data.Functor
import Data.Array.Unboxed
import Data.Maybe

import qualified Data.ByteString.Char8 as B

interval n k x = (max 1 $ x - k, min n $ x + k)

ilength (l, r) = r - l + 1

intersect l r = intersect' (min l r) (max l r)
    where intersect' (l1, r1) (l2, r2)
              | r1 < l2 = Nothing
              | otherwise = Just (min l1 l2, max r1 r2)

-- first fake (0, 0) interval adds its length of 1 to result, hence the need to subtract it
readMessages k links x = let (p, l) = foldl' intersect' ((0, 0), 0) $ generate x in ilength p + l - 1
    where
        n = snd $ bounds links
        intersect' (p, l) p' = case intersect p p' of
                                   Just p'' -> (p'', l)
                                   Nothing  -> (p', l + ilength p)
        generate x = case links ! x of
                         0  -> [interval n k x]
                         x' -> (interval n k x) : generate x'

getResult k links = map (readMessages k links) $ indices links

main = do
    n:k:xs <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    links' <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    let links = listArray (1, n) links' :: UArray Int Int

    putStrLn $ unwords $ map show $ getResult k links


You are given two arrays of length $$$n$$$: $$$a_1, a_2, \dots, a_n$$$ and $$$b_1, b_2, \dots, b_n$$$.You can perform the following operation any number of times:   Choose integer index $$$i$$$ ($$$1 \le i \le n$$$);  Swap $$$a_i$$$ and $$$b_i$$$. What is the minimum possible sum $$$|a_1 - a_2| + |a_2 - a_3| + \dots + |a_{n-1} - a_n|$$$ $$$+$$$ $$$|b_1 - b_2| + |b_2 - b_3| + \dots + |b_{n-1} - b_n|$$$ (in other words, $$$\sum\limits_{i=1}^{n - 1}{\left(|a_i - a_{i+1}| + |b_i - b_{i+1}|\right)}$$$) you can achieve after performing several (possibly, zero) operations?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 4000$$$) — the number of test cases. Then, $$$t$$$ test cases follow. The first line of each test case contains the single integer $$$n$$$ ($$$2 \le n \le 25$$$) — the length of arrays $$$a$$$ and $$$b$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the array $$$a$$$. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le 10^9$$$) — the array $$$b$$$.

For each test case, print one integer — the minimum possible sum $$$\sum\limits_{i=1}^{n-1}{\left(|a_i - a_{i+1}| + |b_i - b_{i+1}|\right)}$$$.

NoteIn the first test case, we can, for example, swap $$$a_3$$$ with $$$b_3$$$ and $$$a_4$$$ with $$$b_4$$$. We'll get arrays $$$a = [3, 3, 3, 3]$$$ and $$$b = [10, 10, 10, 10]$$$ with sum $$$3 \cdot |3 - 3| + 3 \cdot |10 - 10| = 0$$$.In the second test case, arrays already have minimum sum (described above) equal to $$$|1 - 2| + \dots + |4 - 5| + |6 - 7| + \dots + |9 - 10|$$$ $$$= 4 + 4 = 8$$$.In the third test case, we can, for example, swap $$$a_5$$$ and $$$b_5$$$.

{-# LANGUAGE TypeApplications, BlockArguments, OverloadedLists #-}

module Main where

import           Prelude                 hiding ( drop, length, take, zipWith )
import           Data.Maybe
import           Data.Functor
import           Data.Sequence           hiding ( replicateM )
import           Control.Monad
import           Control.Monad.State

calc :: Seq Int -> Int
calc a = sum $ zipWith (\x y -> abs (x - y)) a (drop 1 a)

calc' :: Int -> Int -> Int
calc' x y = abs (x - y)

swap :: Int -> Seq Int -> Seq Int -> (Seq Int, Seq Int)
swap n a b =
  ( take n a >< [fromJust $ b !? n] >< drop (n + 1) a
  , take n b >< [fromJust $ a !? n] >< drop (n + 1) b
  )

aB :: State (Seq Int, Seq Int, Int) Int
aB = get >>= \(a, b, i) -> if i == length a - 1
  then return $ calc a + calc b
  else
    let [t1, t1', t2, t2'] = map fromJust [a !? i, a !? (i + 1), b !? i, b !? (i + 1)]
    in  if calc' t1 t1' + calc' t2 t2' <= calc' t1 t2' + calc' t2 t1'
          then put (a, b, i + 1) >> aB
          else let (a', b') = swap (i + 1) a b
               in  put (a', b', i + 1) >> aB

getInput :: Int -> IO [(Seq Int, Seq Int)]
getInput = flip replicateM $ getLine >> do
  a <- getLine <&> words <&> map (read @Int) <&> fromList
  b <- getLine <&> words <&> map (read @Int) <&> fromList
  return (a, b)

main :: IO ()
main = getLine <&> read @Int
     >>= getInput
     >>= mapM_ (\(a, b) -> print $ evalState aB (a, b, 0))

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

parseInt :: (Integral a) => C.ByteString -> a
parseInt = fromIntegral . fst . fromJust . C.readInt

getInts :: (Integral a) => IO [a]
getInts = map parseInt . C.words <$> C.getLine

calc :: [(Int64, Int64)] -> Int64
calc [] = 0
calc (_ : []) = 0
calc ((a1, b1) : (a2, b2) : rest) = current + calc ((a2, b2) : rest)
  where current = min (abs (a1 - a2) + abs (b1 - b2)) (abs (a1 - b2) + abs (a2 - b1))

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    _ <- C.getLine
    as <- getInts
    bs <- getInts
    return $ int64Dec (calc $ zip as bs) <> charUtf8 '\n'
  hPutBuilder stdout output


Given an array of integer $$$a_1, a_2, \ldots, a_n$$$. In one operation you can make $$$a_i := a_i + 1$$$ if $$$i < n$$$ and $$$a_i \leq a_{i + 1}$$$, or $$$i = n$$$ and $$$a_i \leq a_1$$$.You need to check whether the array $$$a_1, a_2, \ldots, a_n$$$ can become equal to the array $$$b_1, b_2, \ldots, b_n$$$ in some number of operations (possibly, zero). Two arrays $$$a$$$ and $$$b$$$ of length $$$n$$$ are called equal if $$$a_i = b_i$$$ for all integers $$$i$$$ from $$$1$$$ to $$$n$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 4 \cdot 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) – the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) – the elements of the array $$$a$$$. The third line of each test case contains $$$n$$$ integers $$$b_1, \ldots, b_n$$$ ($$$1 \le b_i \le 10^9$$$) – the elements of the array $$$b$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output "YES" if you can get the array $$$b$$$, otherwise output "NO". You may print each letter in any case (for example, "YES", "Yes", "yes", "yEs" will all be recognized as positive answer).

NoteIn the first test case, the array $$$a$$$ is already equal to the array $$$b$$$.In the second test case, we can't get the array $$$b$$$, because to do this we need to decrease $$$a_1$$$.In the fifth test case, we can apply operations in order to the elements with indices $$$4, 3, 3,2,2,2,1,1,1,1$$$, and then get the array $$$[5,5,5,5,5]$$$. After that, you can apply operations in order to elements with indices $$$5,4,4,3,1$$$ and already get an array $$$[6,5,6,7,6]$$$.

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- compab.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large.txt | time ./a.out)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large-7.txt | time ./a.out)

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

ri = readInts <$> B.getLine
  where
    readInts  = unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

showYN False = "NO"
showYN True  = "YES"

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        _n <- B.getLine
        replicateM 2 ri
    mapM_ (putStrLn.showYN.solve) tcs

solve [as, bs] = and (zipWith isPossible as bbs)
  where
    bbs = zip bs (tail bs ++ [head bs])

    isPossible a (b, bnext) = (a == b) || ((a < b) && (b <= bnext + 1))
solve _ =
    error "Bad input reading"

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- compab.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large.txt | time ./a.out)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large-7.txt | time ./a.out)

import           Prelude                    ((+), error)
import qualified System.IO             as S
import           Control.Arrow
import qualified Control.Monad         as M
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Eq
import           Data.Function
import           Data.Functor
import           Data.Int
import           Data.List                  ((++))
import qualified Data.List             as L
import           Data.Ord

mapM_      = M.mapM_
putStrLn   = S.putStrLn
replicateM = M.replicateM

dropSpace = B.dropWhile isSpace

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

showYN False = "NO"
showYN True  = "YES"

main :: S.IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        _n <- B.getLine
        replicateM 2 ri
    mapM_ (putStrLn.showYN.solve) tcs

solve [as, bs] = L.and (L.zipWith isPossible as bbs)
  where
    bbs = L.zip bs (L.tail bs ++ [L.head bs])

    isPossible a (b, bnext) = (a == b) || ((a < b) && (b <= bnext + 1))
solve _ =
    error "Bad input reading"

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- compab.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large.txt | time ./a.out)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out compab.hs  &&  set -o pipefail  &&  cat -- input-large-7.txt | time ./a.out)

import           Prelude                    ((+), error)
import qualified System.IO             as S
import           Control.Arrow
import qualified Control.Monad         as M
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Eq
import           Data.Function
import           Data.Functor
import           Data.Int
import           Data.List                  ((++))
import qualified Data.List             as L
import           Data.Ord

mapM_      = M.mapM_
putStrLn   = S.putStrLn
replicateM = M.replicateM

dropSpace = B.dropWhile isSpace

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

showYN False = "NO"
showYN True  = "YES"

main :: S.IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        _n <- B.getLine
        replicateM 2 ri
    mapM_ (putStrLn.showYN.solve) tcs

solve [as, bs] = L.and (L.zipWith isPossible as bbs)
  where
    bbs = L.zip bs (L.tail bs ++ [L.head bs])

    isPossible a (b, bnext) = (a == b) || ((a < b) && (b <= bnext + 1))
solve _ =
    error "Bad input reading"

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- compab.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import System.IO
import Control.Monad

ri = map read . words <$> getLine :: IO [Int]

showYN False = "NO"
showYN True  = "YES"

main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n] <- ri
        replicateM 2 ri
    mapM_ (putStrLn.showYN.solve) tcs

solve [as, bs] = and (zipWith isPossible as bbs)
  where
    bbs = zip bs (tail bs ++ [last bs])

    isPossible a (b, bnext) = (a == b) || ((a < b) && (b <= bnext + 1))


You are given a sequence $$$a_1, a_2, \dots, a_n$$$ consisting of $$$n$$$ non-zero integers (i.e. $$$a_i \ne 0$$$). You have to calculate two following values:  the number of pairs of indices $$$(l, r)$$$ $$$(l \le r)$$$ such that $$$a_l \cdot a_{l + 1} \dots a_{r - 1} \cdot a_r$$$ is negative;  the number of pairs of indices $$$(l, r)$$$ $$$(l \le r)$$$ such that $$$a_l \cdot a_{l + 1} \dots a_{r - 1} \cdot a_r$$$ is positive;

The first line contains one integer $$$n$$$ $$$(1 \le n \le 2 \cdot 10^{5})$$$ — the number of elements in the sequence. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(-10^{9} \le a_i \le 10^{9}; a_i \neq 0)$$$ — the elements of the sequence.

Print two integers — the number of subsegments with negative product and the number of subsegments with positive product, respectively.

solve :: [Integer] -> [Integer]
solve array = let runDP [] res _ = res
                  runDP (x:xs) [prevN, prevP] [negTllLst, posTllLst] =
                    let [negTllCur, posTllCur] = if x > 0 then [negTllLst, posTllLst + 1]
                                                          else [posTllLst + 1, negTllLst]
                    in runDP xs [prevN + negTllCur, prevP + posTllCur] [negTllCur, posTllCur]
              in runDP array [0,0] [0,0]

main :: IO ()
main = interact $ (++ "\n") . unwords . map show . solve . map read . tail . words

import Data.List

f (p, n, p', n') x | (x == 1)  = (p + 1, n, p + p', n + n')
                   | otherwise = (n, p + 1, p + p', n + n')

task x = show (n + n') ++ " " ++ show (p + p') where (p, n, p', n') = foldl' f (0, 0, 0, 0) x

main = getContents >>= putStr . task . map (\i -> signum $ read i::Integer) . words . head . tail . lines

{-
  Copyright (c) 2019 Islam Omar
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-Ofast #-}

import Control.Monad (foldM, forM, forM_, join, replicateM_, when)
import Control.Monad.ST
import Control.Monad.State.Strict

-- import           Data.Array.MArray.Safe         ( MArray )
-- import qualified Data.Array.MArray.Safe        as MA
import Data.Array.ST.Safe (STArray)
import qualified Data.Array.ST.Safe as MA
import Data.Bits
import Data.Functor
import Data.Graph (Graph)
import qualified Data.Graph as G
import Data.Int (Int64)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.List as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.STRef
import Data.Set (Set)
import qualified Data.Set as S
import System.IO
import Text.Read
--- DEBUGGING
#define DEBUG(x) dump di "x" x
dump di str a
  | "demo.hs" `L.isSuffixOf` __FILE__ =
    modifySTRef' di (L.insert (str, a)) >> return Nothing
  | otherwise = return Nothing

printDump lst
  | "demo.hs" `L.isSuffixOf` __FILE__ = forM_ lst print >> return Nothing
  | otherwise = return Nothing

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

readNum :: (Num a, Read a) => IO a
readNum = read <$> getLine

readNumListLn :: (Num a, Read a) => Int -> IO [a]
readNumListLn n = doGetList n []
  where
    doGetList 0 l = return l
    doGetList n l = do
      i <- readNum
      doGetList (n - 1) (l ++ [i])

-- solve :: STRef s [([Char], Int)] -> Int -> Int -> Int -> Int -> Int -> ST s [Int]
solve di n nums = do
  pos <- newSTRef 0
  neg <- newSTRef 0
  ansp <- newSTRef 0
  ansn <- newSTRef 0
  let updateVal v =
        if v > 0
          then modifySTRef' pos (+ 1)
          else do
            p <- readSTRef pos
            n <- readSTRef neg
            writeSTRef neg (p + 1)
            writeSTRef pos n
  let compute v = do
        updateVal v
        p <- readSTRef pos
        nn <- readSTRef neg
        DEBUG(p)
        DEBUG(nn)
        modifySTRef' ansp (+p)
        modifySTRef' ansn (+nn)

  forM_ nums compute
  p <- readSTRef ansp
  n <- readSTRef ansn
  let ans = (n,p)
  -- solution
  -- readSTRef =<< newSTRef ans
  return ans

main :: IO ()
main = do
  n <- readNum :: IO Int
  --  Read Inputs
  nums <- readNumList :: IO [Int]
  let computation =
        runST $ do
          let dubeg_info =
                [] :: (Num a) =>
                        [(String, a)]
          --- list of tuples (string value)
          di <- newSTRef dubeg_info
          ans <- solve di n nums
          tmp <- readSTRef di
          let lst = (ans, tmp)
          readSTRef =<< newSTRef lst
  -- get solution
  let (n, p) = fst computation
  let debug_info = snd computation
  printDump debug_info
  -- print result
  putStrLn $ show n ++ " " ++ show p

solve :: [Int] -> [Int]
solve array = let runDP [] res _ = res
                  runDP (x:xs) [prevN, prevP] [negTllLst, posTllLst] =
                    let [negTllCur, posTllCur] = if x > 0 then [negTllLst, posTllLst + 1]
                                                          else [posTllLst + 1, negTllLst]
                    in runDP xs [prevN + negTllCur, prevP + posTllCur] [negTllCur, posTllCur]
              in runDP array [0,0] [0,0]

main :: IO ()
main = interact $ (++ "\n") . unwords . map show . solve . map read . tail . words

import Data.List

f (p, n, p', n') x | (x == 1)  = (p + 1, n, p + p', n + n')
                   | otherwise = (n, p + 1, p + p', n + n')

task x = show (n + n') ++ " " ++ show (p + p') where (p, n, p', n') = foldl' f (0, 0, 0, 0) x

main = getContents >>= print . task . map (\i -> signum $ read i::Integer) . words . head . tail . lines

{-
  Copyright (c) 2019 Islam Omar
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-Ofast #-}

import Control.Monad (forM, forM_, join, replicateM_, when)
import Control.Monad.ST
import Control.Monad.State.Strict

-- import           Data.Array.MArray.Safe         ( MArray )
-- import qualified Data.Array.MArray.Safe        as MA
import Data.Array.ST.Safe (STArray)
import qualified Data.Array.ST.Safe as MA
import Data.Bits
import Data.Functor
import Data.Graph (Graph)
import qualified Data.Graph as G
import Data.Int (Int64)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.List as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.STRef
import Data.Set (Set)
import qualified Data.Set as S
import System.IO
import Text.Read
--- DEBUGGING
#define DEBUG(x) dump di "x" x
dump di str a
  | "demo.hs" `L.isSuffixOf` __FILE__ =
    modifySTRef' di (L.insert (str, a)) >> return Nothing
  | otherwise = return Nothing

printDump lst
  | "demo.hs" `L.isSuffixOf` __FILE__ = forM_ lst print >> return Nothing
  | otherwise = return Nothing

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

readNum :: (Num a, Read a) => IO a
readNum = read <$> getLine

readNumListLn :: (Num a, Read a) => Int -> IO [a]
readNumListLn n = doGetList n []
  where
    doGetList 0 l = return l
    doGetList n l = do
      i <- readNum
      doGetList (n - 1) (l ++ [i])

-- solve :: STRef s [([Char], Int)] -> Int -> Int -> Int -> Int -> Int -> ST s [Int]
solve di n nums = do
  DEBUG (n)
  i <- newSTRef 0
  pos <- newSTRef 0
  neg <- newSTRef 0
  ansp <- newSTRef 0
  ansn <- newSTRef 0
  let updateVal v =
        if v > 0
          then modifySTRef' pos (+ 1)
          else do
            p <- readSTRef pos
            n <- readSTRef neg
            writeSTRef neg (p + 1)
            writeSTRef pos n
  writeSTRef i 0
  let loop = do
        it <- readSTRef i
        let v = nums !! it
        updateVal v
        p <- readSTRef pos
        nn <- readSTRef neg
        DEBUG (nn)
        DEBUG (it)
        DEBUG (p)
        modifySTRef' ansp (+p)
        modifySTRef' ansn (+nn)
        modifySTRef' i (+1)
        if it+1 >= n then (return ())
          else loop

  loop
  p <- readSTRef ansp
  n <- readSTRef ansn
  let ans = (n,p)
  -- solution
  -- readSTRef =<< newSTRef ans
  return ans

main :: IO ()
main = do
  n <- readNum :: IO Int
  --  Read Inputs
  nums <- readNumList :: IO [Int]
  print nums
  let computation =
        runST $ do
          let dubeg_info =
                [] :: (Num a) =>
                        [(String, a)]
          --- list of tuples (string value)
          di <- newSTRef dubeg_info
          ans <- solve di n nums
          tmp <- readSTRef di
          let lst = (ans, tmp)
          readSTRef =<< newSTRef lst
  -- get solution
  let (n, p) = fst computation
  let debug_info = snd computation
  printDump debug_info
  -- print result
  putStrLn $ show n ++ " " ++ show p


Vasya is reading a e-book. The file of the book consists of $$$n$$$ pages, numbered from $$$1$$$ to $$$n$$$. The screen is currently displaying the contents of page $$$x$$$, and Vasya wants to read the page $$$y$$$. There are two buttons on the book which allow Vasya to scroll $$$d$$$ pages forwards or backwards (but he cannot scroll outside the book). For example, if the book consists of $$$10$$$ pages, and $$$d = 3$$$, then from the first page Vasya can scroll to the first or to the fourth page by pressing one of the buttons; from the second page — to the first or to the fifth; from the sixth page — to the third or to the ninth; from the eighth — to the fifth or to the tenth.Help Vasya to calculate the minimum number of times he needs to press a button to move to page $$$y$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of testcases. Each testcase is denoted by a line containing four integers $$$n$$$, $$$x$$$, $$$y$$$, $$$d$$$ ($$$1\le n, d \le 10^9$$$, $$$1 \le x, y \le n$$$) — the number of pages, the starting page, the desired page, and the number of pages scrolled by pressing one button, respectively.

Print one line for each test. If Vasya can move from page $$$x$$$ to page $$$y$$$, print the minimum number of times he needs to press a button to do it. Otherwise print $$$-1$$$.

NoteIn the first test case the optimal sequence is: $$$4 \rightarrow 2 \rightarrow 1 \rightarrow 3 \rightarrow 5$$$.In the second test case it is possible to get to pages $$$1$$$ and $$$5$$$.In the third test case the optimal sequence is: $$$4 \rightarrow 7 \rightarrow 10 \rightarrow 13 \rightarrow 16 \rightarrow 19$$$.

import Data.List
import qualified Data.Map.Strict as Map

inf::Int
inf = 1000000005

toint s = (read s) :: Int

doall::[Int]->String
doall [] = ""
doall (n:xx:yy:d:ss) =
  let x = xx-1 in
  let y = yy-1 in
  if (mod x d == mod y d) then
    show(div (abs (x-y)) d)++"\n"++(doall ss)
  else
    let r1 =	if mod y d == 0 then div x d + div y d + 1 else inf in
    let r2 = if mod y d == mod (n-1) d then div (n-1-x) d + div (n-1-y) d + 1 else inf in
    let r = min r1 r2 in
    if r == inf then "-1\n"++(doall ss) else show(r)++"\n"++(doall ss)

solve::String -> String
solve ss =
  let _:s = map toint $ words ss in
  doall s

main = do
  interact $ solve

import Prelude
import Control.Monad

str2Ints str = [read x::Int | x <- words str]
getLineN n = replicateM n getLine

inf::Int
inf = floor (1e9+7)

i2b x = if x /= 0 then 1 else 0

f n x y d = if z == inf then -1 else z
    where z = minimum [if x`rem`d == y`rem`d then abs(x-y)`quot`d else inf,
                       if 0 == y`rem`d then y`quot`d + x`quot`d + i2b(x`rem`d) else inf,
                       if (n-1)`rem`d == y`rem`d then (n-1-y)`quot`d + (n-1-x)`quot`d + i2b((n-1-x)`rem`d) else inf]

main = do
    input<-getLine;
    lines<-getLineN (read input::Int)
    let l = map str2Ints lines
    let ans = foldr (\x acc -> (f (x!!0) (x!!1 - 1) (x!!2 - 1) (x!!3)):acc) [] l
    mapM (putStrLn.show) ans

import Prelude
import Control.Monad

str2Ints str = [read x::Int | x <- words str]
getLineN n = replicateM n getLine

inf::Int
inf = floor (1e9+7)

i2b x = if x /= 0 then 1 else 0

f n x y d = if z == inf then -1 else z
    where z = minimum [if x`rem`d == y`rem`d then abs(x-y)`quot`d else inf,
                       if 0 == y`rem`d then y`quot`d + x`quot`d + i2b(x`rem`d) else inf,
                       if (n-1)`quot`d == y`rem`d then (n-1-y)`quot`d + (n-1-x)`quot`d + i2b((n-1-x)`rem`d) else inf]

main = do
    input<-getLine;
    lines<-getLineN (read input::Int)
    let l = map str2Ints lines
    let ans = foldr (\x acc -> (f (x!!0) (x!!1 - 1) (x!!2 - 1) (x!!3)):acc) [] l
    mapM (putStrLn.show) ans


"Night gathers, and now my watch begins. It shall not end until my death. I shall take no wife, hold no lands, father no children. I shall wear no crowns and win no glory. I shall live and die at my post. I am the sword in the darkness. I am the watcher on the walls. I am the shield that guards the realms of men. I pledge my life and honor to the Night's Watch, for this night and all the nights to come." — The Night's Watch oath.With that begins the watch of Jon Snow. He is assigned the task to support the stewards.This time he has n stewards with him whom he has to provide support. Each steward has his own strength. Jon Snow likes to support a steward only if there exists at least one steward who has strength strictly less than him and at least one steward who has strength strictly greater than him.Can you find how many stewards will Jon support?

First line consists of a single integer n (1 ≤ n ≤ 105) — the number of stewards with Jon Snow. Second line consists of n space separated integers a1, a2, ..., an (0 ≤ ai ≤ 109) representing the values assigned to the stewards.

Output a single integer representing the number of stewards which Jon will feed.

NoteIn the first sample, Jon Snow cannot support steward with strength 1 because there is no steward with strength less than 1 and he cannot support steward with strength 5 because there is no steward with strength greater than 5.In the second sample, Jon Snow can support steward with strength 2 because there are stewards with strength less than 2 and greater than 2.

import Data.List

main = do
        nS <- getLine
        strengthValuesS <- getLine
        let n = read nS :: Int
            strengthValues = map (read :: String -> Int) (words strengthValuesS)
            list = group (sort strengthValues)
        print (max 0 (n - (length (head list)) - (length (last list))))

import Control.Applicative ((<$>), (<*>))
main = do
    n <- readLn :: IO Int
    a <- fmap (map read) $ fmap words $ getLine :: IO [Int]
    let min0 = minimum a
    let max0 = maximum a
    print $ length $ filter ((&&) <$> (> min0) <*> (< max0)) a

import Data.List

main = do
    getLine
    a <- return . map length . group . sort . map (read :: String -> Int) . words =<< getLine
    print $ if length a < 2 then 0 else sum $ init $ tail a

{-# LANGUAGE TypeApplications #-}
import Data.List
main = interact $ show . length . concat . drop 1 . init . group . sort @Int . map read . tail . words

import Data.List
main=interact$show.length.concat.drop 1.init.group.sort.map((+0).read).tail.words

g mini maxi a = length $ filter (\x -> mini < x && x < maxi) a
f a = g (minimum a) (maximum a) a
main=interact$show.f.map ((+0).read).tail.words

import Data.List

main = do
    getLine
    l <- getLine >>= return . map read . words :: IO [Int]
    let m = minimum l
    let ma = maximum l
    print $ length $ filter (\x -> x > m && x < ma) l

import Data.List
main = do
  getLine
  a <- getLine >>= return.map read.words :: IO [Integer]
  print.length.filter (\x -> x > minimum a && x < maximum a) $ a

main = do
  i <- getLine
  let n = read i :: Int
  j <- getLine
  let inputs = map (\x -> read x :: Integer) $ words j
  let max_ = maximum inputs
  let min_ = minimum inputs
  let max_count = length $ filter (==max_) inputs
  let min_count = length $ filter (==min_) inputs
  if max_ == min_
    then print 0
    else print $ n - max_count - min_count

import Data.List.Split
getInt :: IO Integer
getInt = readLn

solve n as =
  length.filter (\x -> x > minimum as && x < maximum as) $ as

main = do
  n <- getInt
  a <- getLine
  print.solve n $ Data.List.Split.splitOn " " a

import Data.List.Split
getInt :: IO Int
getInt = readLn

solve n as =
  length.filter (\x -> x > minimum as && x < maximum as) $ as

main = do
  n <- getInt
  a <- getLine
  print.solve n $ Data.List.Split.splitOn " " a

import Data.List
import Data.List.Split
getInt :: IO Int
getInt = readLn

solve n as =
  length.filter (\x -> x > head bs && x < last bs) $ bs
  where bs = Data.List.sort as

main = do
  n <- getInt
  a <- getLine
  print.solve n $ Data.List.Split.splitOn " " a

main = do
  i <- getLine
  let n = read i :: Int
  j <- getLine
  let inputs = map (\x -> read x :: Integer) $ words j
  let max_count = length $ filter (==maximum inputs) inputs
  let min_count = length $ filter (==minimum inputs) inputs
  if max_count == min_count
    then print 0
    else print $ n - max_count - min_count

main = do
  i <- getLine
  let n = read i :: Int
  j <- getLine
  let inputs = map (\x -> read x :: Integer) $ words j
  let max_count = length $ filter (==maximum inputs) inputs
  let min_count = length $ filter (==minimum inputs) inputs
  print $ n - max_count - min_count


Alexey, a merry Berland entrant, got sick of the gray reality and he zealously wants to go to university. There are a lot of universities nowadays, so Alexey is getting lost in the diversity — he has not yet decided what profession he wants to get. At school, he had bad grades in all subjects, and it's only thanks to wealthy parents that he was able to obtain the graduation certificate.The situation is complicated by the fact that each high education institution has the determined amount of voluntary donations, paid by the new students for admission — ni berubleys. He cannot pay more than ni, because then the difference between the paid amount and ni can be regarded as a bribe!Each rector is wearing the distinctive uniform of his university. Therefore, the uniform's pockets cannot contain coins of denomination more than ri. The rector also does not carry coins of denomination less than li in his pocket — because if everyone pays him with so small coins, they gather a lot of weight and the pocket tears. Therefore, a donation can be paid only by coins of denomination x berubleys, where li ≤ x ≤ ri (Berland uses coins of any positive integer denomination). Alexey can use the coins of different denominations and he can use the coins of the same denomination any number of times. When Alexey was first confronted with such orders, he was puzzled because it turned out that not all universities can accept him! Alexey is very afraid of going into the army (even though he had long wanted to get the green uniform, but his dad says that the army bullies will beat his son and he cannot pay to ensure the boy's safety). So, Alexey wants to know for sure which universities he can enter so that he could quickly choose his alma mater.Thanks to the parents, Alexey is not limited in money and we can assume that he has an unlimited number of coins of each type.In other words, you are given t requests, each of them contains numbers ni, li, ri. For each query you need to answer, whether it is possible to gather the sum of exactly ni berubleys using only coins with an integer denomination from li to ri berubleys. You can use coins of different denominations. Coins of each denomination can be used any number of times.

The first line contains the number of universities t, (1 ≤ t ≤ 1000) Each of the next t lines contain three space-separated integers: ni, li, ri (1 ≤ ni, li, ri ≤ 109; li ≤ ri).

For each query print on a single line: either "Yes", if Alexey can enter the university, or "No" otherwise.

NoteYou can pay the donation to the first university with two coins: one of denomination 2 and one of denomination 3 berubleys. The donation to the second university cannot be paid.

import Control.Monad (replicateM_)

solve :: Int -> Int -> Int -> Bool
solve n lo hi =
  let rlo = floor   (fromIntegral (n-lo) / fromIntegral lo)  :: Int
      rhi = ceiling (fromIntegral (n-hi) / fromIntegral hi)  :: Int
  in rhi <= rlo && rlo >= 0

(-->) = flip fmap

main = do
  n <- getLine --> read
  replicateM_ n $ do
    (n:lo:hi:_) <- getLine --> words --> map read
    case solve n lo hi of
      True  -> putStrLn "Yes"
      False -> putStrLn "No"


You are given three integers $$$a$$$, $$$b$$$ and $$$c$$$.Find two positive integers $$$x$$$ and $$$y$$$ ($$$x > 0$$$, $$$y > 0$$$) such that:   the decimal representation of $$$x$$$ without leading zeroes consists of $$$a$$$ digits;  the decimal representation of $$$y$$$ without leading zeroes consists of $$$b$$$ digits;  the decimal representation of $$$gcd(x, y)$$$ without leading zeroes consists of $$$c$$$ digits. $$$gcd(x, y)$$$ denotes the greatest common divisor (GCD) of integers $$$x$$$ and $$$y$$$.Output $$$x$$$ and $$$y$$$. If there are multiple answers, output any of them.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 285$$$) — the number of testcases. Each of the next $$$t$$$ lines contains three integers $$$a$$$, $$$b$$$ and $$$c$$$ ($$$1 \le a, b \le 9$$$, $$$1 \le c \le min(a, b)$$$) — the required lengths of the numbers. It can be shown that the answer exists for all testcases under the given constraints. Additional constraint on the input: all testcases are different.

For each testcase print two positive integers — $$$x$$$ and $$$y$$$ ($$$x > 0$$$, $$$y > 0$$$) such that    the decimal representation of $$$x$$$ without leading zeroes consists of $$$a$$$ digits;  the decimal representation of $$$y$$$ without leading zeroes consists of $$$b$$$ digits;  the decimal representation of $$$gcd(x, y)$$$ without leading zeroes consists of $$$c$$$ digits.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

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

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = (Integer, Integer)

solve :: Integer -> Integer -> Integer -> Output
solve a b c = let (x, y) = result (a-c+1) (b-c+1) in (expo 10 (c-1) * x, expo 10 (c-1) * y)

result a b = (expo 10 (a-1) + 1, expo 10 (b-1))

expo :: Integral n => n -> n -> n
expo n x | x < 0 = error "expo n x : x < 0"
expo n x
	| x == 0 = 1
	| otherwise = k * k * if mod x 2 == 0 then 1 else n
	where k = expo n (div x 2)

plotResult :: Output -> IO ()
plotResult (a, b) = putStrLn $ show a ++ " " ++ show b

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[a, b, c] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve a b c
	return ()

import Control.Monad
import Data.Maybe
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
    [a, b, c] <- getInts
    let f x p l = head $ dropWhile (\x -> length (show x) < l) $ iterate (*p) x
        x3 = f 1 2 c
        x1 = f x3 2 a
        x2 = f x3 3 b
    C.putStrLn $ C.pack $ show x1 ++ " " ++ show x2


You are given an integer $$$n$$$ ($$$n \ge 0$$$) represented with $$$k$$$ digits in base (radix) $$$b$$$. So,$$$$$$n = a_1 \cdot b^{k-1} + a_2 \cdot b^{k-2} + \ldots a_{k-1} \cdot b + a_k.$$$$$$For example, if $$$b=17, k=3$$$ and $$$a=[11, 15, 7]$$$ then $$$n=11\cdot17^2+15\cdot17+7=3179+255+7=3441$$$.Determine whether $$$n$$$ is even or odd.

The first line contains two integers $$$b$$$ and $$$k$$$ ($$$2\le b\le 100$$$, $$$1\le k\le 10^5$$$) — the base of the number and the number of digits. The second line contains $$$k$$$ integers $$$a_1, a_2, \ldots, a_k$$$ ($$$0\le a_i < b$$$) — the digits of $$$n$$$. The representation of $$$n$$$ contains no unnecessary leading zero. That is, $$$a_1$$$ can be equal to $$$0$$$ only if $$$k = 1$$$.

Print "even" if $$$n$$$ is even, otherwise print "odd". You can print each letter in any case (upper or lower).

NoteIn the first example, $$$n = 3 \cdot 13^2 + 2 \cdot 13 + 7 = 540$$$, which is even.In the second example, $$$n = 123456789$$$ is odd.In the third example, $$$n = 32 \cdot 99^4 + 92 \cdot 99^3 + 85 \cdot 99^2 + 74 \cdot 99 + 4 = 3164015155$$$ is odd.In the fourth example $$$n = 2$$$.

import Data.Char

modpower x = 1 : (cycle $ case x of
                        1 -> [1]
                        2 -> [2,4,8,6]
                        3 -> [3,9,7,1]
                        4 -> [4,6]
                        5 -> [5]
                        6 -> [6]
                        7 -> [7,9,3,1]
                        8 -> [8,4,2,6]
                        9 -> [9,1]
                        0 -> [0,0])

get acc (a:b:as) = if b == ' ' then get (digitToInt a : acc) as else get acc (b:as)
get acc as  = ((digitToInt $ last as) : acc)

main = do
    [n,_] <- map (read :: String -> Int) . words <$> getLine
    a <- get [] <$> getLine
    let b =  take (length a) $ modpower (n`mod`10)
        c =  sum $ zipWith (*) a b
    putStrLn $ if even c then "even" else "odd"

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  [b,k] <- map read . words <$> getLine
  as <- take k . unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let ans | odd b     = foldl xor False $ map odd as
          | otherwise = odd $ last as
  putStrLn $ if ans then "odd" else "even"

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

main = interact $ (["odd","even"] !!) . fromEnum . solve . map read . words
solve (b:k:as) | even b = even (last as)
               | otherwise = even (sum as)

import Text.Printf
import Control.Monad

main = do
  [b, k] <- fmap (map read . words) getLine
  ls <- fmap (map read . reverse . words) getLine
  putStrLn . oddOrEven $ solve b ls

solve b ls@(x:_)
  | even b = x
  | otherwise = sum $ map (`rem` 2) ls

oddOrEven x
  | even x = "even"
  | otherwise = "odd"

press :: [Int] -> Int -> Int

press [] n = 0

press a n =
    ((head a) +(n * (press (tail a) n))) `mod` 2

main = do
    [n,_] <- map (read :: String -> Int) . words <$> getLine
    a <- map (read :: String -> Int) . words <$> getLine
    putStrLn $ if even (press (reverse a) n) then "even" else "odd"

press :: Bool -> [Int] -> Bool

press n [a] = (odd a)

press n a =
    ((odd (head a)) /= (n && (press n (tail a))))

main = do
    [n,_] <- map (read :: String -> Int) . words <$> getLine
    a <- map (read :: String -> Int) . words <$> getLine
    putStrLn $ if press (odd n) (reverse a) then "odd" else "even"

import Control.DeepSeq

main = do
  [o, n] <- fmap (fmap read . words) getLine
  s <- fmap (fmap read . words) getLine
  let (r, _) = foldl (\(s, c) x -> ((force s :: Int) + x * o ^ c, c - 1)) (0, n - 1) s
  putStrLn $ if even r then "even" else "odd"

main = interact $ process . map read . words
process :: [Int] -> String
process (b:k:a) = if ev then "even" else "odd" where
  ev | even b    = even $ last a
     | otherwise = even $ sum a

solve b k as | b `mod` 2 == 0   = if (last as) `mod` 2 == 0 then "even" else "odd"
             | otherwise        = if s `mod` 2 == 0 then "even" else "odd"
             where s = sum as

parseInput input = ([b, k], as) where
    ls = lines input
    [b, k] = map read $ words $ head ls :: [Int]
    as = map read $ words $ last ls :: [Int]

main = do
    input <- getContents
    let ([b, k], as) = parseInput input
    putStrLn $ solve b k as


Fifa and Fafa are sharing a flat. Fifa loves video games and wants to download a new soccer game. Unfortunately, Fafa heavily uses the internet which consumes the quota. Fifa can access the internet through his Wi-Fi access point. This access point can be accessed within a range of r meters (this range can be chosen by Fifa) from its position. Fifa must put the access point inside the flat which has a circular shape of radius R. Fifa wants to minimize the area that is not covered by the access point inside the flat without letting Fafa or anyone outside the flat to get access to the internet.The world is represented as an infinite 2D plane. The flat is centered at (x1, y1) and has radius R and Fafa's laptop is located at (x2, y2), not necessarily inside the flat. Find the position and the radius chosen by Fifa for his access point which minimizes the uncovered area.

The single line of the input contains 5 space-separated integers R, x1, y1, x2, y2 (1 ≤ R ≤ 105, |x1|, |y1|, |x2|, |y2| ≤ 105).

Print three space-separated numbers xap, yap, r where (xap, yap) is the position which Fifa chose for the access point and r is the radius of its range.  Your answer will be considered correct if the radius does not differ from optimal more than 10 - 6 absolutely or relatively, and also the radius you printed can be changed by no more than 10 - 6 (absolutely or relatively) in such a way that all points outside the flat and Fafa's laptop position are outside circle of the access point range.

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

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

readInteger = fst . M.fromJust . C.readInteger

distsq x1 y1 x2 y2 = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)

main = do
    (map readInteger . C.words -> [r, x1, y1, x2, y2]) <- B.getLine
    let dd = distsq x1 y1 x2 y2
    if dd >= r * r then
        putStrLn $ unwords $ map show [x1, y1, r]
    else do
        if dd /= 0 then do
            let d = sqrt (fromIntegral dd)
                rr = ((d + fromIntegral r) / 2.0) :: Double
                xx = fromIntegral x2 - fromIntegral (x2 - x1) / d * rr
                yy = fromIntegral y2 - fromIntegral (y2 - y1) / d * rr
            putStrLn $ unwords $ map show [xx, yy, rr]
        else do
            let d = sqrt (fromIntegral dd)
                rr = ((d + fromIntegral r) / 2.0) :: Double
                xx = fromIntegral x2 - rr
            putStrLn $ unwords $ map show [xx, fromIntegral y1, rr]

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

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

readInteger = fst . M.fromJust . C.readInteger

distsq x1 y1 x2 y2 = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)

main = do
    (map readInteger . C.words -> [r, x1, y1, x2, y2]) <- B.getLine
    let dd = distsq x1 y1 x2 y2
    if dd >= r * r || dd == 0 then
        putStrLn $ unwords $ map show [x1, y1, if dd /= 0 then r else 0]
    else do
        let d = sqrt (fromIntegral dd)
            rr = ((d + fromIntegral r) / 2.0) :: Double
            xx = fromIntegral x2 - fromIntegral (x2 - x1) / d * rr
            yy = fromIntegral y2 - fromIntegral (y2 - y1) / d * rr
        putStrLn $ unwords $ map show [xx, yy, rr]