The German University in Cairo (GUC) dorm houses are numbered from 1 to n. Underground water pipes connect these houses together. Each pipe has certain direction (water can flow only in this direction and not vice versa), and diameter (which characterizes the maximal amount of water it can handle).For each house, there is at most one pipe going into it and at most one pipe going out of it. With the new semester starting, GUC student and dorm resident, Lulu, wants to install tanks and taps at the dorms. For every house with an outgoing water pipe and without an incoming water pipe, Lulu should install a water tank at that house. For every house with an incoming water pipe and without an outgoing water pipe, Lulu should install a water tap at that house. Each tank house will convey water to all houses that have a sequence of pipes from the tank to it. Accordingly, each tap house will receive water originating from some tank house.In order to avoid pipes from bursting one week later (like what happened last semester), Lulu also has to consider the diameter of the pipes. The amount of water each tank conveys should not exceed the diameter of the pipes connecting a tank to its corresponding tap. Lulu wants to find the maximal amount of water that can be safely conveyed from each tank to its corresponding tap.

The first line contains two space-separated integers n and p (1 ≤ n ≤ 1000, 0 ≤ p ≤ n) — the number of houses and the number of pipes correspondingly.  Then p lines follow — the description of p pipes. The i-th line contains three integers ai bi di, indicating a pipe of diameter di going from house ai to house bi (1 ≤ ai, bi ≤ n, ai ≠ bi, 1 ≤ di ≤ 106). It is guaranteed that for each house there is at most one pipe going into it and at most one pipe going out of it.

Print integer t in the first line — the number of tank-tap pairs of houses. For the next t lines, print 3 integers per line, separated by spaces: tanki, tapi, and diameteri, where tanki ≠ tapi (1 ≤ i ≤ t). Here tanki and tapi are indexes of tank and tap houses respectively, and diameteri is the maximum amount of water that can be conveyed. All the t lines should be ordered (increasingly) by tanki.

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array
import Data.List

main = do
    [n, p] <- ( map read . words ) `liftM` getLine
    pipes <- replicateM p $ do
        [a, b, d] <- ( map read . words ) `liftM` getLine :: IO [Int]
        return (a, b, d)

    let mergedPipeArray :: Array Int (Maybe Int, Maybe Int, Int)
        mergedPipeArray = runST $ do
            houseArray <- newArray (1,n) (Nothing, Nothing, maxBound) :: ST s (STArray s Int (Maybe Int, Maybe Int, Int))
            forM_ pipes $ \(from, to, dia) -> do
                (fromFrom, fromTo, fromDia) <- readArray houseArray from
                (toFrom, toTo, toDia) <- readArray houseArray to

                let veryFrom = maybe from id fromFrom
                    veryTo = maybe to id toTo
                    veryDia = min dia $ min fromDia toDia

                writeArray houseArray from (Nothing, Nothing, 0)
                writeArray houseArray to (Nothing, Nothing, 0)
                unless ( veryFrom == to && veryTo == from ) $ do
                    writeArray houseArray veryFrom (Nothing, Just veryTo, veryDia)
                    writeArray houseArray veryTo (Just veryFrom, Nothing, veryDia)

            unsafeFreeze houseArray
        mergedPipe = filter (\(_, (_, to, dia)) -> case to of Just _ -> True; Nothing -> False) $ assocs mergedPipeArray

    --putStrLn $ show mergedPipe
    putStrLn $ show $ length mergedPipe
    putStr $ unlines $ map (\(from, (_, Just to, dia)) -> show from ++ " " ++ show to ++ " " ++ show dia) mergedPipe

    return ()

{-# LANGUAGE TypeSynonymInstances #-}
import Data.Array
import List

class Scan a where scan' :: String -> a
instance Scan Int where scan' n = read n
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' f = read f
instance Scan Double where scan' d = read d
instance Scan Integer where scan' n = read n
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = scan'' (words x)
                                                 where
                                                   scan'' (x:y:_) = (scan' x,scan' y)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = scan'' (words x)
                                                          where
                                                            scan'' (x:y:z:_) = (scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = scan'' (words x)
                                                                   where
                                                                     scan'' (w:x:y:z:_) = (scan' w,scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = scan'' (words x)
                                                                            where
                                                                              scan'' (v:w:x:y:z:_) = (scan' v,scan' w,scan' x,scan' y,scan' z)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scan :: (Scan a) => IO a
scan = do n <- getLine
          return (scan' n)

scans :: (Scan a) => Int -> IO [a]
scans 0 = return []
scans n = do x <- scan
             xs <- scans (n-1)
             return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

mint (_,b) c = if b<c then b else c

solve n house = rec 1 []
    where
      issource i = issourcerec i 1
          where
            issourcerec i j = if j>n then
                                  any (\k -> Nothing/=(house!(i,k))) [1..n]
                              else
                                  if (house!(j,i)) == Nothing then
                                      issourcerec i (j+1)
                                  else
                                      False
      rec i l | i>n = l
      rec i l = if issource i then
                    rec (i+1) ((recrec i 1):l)
                else
                    rec (i+1) l
      recrec i j = case (house!(i,j)) of
                     Just f -> (i,(dfs j 1 (j,f)))
                     Nothing -> recrec i (j+1)
      dfs i j maximum = if j>n then
                            maximum
                        else
                            case (house!(i,j)) of
                              Just f ->
                                  dfs j 1 (j,(mint maximum f))
                              Nothing ->
                                  dfs i (j+1) maximum

conv n l [] = (array ((1,1),(n,n)) [((i,j),Nothing)|i<-[1..n],j<-[1..n]])//l
conv n l ((a,b,d):xs) = conv n (((a,b),Just d):l) xs

convans [] l = sort l
convans ((i,(j,f)):xs) l = convans xs ((i,j,f):l)

putAns :: [(Int,Int,Int)] -> IO ()
putAns l = let n = length l
           in
             do putAnsLn n
                putAnsLns l

sub n p = if p/=0 then
              do abd <- scans p::IO [(Int,Int,Int)]
                 putAns (convans (solve n (conv n [] abd)) [])
          else
              putAnsLn "0"

main = do (n,p) <- scan::IO (Int,Int)
          sub n p

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

type Z = Int

solve :: Int -> [(Z,Z,Z)] -> [(Z,Z,Z)]
solve n abds = catMaybes $ [go table1 table2 i| i<-[1..n]] where
  table1 = accumArray mplus Nothing (1,n) (map f1 abds)
  table2 = accumArray mplus Nothing (1,n) (map f2 abds)
  f1 (a,b,d) = (a,Just (b,d))
  f2 (a,b,d) = (b,Just (a,d))

go t1 t2 a
  | t2!a /= Nothing = Nothing
  | t1!a == Nothing = Nothing
  | otherwise = let (b,d) = g a in Just (a,b,d)
  where
    g a = case t1!a of
               Nothing -> (a,infty)
               Just (b,d) -> let (b',d') = g b
                             in (b',min d d')
    infty = 10^7

main = do
  [n,p] <- map read . words <$> getLine
  abds <- replicateM p readABD
  let anss = solve n abds
  print $ length anss
  mapM_ printAns anss

readABD = (\[a,b,d] -> (a,b,d)) . map read . words <$> getLine
printAns (a,b,d) = putStrLn $ unwords [show a, show b, show d]

import Control.Monad

put x l i = fl ++ (x:(tail ll))
    where (fl, ll) = splitAt i l

po l = map read $ words l :: [Int]
s1 :: [[Int]] -> Int -> [[Int]]
s1 x n = s x (take n (repeat []))
    where
        s [] r = r
        s (x:y) r = s y (put x r ((head x) - 1))

d :: [Int] -> [[Int]] -> ([Int], [[Int]])
d (x:y:z:[]) r
    | (r!!(y-1)) == [] = ((x:y:z:[]), r)
    | x == y = ((x:y:z:[]), r)
    | otherwise = d (x:(a!!1):(minimum $ z:[(last a)]):[]) (put [] r (y-1))
        where a = r!!(y-1)
--d (x:y:[]) r =  ([0,0,0],r)
--d (x:[]) r =  ([0,0,0],r)
d [] r =  ([0,0,0],r)

dig :: Int -> [[Int]] -> [[Int]]
dig n x
    | (x!!n) == [] = x
    | otherwise = put xs ys n
        where (xs, ys) = d (x!!n) x

solve x = s2 0 x
    where
        s2 i x
            | i == (length x) = x
            | (x!!i) == [] = s2 (i +1) x
            | otherwise = s2 (i+1) (dig i x)
solve_r x = s3 ((length x) - 1) x
    where
        s3 i x
            | i == -1 = x
            | (x!!i) == [] = s3 (i -1) x
            | otherwise = s3 (i-1) (dig i x)

--co x = [i | i <- x, not (i == [])]
co x = [i | i <- x, (not (i == [])) && (not ((i!!0) ==(i!!1)))]
pp (x:y:z:[]) = (show x) ++ " " ++ (show y) ++ " " ++ (show z)
main = do
    l1 <- getLine
    let x = po l1
    let n = head x
    let p = last x
    ip <- replicateM p getLine
    let ipn = map po ip
    let t = (s1 ipn n)
    let m = co. solve_r . solve $ t
    print (length m)
    mapM_ (putStrLn.pp) m

{-# LANGUAGE TypeSynonymInstances #-}
import Data.Array
import List

class Scan a where scan' :: String -> a
instance Scan Int where scan' n = read n
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' f = read f
instance Scan Double where scan' d = read d
instance Scan Integer where scan' n = read n
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = scan'' (words x)
                                                 where
                                                   scan'' (x:y:_) = (scan' x,scan' y)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = scan'' (words x)
                                                          where
                                                            scan'' (x:y:z:_) = (scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = scan'' (words x)
                                                                   where
                                                                     scan'' (w:x:y:z:_) = (scan' w,scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = scan'' (words x)
                                                                            where
                                                                              scan'' (v:w:x:y:z:_) = (scan' v,scan' w,scan' x,scan' y,scan' z)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scan :: (Scan a) => IO a
scan = do n <- getLine
          return (scan' n)

scans :: (Scan a) => Int -> IO [a]
scans 0 = return []
scans n = do x <- scan
             xs <- scans (n-1)
             return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

mint (_,b) c = if b<c then b else c

solve n house = rec 1 []
    where
      issource i = issourcerec i 1
          where
            issourcerec i j = if j>n then
                                  True
                              else
                                  if (house!(j,i)) == Nothing then
                                      issourcerec i (j+1)
                                  else
                                      False
      rec i l | i>n = l
      rec i l = if issource i then
                    rec (i+1) ((recrec i 1):l)
                else
                    rec (i+1) l
      recrec i j = case (house!(i,j)) of
                     Just f -> (i,(dfs j 1 (j,f)))
                     Nothing -> recrec i (j+1)
      dfs i j maximum = if j>n then
                            maximum
                        else
                            case (house!(i,j)) of
                              Just f ->
                                  dfs j 1 (j,(mint maximum f))
                              Nothing ->
                                  dfs i (j+1) maximum

conv n l [] = (array ((1,1),(n,n)) [((i,j),Nothing)|i<-[1..n],j<-[1..n]])//l
conv n l ((a,b,d):xs) = conv n (((a,b),Just d):l) xs

convans [] l = sort l
convans ((i,(j,f)):xs) l = convans xs ((i,j,f):l)

putAns :: [(Int,Int,Int)] -> IO ()
putAns l = let n = length l
           in
             do putAnsLn n
                putAnsLns l

sub n p = if p/=0 then
              do abd <- scans p::IO [(Int,Int,Int)]
                 putAns (convans (solve n (conv n [] abd)) [])
          else
              return ()

main = do (n,p) <- scan::IO (Int,Int)
          sub n p

import Control.Monad

put x l i = fl ++ (x:(tail ll))
    where (fl, ll) = splitAt i l

po l = map read $ words l :: [Int]
s1 :: [[Int]] -> Int -> [[Int]]
s1 x n = s x (take n (repeat []))
    where
        s [] r = r
        s (x:y) r = s y (put x r ((head x) - 1))

d :: [Int] -> [[Int]] -> ([Int], [[Int]])
d (x:y:z:[]) r
    | (r!!(y-1)) == [] = ((x:y:z:[]), r)
    | x == y = ((x:y:z:[]), r)
    | otherwise = d (x:(a!!1):(minimum $ z:[(last a)]):[]) (put [] r (y-1))
        where a = r!!(y-1)
dig :: Int -> [[Int]] -> [[Int]]
dig n x = put xs ys n
    where (xs, ys) = d (x!!n) x

solve x = s2 0 x
    where
        s2 i x
            | i == (length x) = x
            | (x!!i) == [] = s2 (i +1) x
            | otherwise = s2 (i+1) (dig i x)
solve_r x = s3 ((length x) - 1) x
    where
        s3 i x
            | i == -1 = x
            | (x!!i) == [] = s3 (i -1) x
            | otherwise = s3 (i-1) (dig i x)

co x = [i | i <- x, not (i == [])]
pp (x:y:z:[]) = (show x) ++ " " ++ (show y) ++ " " ++ (show z)
main = do
    l1 <- getLine
    let x = po l1
    let n = head x
    let p = last x
    ip <- replicateM p getLine
    let ipn = map po ip
    let t = (s1 ipn n)
    let m = co. solve_r . solve $ dig 0 t
    print (length m)
    mapM_ (putStrLn.pp) m


You are given two integers $$$n$$$ and $$$m$$$ ($$$m < n$$$). Consider a convex regular polygon of $$$n$$$ vertices. Recall that a regular polygon is a polygon that is equiangular (all angles are equal in measure) and equilateral (all sides have the same length).  Examples of convex regular polygons Your task is to say if it is possible to build another convex regular polygon with $$$m$$$ vertices such that its center coincides with the center of the initial polygon and each of its vertices is some vertex of the initial polygon.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. The next $$$t$$$ lines describe test cases. Each test case is given as two space-separated integers $$$n$$$ and $$$m$$$ ($$$3 \le m < n \le 100$$$) — the number of vertices in the initial polygon and the number of vertices in the polygon you want to build.

For each test case, print the answer — "YES" (without quotes), if it is possible to build another convex regular polygon with $$$m$$$ vertices such that its center coincides with the center of the initial polygon and each of its vertices is some vertex of the initial polygon and "NO" otherwise.

Note  The first test case of the example It can be shown that the answer for the second test case of the example is "NO".

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Integer]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, m] <- getIntList
        putStrLn . yesOrNo . (==0) $ (n `mod` m)

import Control.Monad

solve :: Int -> Int -> String
solve n m = if n `mod` m == 0
            then "YES"
            else "NO"

main :: IO ()
main = do
  t <- readLn
  forM_ [1..t] $ \_ -> do
    l <- getLine
    [n, m] <- return $ map read $ words l
    putStrLn $ solve n m

import Control.Monad
possible:: [Int]  -> Bool

possible (x:y:_) = rem x y == 0

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

main = do
    t <- getLine
    let cases = (read t :: Int)
    results <- forM [1..cases] (\t -> do
        integers <- readInts
        if possible integers then return "YES" else return "NO"
        )

    mapM putStrLn results

import Control.Monad

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

main = do
    t <- readLn :: IO Int
    forM_ [1..t] (\_ -> do
            [n,m] <- r
            putStrLn $ if solve n m then "YES" else "NO"
        )

solve :: Int -> Int -> Bool
solve n m = n `rem` m == 0

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

process1 (x:y:[]) |x>y = mod x y ==0
                  | otherwise = mod y x ==0

process a = if process1 a then "YES" else "NO"

main::IO ()
main=do
  t<- read<$> getLine ::IO Int
  a<-  map(map read. words) <$> replicateM t getLine::IO [[Int]]
  mapM_ putStrLn $ map process a

process :: Int -> Int -> Bool
process n m = (n `mod` m) == 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    ts <- fmap (map (map readInt.words).lines) getContents
    mapM_ putStrLn $ map (\[n,m] -> if process n m then "YES" else "NO") ts

import Control.Monad

(|>) x f = f x

main = do
    line <- getLine
    forM_ [1..(read line)] $ \t -> do
        line <- getLine
        (n, m) <- line |> words |> (map read) |> (\l -> (l !! 0, l !! 1)) |> pure
        putStrLn $ if n `mod` m == 0
            then "YES"
            else "NO"

import Control.Monad

(|>) x f = f x

main = do
    line <- getLine
    forM_ [1..(read line)] $ \t -> do
        line <- getLine
        (n, m) <- line |> words |> (map read) |> (\l -> (l !! 0, l !! 1)) |> pure
        putStrLn (show n)
        putStrLn (show m)
        putStrLn $ if n `mod` m == 0
            then "YES"
            else "NO"

import Control.Monad

(|>) x f = f x

main = do
    line <- getLine
    forM_ [1..(read line)] $ \t -> do
        line <- getLine
        (n, m) <- line |> words |> (map read) |> (\l -> (l !! 0, l !! 1)) |> pure
        putStrLn $ if n `div` m == 0
            then "YES"
            else "NO"


You are given an integer $$$n$$$.Let's define $$$s(n)$$$ as the string "BAN" concatenated $$$n$$$ times. For example, $$$s(1)$$$ = "BAN", $$$s(3)$$$ = "BANBANBAN". Note that the length of the string $$$s(n)$$$ is equal to $$$3n$$$.Consider $$$s(n)$$$. You can perform the following operation on $$$s(n)$$$ any number of times (possibly zero): Select any two distinct indices $$$i$$$ and $$$j$$$ $$$(1 \leq i, j \leq 3n, i \ne j)$$$. Then, swap $$$s(n)_i$$$ and $$$s(n)_j$$$. You want the string "BAN" to not appear in $$$s(n)$$$ as a subsequence. What's the smallest number of operations you have to do to achieve this? Also, find one such shortest sequence of operations.A string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 100)$$$  — the number of test cases. The description of the test cases follows. The only line of each test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 100)$$$.

For each test case, in the first line output $$$m$$$ ($$$0 \le m \le 10^5$$$) — the minimum number of operations required. It's guaranteed that the objective is always achievable in at most $$$10^5$$$ operations under the constraints of the problem.  Then, output $$$m$$$ lines. The $$$k$$$-th of these lines should contain two integers $$$i_k$$$, $$$j_k$$$ $$$(1\leq i_k, j_k \leq 3n, i_k \ne j_k)$$$ denoting that you want to swap characters at indices $$$i_k$$$ and $$$j_k$$$ at the $$$k$$$-th operation.  After all $$$m$$$ operations, "BAN" must not appear in $$$s(n)$$$ as a subsequence.  If there are multiple possible answers, output any.

NoteIn the first testcase, $$$s(1) = $$$ "BAN", we can swap $$$s(1)_1$$$ and $$$s(1)_2$$$, converting $$$s(1)$$$ to "ABN", which does not contain "BAN" as a subsequence.In the second testcase, $$$s(2) = $$$ "BANBAN", we can swap $$$s(2)_2$$$ and $$$s(2)_6$$$, converting $$$s(2)$$$ to "BNNBAA", which does not contain "BAN" as a subsequence.

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bifunctor
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Tuple
import Debug.Trace

----- <Solution> --------------------------------------------------------------
type TC = Int

type Output = Res

input :: Scanner TC
input = int

newtype Res = Res [(Int, Int)]

instance Show Res where
  show (Res ps) =
    unlines $
      show (length ps) : map (\(i, j) -> show i <> " " <> show j) ps

solve :: TC -> Output
solve n = "BAN" >$> replicate n >>> concat >>> play

play :: String -> Res
play s | ok s = Res []
play s = Res $ (1 + length s1, length s - length s3) : ps
  where
    (s1, ('A' : s2, s3)) =
      s >$> break (== 'A')
        >>> second
          ( reverse
              >>> break (== 'N')
              >>> bimap reverse (tail >>> reverse)
              >>> swap
          )
    (Res ps) = play $ s1 ++ 'N' : s2 ++ 'A' : s3

ok :: String -> Bool
ok = not . hasSub "BAN"

hasSub :: String -> String -> Bool
hasSub (c : cs) (x : xs)
  | c == x = hasSub cs xs
  | otherwise = hasSub (c : cs) xs
hasSub cs _ = null cs

output :: Int -> Output -> C.ByteString
output ix = showB

----- </Solution> -------------------------------------------------------------

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

----- Template ----------------------------------------------------------------

-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

-- pragmas.hs {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad         (replicateM_)
import           Data.Array            (Array, (!))
import qualified Data.ByteString.Char8 as C
import           Data.Ix               (Ix)
import           Data.List             (intercalate, unfoldr)

solve :: Int -> [(Int, Int)]
solve n = takeWhile (uncurry (<)) $  zip [1, 4 ..] [(3 * n), (3 * n - 3) ..]

showPair :: (Show a1, Show a2) => (a1, a2) -> [Char]
showPair (a, b) = show a ++ " " ++ show b

docase :: IO ()
docase = do
  n <- getInt
  let xs = solve n
  print $ length xs
  putStrLn $ intercalate "\n" (showPair <$> xs)

main :: IO ()
main = getInt >>= flip replicateM_ docase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts = unfoldr go where
    go s = do
        (n,s1) <- C.readInt s
        let s2 = C.dropWhile (==' ') s1
        pure (n,s2)

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine

import Data.List ((\\))
(>>>) = flip (.)

main :: IO ()
main =
  interact $
    lines
      >>> tail
      >>> map (read >>> solve >>> showAns)
      >>> unlines

type Result = [(Int, Int)]

showAns :: Result -> String
showAns res = unlines $ show (length res) : map (\(i, j) -> show i <> " " <> show j) res

solve :: Int -> Result
solve n = zip (as \\ ls) (ls \\ as)
  where
    as = subtract 1 . (3 *) <$> [1..n]
    ls = (2 * n +) <$> [1..n]

-- pragmas.hs {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad         (replicateM_)
import           Data.Array            (Array, (!))
import qualified Data.ByteString.Char8 as C
import           Data.Ix               (Ix)
import           Data.List             (intercalate, unfoldr)

solve :: Int -> [(Int, Int)]
solve 1 = [(1, 3)]
solve n = filter ((/=1).(`mod` 3).snd) $ zip lst [3 * n..]
  where
  isValid b = b `mod` 3 == 1
  lst = filter ((==1).(`mod`3)) [1..(3 * (n - 1))]

showPair :: (Show a1, Show a2) => (a1, a2) -> [Char]
showPair (a, b) = show a ++ " " ++ show b

docase :: IO ()
docase = do
  n <- getInt
  let xs = solve n
  print $ length xs
  putStrLn $ intercalate "\n" (showPair <$> xs)

main :: IO ()
main = getInt >>= flip replicateM_ docase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts = unfoldr go where
    go s = do
        (n,s1) <- C.readInt s
        let s2 = C.dropWhile (==' ') s1
        pure (n,s2)

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine


Mikhail walks on a Cartesian plane. He starts at the point $$$(0, 0)$$$, and in one move he can go to any of eight adjacent points. For example, if Mikhail is currently at the point $$$(0, 0)$$$, he can go to any of the following points in one move:   $$$(1, 0)$$$;  $$$(1, 1)$$$;  $$$(0, 1)$$$;  $$$(-1, 1)$$$;  $$$(-1, 0)$$$;  $$$(-1, -1)$$$;  $$$(0, -1)$$$;  $$$(1, -1)$$$. If Mikhail goes from the point $$$(x1, y1)$$$ to the point $$$(x2, y2)$$$ in one move, and $$$x1 \ne x2$$$ and $$$y1 \ne y2$$$, then such a move is called a diagonal move.Mikhail has $$$q$$$ queries. For the $$$i$$$-th query Mikhail's target is to go to the point $$$(n_i, m_i)$$$ from the point $$$(0, 0)$$$ in exactly $$$k_i$$$ moves. Among all possible movements he want to choose one with the maximum number of diagonal moves. Your task is to find the maximum number of diagonal moves or find that it is impossible to go from the point $$$(0, 0)$$$ to the point $$$(n_i, m_i)$$$ in $$$k_i$$$ moves.Note that Mikhail can visit any point any number of times (even the destination point!).

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^4$$$) — the number of queries. Then $$$q$$$ lines follow. The $$$i$$$-th of these $$$q$$$ lines contains three integers $$$n_i$$$, $$$m_i$$$ and $$$k_i$$$ ($$$1 \le n_i, m_i, k_i \le 10^{18}$$$) — $$$x$$$-coordinate of the destination point of the query, $$$y$$$-coordinate of the destination point of the query and the number of moves in the query, correspondingly.

Print $$$q$$$ integers. The $$$i$$$-th integer should be equal to -1 if Mikhail cannot go from the point $$$(0, 0)$$$ to the point $$$(n_i, m_i)$$$ in exactly $$$k_i$$$ moves described above. Otherwise the $$$i$$$-th integer should be equal to the the maximum number of diagonal moves among all possible movements.

NoteOne of the possible answers to the first test case: $$$(0, 0) \to (1, 0) \to (1, 1) \to (2, 2)$$$.One of the possible answers to the second test case: $$$(0, 0) \to (0, 1) \to (1, 2) \to (0, 3) \to (1, 4) \to (2, 3) \to (3, 2) \to (4, 3)$$$.In the third test case Mikhail cannot reach the point $$$(10, 1)$$$ in 9 moves.

-- Codeforces 1036B
import Data.List

isPossible :: Integer -> Integer -> Integer -> Bool
isPossible x y path = max x y <= path

findPath :: Integer -> Integer -> Integer -> Integer
findPath x y path
    | not $ isPossible x y path = -1
    | otherwise = d'
    where d1 = (x + y) - path
          x' = x - d1
          y' = y - d1
          d' = d1 + (x' `div` 2 * 2) + (y' `div` 2 * 2)

main :: IO ()
main = do
    n <- getLine
    contents <- getContents
    let querys = take (read n) (lines contents)
    let paths  = map ((\[a,b,c] -> (read a, read b, read c)).words) querys :: [(Integer, Integer, Integer)]
    let diags  = map (\(x, y, p) -> findPath x y p) paths
    mapM_ print diags

-- Codeforces 1036B
import Data.List

isPossible :: Int -> Int -> Int -> Bool
isPossible x y path = max x y <= path

findPath :: Int -> Int -> Int -> Int
findPath x y path
    | not $ isPossible x y path = -1
    | otherwise = d'
    where d1 = (x + y) - path
          x' = x - d1
          y' = y - d1
          d' = d1 + (x' `div` 2 * 2) + (y' `div` 2 * 2)

main :: IO ()
main = do
    n <- getLine
    contents <- getContents
    let querys = take (read n) (lines contents)
    let paths  = map ((\[a,b,c] -> (read a, read b, read c)).words) querys :: [(Int, Int, Int)]
    let diags  = map (\(x, y, p) -> findPath x y p) paths
    mapM_ print diags


You are given one integer number $$$n$$$. Find three distinct integers $$$a, b, c$$$ such that $$$2 \le a, b, c$$$ and $$$a \cdot b \cdot c = n$$$ or say that it is impossible to do it.If there are several answers, you can print any.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The next $$$n$$$ lines describe test cases. The $$$i$$$-th test case is given on a new line as one integer $$$n$$$ ($$$2 \le n \le 10^9$$$).

For each test case, print the answer on it. Print "NO" if it is impossible to represent $$$n$$$ as $$$a \cdot b \cdot c$$$ for some distinct integers $$$a, b, c$$$ such that $$$2 \le a, b, c$$$. Otherwise, print "YES" and any possible such representation.

import Control.Monad
import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)

import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get :: EIO Int64
    case f2 n of
        Just (a, b, c) -> do
            putsln "YES"
            putsln $ (show a) ++ " " ++ (show b) ++ " " ++ (show c)
        Nothing -> putsln "NO"

f2 :: Int64 -> Maybe (Int64, Int64, Int64)
f2 x =  let ls = f3 x in
            case ls of
                [] -> Nothing
                (a, ae) : [] -> if ae < 6 then
                                    Nothing
                                else
                                    Just (a, ipow a 2, ipow a $ ae - 3)
                (a, ae) : (b, be) : [] ->   if ae + be <= 3 then
                                                Nothing
                                            else
                                                Just (a, b, (ipow a $ ae - 1) * (ipow b $ be - 1))
                (a, _) : (b, _): _ -> Just (a, b, div x $ a * b)

f3 :: Int64 -> [(Int64, Int64)]
f3 n = f4 n 2 $ sqrt $ fromIntegral n

f4 :: Int64 -> Int64 -> Double -> [(Int64, Int64)]
f4 n x d =  if (fromIntegral x) > d then
                if n /= 1 then
                    [(n, 1)]
                else
                    []
            else if mod n x == 0 then
                let (np, ep) = divrec n x in
                    (x, ep) : f4 np (x + 1) d
            else
                f4 n (x + 1) d

divrec :: Int64 -> Int64 -> (Int64, Int64)
divrec n x =    if mod n x == 0 then
                    let (np, ep) = divrec (div n x) x in
                        (np, ep + 1)
                else
                    (n, 0)

ipow :: Int64 -> Int64 -> Int64
ipow n e = if e == 0 then 1 else n * (ipow n $ e - 1)

import Control.Monad
import Text.Printf

next_div :: Integer -> Integer -> Maybe Integer
next_div n t
  | t * t >= n = Nothing
  | (/=0) $ n `mod` t = next_div n $ t + 1
  | otherwise = Just t

three_divsor :: Integer -> Maybe (Integer, Integer, Integer)
three_divsor n = do
  a <- next_div n 2
  b <- next_div (n `div` a) (a + 1)
  let r = n `div` (a * b)
  c <- if (r==a || r==b) then Nothing else Just r
  return (a, b, c)

one :: Maybe (Integer, Integer, Integer) -> Integer
one (Just (a, b, c)) = a

main = do
  i <- getLine
  let t = read i :: Integer
  forM_ [1..t] $ \ _ -> do
    ii <- getLine
    let n = read ii :: Integer
    let ret = three_divsor n
    case ret of
      Just (a,b,c) -> printf "YES\n%v %v %v\n" a b c
      Nothing -> printf "NO\n"

import Control.Monad
import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)

import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get :: EIO Int64
    case f2 n of
        Just (a, b, c) -> do
            putsln "YES"
            putsln $ (show a) ++ " " ++ (show b) ++ " " ++ (show c)
        Nothing -> putsln "NO"

f2 :: Int64 -> Maybe (Int64, Int64, Int64)
f2 x =  let ls = f3 x in
            case ls of
                [] -> Nothing
                (a, ae) : [] -> if ae < 6 then
                                    Nothing
                                else
                                    Just (a, ipow a 2, ipow a $ ae - 3)
                (a, ae) : (b, be) : [] ->   if ae == 1 && be == 1 then
                                                Nothing
                                            else
                                                Just (a, b, (ipow a $ ae - 1) * (ipow b $ be - 1))
                (a, _) : (b, _): _ -> Just (a, b, div x $ a * b)

f3 :: Int64 -> [(Int64, Int64)]
f3 n = f4 n 2 $ sqrt $ fromIntegral n

f4 :: Int64 -> Int64 -> Double -> [(Int64, Int64)]
f4 n x d =  if (fromIntegral x) > d then
                if n /= 1 then
                    [(n, 1)]
                else
                    []
            else if mod n x == 0 then
                let (np, ep) = divrec n x in
                    (x, ep) : f4 np (x + 1) d
            else
                f4 n (x + 1) d

divrec :: Int64 -> Int64 -> (Int64, Int64)
divrec n x =    if mod n x == 0 then
                    let (np, ep) = divrec (div n x) x in
                        (np, ep + 1)
                else
                    (n, 0)

ipow :: Int64 -> Int64 -> Int64
ipow n e = if e == 0 then 1 else n * (ipow n $ e - 1)

import Control.Monad
import Text.Printf

next_div :: Integer -> Integer -> Maybe Integer
next_div n t
  | t >= n = Nothing
  | (/=0) $ n `mod` t = next_div n $ t + 1
  | otherwise = Just t

three_divsor :: Integer -> Maybe (Integer, Integer, Integer)
three_divsor n = do
  a <- next_div n 2
  b <- next_div (n `div` a) (a + 1)
  let r = n `div` (a * b)
  c <- if (==b) r then Nothing else Just r
  return (a, b, c)

one :: Maybe (Integer, Integer, Integer) -> Integer
one (Just (a, b, c)) = a

main = do
  i <- getLine
  let t = read i :: Integer
  forM_ [1..t] $ \ _ -> do
    ii <- getLine
    let n = read ii :: Integer
    let ret = three_divsor n
    case ret of
      Just (a,b,c) -> printf "YES\n%v %v %v\n" a b c
      Nothing -> printf "NO\n"


100 years have passed since the last victory of the man versus computer in Go. Technologies made a huge step forward and robots conquered the Earth! It's time for the final fight between human and robot that will decide the faith of the planet.The following game was chosen for the fights: initially there is a polynomial P(x) = anxn + an - 1xn - 1 + ... + a1x + a0,  with yet undefined coefficients and the integer k. Players alternate their turns. At each turn, a player pick some index j, such that coefficient aj that stay near xj is not determined yet and sets it to any value (integer or real, positive or negative, 0 is also allowed). Computer moves first. The human will be declared the winner if and only if the resulting polynomial will be divisible by Q(x) = x - k.Polynomial P(x) is said to be divisible by polynomial Q(x) if there exists a representation P(x) = B(x)Q(x), where B(x) is also some polynomial.Some moves have been made already and now you wonder, is it true that human can guarantee the victory if he plays optimally?

The first line of the input contains two integers n and k (1 ≤ n ≤ 100 000, |k| ≤ 10 000) — the size of the polynomial and the integer k. The i-th of the following n + 1 lines contain character '?' if the coefficient near xi - 1 is yet undefined or the integer value ai, if the coefficient is already known ( - 10 000 ≤ ai ≤ 10 000). Each of integers ai (and even an) may be equal to 0. Please note, that it's not guaranteed that you are given the position of the game where it's computer's turn to move.

Print "Yes" (without quotes) if the human has winning strategy, or "No" (without quotes) otherwise.

NoteIn the first sample, computer set a0 to  - 1 on the first move, so if human can set coefficient a1 to 0.5 and win.In the second sample, all coefficients are already set and the resulting polynomial is divisible by x - 100, so the human has won.

import Control.Applicative

main = interact $ say . solve . words

say True = "Yes"
say False = "No"

solve (ns:ks:rest) = solve' n k $ take n rest
  where n = read ns + 1
        k = read ks

solve' n k rest
 | k == 0 = if head rest == "?" then nq `rem` 2 == 1 else head rest == "0"
 | nq == n = check 0 k . reverse . map read $ rest
 | otherwise = n `rem` 2 == 0
 where nq = length . filter (/="?") $ rest

check v _ [] = v == 0
check v _ _ | abs v > 10^12 = False
check v k (x:xs) = check (v * k + x) k xs

import Control.Applicative

main = interact $ say . solve . words

say True = "Yes"
say False = "No"

solve (ns:ks:rest) = solve' n k $ take n rest
  where n = read ns + 1
        k = read ks

solve' n k rest
 | k == 0 = if head rest == "?" then n `rem` 2 == 0 else head rest == "0"
 | nq == 0 = check 0 k . reverse . map read $ rest
 | otherwise = n `rem` 2 == 0
 where nq = length . filter (=="?") $ rest

check v _ [] = v == 0
check v _ _ | abs v > 10^12 = False
check v k (x:xs) = check (v * k + x) k xs


PolandBall is playing a game with EnemyBall. The rules are simple. Players have to say words in turns. You cannot say a word which was already said. PolandBall starts. The Ball which can't say a new word loses.You're given two lists of words familiar to PolandBall and EnemyBall. Can you determine who wins the game, if both play optimally?

The first input line contains two integers n and m (1 ≤ n, m ≤ 103) — number of words PolandBall and EnemyBall know, respectively. Then n strings follow, one per line — words familiar to PolandBall. Then m strings follow, one per line — words familiar to EnemyBall. Note that one Ball cannot know a word more than once (strings are unique), but some words can be known by both players. Each word is non-empty and consists of no more than 500 lowercase English alphabet letters.

In a single line of print the answer — "YES" if PolandBall wins and "NO" otherwise. Both Balls play optimally.

2 2
kremowka
wadowicka
kremowka
wiedenska

NoteIn the first example PolandBall knows much more words and wins effortlessly.In the second example if PolandBall says kremowka first, then EnemyBall cannot use that word anymore. EnemyBall can only say wiedenska. PolandBall says wadowicka and wins.

import Data.List
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B

main = do
  n:m:_ <- (map $ maybe undefined fst . B.readInt) . B.words <$> B.getLine
  ps <- replicateM n B.getLine
  es <- replicateM m B.getLine
  putStr $ let i =  length $ ps `intersect` es in if n - i `div` 2 > m - (i + 1) `div` 2 then "YES" else "NO"

import Data.List
import Control.Monad

runGame xs ys =
    lx - ly + xbonus > 0
    where
        common = length $ getCommon (sort xs) (sort ys)
        lx = (length xs) - common
        ly = (length ys) - common
        xbonus = if common `mod` 2 == 0 then 0 else 1

getLines n = replicateM n getLine

getCommon xs'@(x:xs) ys'@(y:ys) = if x == y then x : getCommon xs ys
                                        else getCommon ( skipWhile ( < x ) ys' ) xs'
getCommon _       _     = []

skipWhile _ []         = []
skipWhile p xs'@(x:xs) = if p x then skipWhile p xs
                                else xs'

main =
    do
        line1 <- getLine
        let numbers = map read . words $ line1
        let n = numbers !! 0
        let m = numbers !! 1
        selfWords  <- getLines n
        enemyWords <- getLines m

        putStrLn $
            if runGame selfWords enemyWords
            then "YES"
            else "NO"

import Data.List
import Control.Monad

runGame xs ys =
    lx - ly + xbonus > 0
    where
        common = length $ getCommon (sort xs) (sort ys)
        lx = (length xs) - common
        ly = (length ys) - common
        xbonus = if common `mod` 2 == 0 then 0 else 1

getLines n = replicateM n getLine

getCommon (x:xs) (y:ys) = if x == y then x : getCommon xs ys
                                    else getCommon ( skipWhile (\ k -> k < x ) ys ) xs
getCommon _       _     = []

skipWhile _ []         = []
skipWhile p xs'@(x:xs) = if p x then skipWhile p xs
                                else xs'

main =
    do
        line1 <- getLine
        let numbers = map read . words $ line1
        let n = numbers !! 0
        let m = numbers !! 1
        selfWords  <- getLines n
        enemyWords <- getLines m

        putStrLn $
            if runGame selfWords enemyWords
            then "YES"
            else "NO"

import Data.List
import Control.Monad

runGame xs ys =
    lx - ly + xbonus > 0
    where
        common = length . takeWhile (\(x,y)-> x == y) $ zip (sort xs) (sort ys)
        lx = (length xs) - common
        ly = (length ys) - common
        xbonus = if common `mod` 2 == 0 then 0 else 1

getLines n = replicateM n getLine

main =
    do
        line1 <- getLine
        let numbers = map read . words $ line1
        let n = numbers !! 0
        let m = numbers !! 1
        selfWords  <- getLines n
        enemyWords <- getLines m

        putStrLn $
            if runGame selfWords enemyWords
            then "YES"
            else "NO"


After the contest in comparing numbers, Shapur's teacher found out that he is a real genius and that no one could possibly do the calculations faster than him even using a super computer!Some days before the contest, the teacher took a very simple-looking exam and all his n students took part in the exam. The teacher gave them 3 strings and asked them to concatenate them. Concatenating strings means to put them in some arbitrary order one after the other. For example from concatenating Alireza and Amir we can get to AlirezaAmir or AmirAlireza depending on the order of concatenation.Unfortunately enough, the teacher forgot to ask students to concatenate their strings in a pre-defined order so each student did it the way he/she liked.Now the teacher knows that Shapur is such a fast-calculating genius boy and asks him to correct the students' papers.Shapur is not good at doing such a time-taking task. He rather likes to finish up with it as soon as possible and take his time to solve 3-SAT in polynomial time. Moreover, the teacher has given some advice that Shapur has to follow. Here's what the teacher said:   As I expect you know, the strings I gave to my students (including you) contained only lowercase and uppercase Persian Mikhi-Script letters. These letters are too much like Latin letters, so to make your task much harder I converted all the initial strings and all of the students' answers to Latin.  As latin alphabet has much less characters than Mikhi-Script, I added three odd-looking characters to the answers, these include "-", ";" and "_". These characters are my own invention of course! And I call them Signs.  The length of all initial strings was less than or equal to 100 and the lengths of my students' answers are less than or equal to 600  My son, not all students are genius as you are. It is quite possible that they make minor mistakes changing case of some characters. For example they may write ALiReZaAmIR instead of AlirezaAmir. Don't be picky and ignore these mistakes.  Those signs which I previously talked to you about are not important. You can ignore them, since many students are in the mood for adding extra signs or forgetting about a sign. So something like Iran;;-- is the same as --;IRAN  You should indicate for any of my students if his answer was right or wrong. Do this by writing "WA" for Wrong answer or "ACC" for a correct answer.  I should remind you that none of the strings (initial strings or answers) are empty.  Finally, do these as soon as possible. You have less than 2 hours to complete this.

The first three lines contain a string each. These are the initial strings. They consists only of lowercase and uppercase Latin letters and signs ("-", ";" and "_"). All the initial strings have length from 1 to 100, inclusively. In the fourth line there is a single integer n (0 ≤ n ≤ 1000), the number of students. Next n lines contain a student's answer each. It is guaranteed that the answer meets what the teacher said. Each answer iconsists only of lowercase and uppercase Latin letters and signs ("-", ";" and "_"). Length is from 1 to 600, inclusively.

For each student write in a different line. Print "WA" if his answer is wrong or "ACC" if his answer is OK.

Iran_
Persian;
W_o;n;d;e;r;f;u;l;
7
WonderfulPersianIran
wonderful_PersIAN_IRAN;;_
WONDERFUL___IRAN__PERSIAN__;;
Ira__Persiann__Wonderful
Wonder;;fulPersian___;I;r;a;n;
__________IranPersianWonderful__________
PersianIran_is_Wonderful

Shapur;;
is___
a_genius
3
Shapur__a_is___geniUs
is___shapur___a__Genius;
Shapur;;is;;a;;geni;;us;;

module Main where

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

normalize = map toLower . filter isAlpha

main = do
    inits <- replicateM 3 $ getLine >>= return . normalize
    let answers = map ( foldl' (++) [] ) $ permutations inits

    n <- read `liftM` getLine
    replicateM_ n $ do
        res <- getLine >>= return . ( `elem` answers ) . normalize
        if res
            then putStrLn "ACC"
            else putStrLn "WA"

import Data.Char (toLower)
import Data.List (permutations)

clear = map toLower . filter (not . (flip elem $ ";_-"))

check x y
  | y `elem` p = "ACC"
  | otherwise  = "WA"
    where p = [clear $ concat z | z <- permutations x]

main = interact solve
       where solve x = unlines [check (take 3 $ lines x) z | z <- [clear y | y <- drop 4 $ lines x]]

import Data.Char
import Data.List

easy [] = []
easy (x:xs)
	| elem x "-_;" = easy xs
	| otherwise = toLower x : easy xs

permutation [] = [[]]
permutation xs = concat [map (x:) $ permutation (delete x xs) | x <- xs]

solve [] _ = "ACC"
solve as b = if elem b ass then "ACC" else "WA"
	where
		ass = map concat $ permutation as

getLines 0 = return []
getLines n = do x <- getLine; xs <- getLines (n-1); return (x:xs)

putStrLns [] = return ()
putStrLns (x:xs) = do putStrLn x; putStrLns xs

main = do
	s <- getLines 3 >>= return . map easy
	n <- getLine >>= return . read
	vals <- getLines n >>= return . map easy
	let ans = map (solve s) vals
	putStrLns ans

import Char (toUpper)
import Control.Monad (replicateM)
import Data.List (permutations)

myFilterAndUpperCase :: String -> String
myFilterAndUpperCase  =  map toUpper . filter (flip notElem "-;_")

solve :: [String] -> String -> String
solve permutations' s
  | elem s permutations'  =  "ACC"
  | otherwise  =  "WA"

main :: IO ()
main  =  do
    s1  <-  fmap myFilterAndUpperCase getLine
    s2  <-  fmap myFilterAndUpperCase getLine
    s3  <-  fmap myFilterAndUpperCase getLine
    n   <-  readLn
    xs  <-  replicateM n (fmap myFilterAndUpperCase getLine)
    let permutations'  =  map concat $ permutations [s1, s2, s3]
    mapM_ (putStrLn . solve permutations') xs

import Data.Char
perm = [[0,1,2], [0, 2, 1], [1, 0, 2], [1, 2, 0], [2, 0, 1], [2, 1, 0]]
main = do
    l <- mapM (\_ -> (filter isAlpha . map toUpper) `fmap` getLine) [1..3]
    n <- read `fmap` getLine
    let test = map (\l1 -> concat $ map (\i -> l!!i) l1) perm
    mapM_ (\_ -> do
        s <- (filter isAlpha .map toUpper) `fmap` getLine
        putStrLn (if s `elem` test then "ACC" else "WA")) [1..n]

import Data.Char

simp word = map toUpper $ filter (/='_') $  filter (/='-')  $  filter (/=';') word

check3 w1 w2 w3 answer =
 any (==answer) [w1++w2++w3, w1++w3++w2, w2++w1++w3, w2++w3++w1, w3++w1++w2, w3++w2++w1]

check word1 word2 word3 answer = if check3 (simp word1) (simp word2) (simp word3) (simp answer)
  then "ACC"
  else "WA"

processLines 0 word1 word2 word3=
 do
  putStrLn("")

processLines 1 word1 word2 word3=
 do
  answer<-getLine
  putStrLn(check word1 word2 word3 answer)

processLines n word1 word2 word3=
 do
  answer<-getLine
  putStrLn(check word1 word2 word3 answer)
  processLines (n-1) word1 word2 word3

main =
 do
  word1 <- getLine
  word2 <- getLine
  word3 <- getLine
  n <- getLine
  processLines (read n::Int) word1 word2 word3

import Char
main = interact solve
solve input = output where
  inputs = map toL $ lines input
  strings = take 3 inputs
  answers = drop 4 inputs
  output = unlines $ solve0 strings answers
toL [] = []
toL (x:xs) = (if x=='-' || x==';' || x=='_' then [] else [toLower x]) ++ (toL xs)
solve0 _ [] = []
solve0 [a,b,c] (x:xs) = y:(solve0 [a,b,c] xs) where
  y
    | x==a++b++c = "ACC"
    | x==a++c++b = "ACC"
    | x==b++a++c = "ACC"
    | x==b++c++a = "ACC"
    | x==c++a++b = "ACC"
    | x==c++b++a = "ACC"
    | otherwise  = "WA"

import Data.Char
import Data.List

parse l =
    case lines l of
      (a:b:c:_:s) -> (clear a, clear b, clear c,map clear s)

clear l = [toLower x | x <- l, not (x `elem` ";_-")]

solve (a,b,c,s) = map mapper s
    where
      mapper foo =
          if foo `elem` bar
          then "ACC"
          else "WA"
      bar = [concat p | p <- permutations [a,b,c]]

main = do
  foo <- getContents
  putStrLn .unlines  . solve . parse $ foo

import Data.List
import Data.Char

perm [] = [[]]
perm xs  = [x:ps | x <- xs, ps <- perm (xs\\[x])]

format = map toLower . (filter $ not . (`elem` ";-_"))

main = interact f
f = unlines . (\x -> map (test (map concat $ perm $ take 3 x)) (drop 4 x)) . lines . format

test :: [String] -> String -> String
test dict s = if elem s dict then "ACC" else "WA"

import Data.Char (toLower)
import Data.List (sort)

removeSigns :: String -> String
removeSigns [] = []
removeSigns (x:xs)
  | isSign x   = removeSigns xs
  | otherwise  = x : removeSigns xs
    where isSign x = x == ';' || x == '-' || x == '_'

check :: String -> String -> Bool
check a b = task == answer where task   = sort $ map toLower $ removeSigns a
                                 answer = sort $ map toLower $ removeSigns b

run :: String -> Int -> IO Bool
run task num
  | num == 0  = return True
  | otherwise = getLine >>= return . check task >>= \ans -> putStrLn (if ans then "ACC" else "WA") >> run task (num-1)

main = do
  a   <- getLine
  b   <- getLine
  c   <- getLine
  num <- getLine
  run (a ++ b ++ c) (read num)

import Data.Char (toLower)
import Data.List (sort)

removeSigns :: String -> String
removeSigns [] = []
removeSigns (x:xs)
  | isSign x   = removeSigns xs
  | otherwise  = x : removeSigns xs
    where isSign x = x == ';' || x == '-' || x == '_'

check :: String -> String -> Bool
check a b = task == answer where task   = sort $ map toLower $ a
                                 answer = sort $ map toLower $ removeSigns b

run :: String -> Int -> IO Bool
run task num
  | num == 0  = return True
  | otherwise = getLine >>= return . check task >>= \ans -> putStrLn (if ans then "ACC" else "WA") >> run task (num-1)

main = do
  a   <- getLine
  b   <- getLine
  c   <- getLine
  num <- getLine
  run (removeSigns a ++ removeSigns b ++ removeSigns c) (read num)


On February 14 Denis decided to give Valentine to Nastya and did not come up with anything better than to draw a huge red heart on the door of the length $$$k$$$ ($$$k \ge 3$$$). Nastya was very confused by this present, so she decided to break the door, throwing it on the mountains.Mountains are described by a sequence of heights $$$a_1, a_2, \dots, a_n$$$ in order from left to right ($$$k \le n$$$). It is guaranteed that neighboring heights are not equal to each other (that is, $$$a_i \ne a_{i+1}$$$ for all $$$i$$$ from $$$1$$$ to $$$n-1$$$).Peaks of mountains on the segment $$$[l,r]$$$ (from $$$l$$$ to $$$r$$$) are called indexes $$$i$$$ such that $$$l < i < r$$$, $$$a_{i - 1} < a_i$$$ and $$$a_i > a_{i + 1}$$$. It is worth noting that the boundary indexes $$$l$$$ and $$$r$$$ for the segment are not peaks. For example, if $$$n=8$$$ and $$$a=[3,1,4,1,5,9,2,6]$$$, then the segment $$$[1,8]$$$ has only two peaks (with indexes $$$3$$$ and $$$6$$$), and there are no peaks on the segment $$$[3, 6]$$$.To break the door, Nastya throws it to a segment $$$[l,l+k-1]$$$ of consecutive mountains of length $$$k$$$ ($$$1 \le l \le n-k+1$$$). When the door touches the peaks of the mountains, it breaks into two parts, after that these parts will continue to fall in different halves and also break into pieces when touching the peaks of the mountains, and so on. Formally, the number of parts that the door will break into will be equal to $$$p+1$$$, where $$$p$$$ is the number of peaks on the segment $$$[l,l+k-1]$$$.Nastya wants to break it into as many pieces as possible. Help her choose such a segment of mountains $$$[l, l+k-1]$$$ that the number of peaks on it is maximum. If there are several optimal segments, Nastya wants to find one for which the value $$$l$$$ is minimal.Formally, you need to choose a segment of mountains $$$[l, l+k-1]$$$ that has the maximum number of peaks. Among all such segments, you need to find the segment that has the minimum possible value $$$l$$$.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$)  — the number of test cases. Then the descriptions of the test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$3 \leq k \leq n \leq 2 \cdot 10^5$$$)  — the number of mountains and the length of the door. The second line of the input data set contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \leq a_i \leq 10 ^ 9$$$, $$$a_i \neq a_{i + 1}$$$)  — the heights of mountains. It is guaranteed that the sum of $$$n$$$ over all the test cases will not exceed $$$2 \cdot 10^5$$$.

For each test case, output two integers $$$t$$$ and $$$l$$$  — the maximum number of parts that the door can split into, and the left border of the segment of length $$$k$$$ that the door should be reset to.

NoteIn the first example, you need to select a segment of mountains from $$$2$$$ to $$$7$$$. In this segment, the indexes $$$3$$$ and $$$6$$$ are peaks, so the answer is $$$3$$$ (only $$$2$$$ peaks, so the door will break into $$$3$$$ parts). It is not difficult to notice that the mountain segments $$$[1, 6]$$$ and $$$[3, 8]$$$ are not suitable since they only have a $$$1$$$ peak (for the first segment, the $$$6$$$ index is not a peak, and for the second segment, the $$$3$$$ index is not a peak).In the second example, you need to select a segment of mountains from $$$2$$$ to $$$4$$$. In this segment, the index $$$3$$$ is a peak, so the answer is $$$2$$$ (only $$$1$$$ peak, so the door will break into $$$2$$$ parts).In the third example, you need to select a segment of mountains from $$$1$$$ to $$$4$$$. In this segment, the index $$$3$$$ is a peak, so the answer is $$$2$$$ (only $$$1$$$ peak, so the door will break into $$$2$$$ parts). You can see that on the segments $$$[2, 5]$$$, $$$[4, 7]$$$ and $$$[5, 8]$$$ the number of peaks is also $$$1$$$, but these segments have a left border greater than the segment $$$[1, 4]$$$, so they are not the correct answer.

import Control.Arrow

main = interact $
  lines >>> drop 1
  >>> map (words >>> map read)
  >>> process
  >>> map (\(x,y) -> unwords [show x, show y]) >>> unlines

process :: [[Int]] -> [(Int, Int)]
process [] = []
process ([n,k]:a:ps) = solve n k a : process ps

solve n k a =
  let p = peaks a in
  let del = sum (take (k - 2) p)
            : zipWith (-) (drop (k - 2) p) p in
  let fin = zip (scanl1 (+) del) [-1,-2..] in
  let (t, l) = foldl1 max fin in (t + 1, -l)

peaks :: [Int] -> [Int]
peaks [_,_] = []
peaks (x:x':x'':xs) =
  (if x' > (max x x'') then 1 else 0)
    : peaks (x':x'':xs)

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  [_,k] <- (map read.words) <$> getLine
  as <- (map read.words) <$> getLine
  putStrLn $ solve k as

solve :: Int -> [Int] -> String
solve k as = (unwords.map show) [b+1,a]
  where
    (a,b) = (toMax.(toScores (k-2)).toAscending.toPeaks) as

toPeaks :: [Int] -> [Int]
toPeaks as = map f triples
  where
    triples = zip3 as (tail as) (tail $ tail as)
    f = \(x,y,z) -> fromEnum (x<y && y>z)

toAscending :: [Int] -> [Int]
toAscending peaks=scanl (+) 0 peaks

toScores ::Int -> [Int] -> [Int]
toScores k asc = zipWith (-) (drop k asc) asc

toMax :: [Int] -> (Int,Int)
toMax scores = (maximumBy myCompare) $ zip [1..] scores
  where
    myCompare (_,x) (_,y) = case compare x y of
      LT -> LT
      EQ -> GT
      GT -> GT

parse :: String -> [Int]
parse = map read . words

getPeaks :: [Int] -> [Int]
getPeaks (a:b:c:ls)
    | b > a && b > c        = 1 : getPeaks (b:c:ls)
    | otherwise             = 0 : getPeaks (b:c:ls)
getPeaks _ = []
prefixSum :: [Int] -> [Int]
prefixSum ls = 0 : helper 0 ls
    where
        helper aux [] = []
        helper aux (l:ls) = (aux+l) : helper (aux+l) ls

negateSnd :: (Int, Int) -> (Int, Int)
negateSnd (a,b) = (a, negate b)

getMax :: [Int] -> (Int, Int)
getMax ls = negateSnd $ maximum $ zip ls [(-1),(-2)..]

solveTestCases :: Int -> IO ()
solveTestCases 0 = return ()
solveTestCases t = do
    nk <- getLine
    aLine <- getLine
    let
        (n:k:_) = parse nk
        as = parse aLine
        peaks = getPeaks as
        prefixSumList = prefixSum peaks
        nPeaks = zipWith (-) (drop (k-2) prefixSumList) prefixSumList
        (mVal, mInd) = getMax nPeaks
    putStrLn $ show (mVal+1) ++ " " ++ show mInd
    solveTestCases (t-1)

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


Bash has set out on a journey to become the greatest Pokemon master. To get his first Pokemon, he went to Professor Zulu's Lab. Since Bash is Professor Zulu's favourite student, Zulu allows him to take as many Pokemon from his lab as he pleases.But Zulu warns him that a group of k > 1 Pokemon with strengths {s1, s2, s3, ..., sk} tend to fight among each other if gcd(s1, s2, s3, ..., sk) = 1 (see notes for gcd definition).Bash, being smart, does not want his Pokemon to fight among each other. However, he also wants to maximize the number of Pokemon he takes from the lab. Can you help Bash find out the maximum number of Pokemon he can take? Note: A Pokemon cannot fight with itself.

The input consists of two lines. The first line contains an integer n (1 ≤ n ≤ 105), the number of Pokemon in the lab. The next line contains n space separated integers, where the i-th of them denotes si (1 ≤ si ≤ 105), the strength of the i-th Pokemon.

Print single integer — the maximum number of Pokemons Bash can take.

Notegcd (greatest common divisor) of positive integers set {a1, a2, ..., an} is the maximum positive integer that divides all the integers {a1, a2, ..., an}.In the first sample, we can take Pokemons with strengths {2, 4} since gcd(2, 4) = 2.In the second sample, we can take Pokemons with strengths {2, 4, 6}, and there is no larger group with gcd ≠ 1.

import Data.List

factors n = go n 2
  where
    go n i
      | i * i > n = if n > 1 then [n] else []
      | otherwise = case n `mod` i of
          0 -> i : go (head $ dropWhile (\k -> k `mod` i == 0) (iterate (`div` i) n)) (i + 1)
          _ -> go n (i + 1)

solve xs = maximum . (1:) . map length . group . sort $ xs >>= factors

main = getLine >> getLine >>= \line -> print . solve $ map read (words line)

import qualified Data.Map as Map
import Control.Exception (assert)
import Data.List
-- import Debug.Trace as Trace
-- trace' x = Trace.traceShow x x

solve :: [Int] -> Int
solve xs = maximum . (1:) $ Map.elems $ Map.fromListWith (+) (zip fs (repeat 1))
  where
    fs = concatMap uniqueFactors xs

uniqueFactors :: Int -> [Int]
uniqueFactors 1 = []
uniqueFactors x = nub $ helper x 2 where
  helper r p
    | p * p > r = [r]
    | mod r p == 0 = p : helper (div r p) p
    | otherwise = helper r (p + 1)

main = do
  _ <- getLine
  xs <- return . map read . words =<< getLine
  print $ solve xs

import qualified Data.Map as Map
import Control.Exception (assert)
import Data.List
-- import Debug.Trace as Trace
-- trace' x = Trace.traceShow x x

solve :: [Int] -> Int
solve xs = maximum $ Map.elems $ Map.fromListWith (+) (zip fs (repeat 1))
  where
    fs = concatMap uniqueFactors xs

uniqueFactors :: Int -> [Int]
uniqueFactors x = nub $ helper x 2 where
  helper r p
    | p * p > r = [r]
    | mod r p == 0 = p : helper (div r p) p
    | otherwise = helper r (p + 1)

main = do
  _ <- getLine
  xs <- return . map read . words =<< getLine
  print $ solve xs


The School №0 of the capital of Berland has n children studying in it. All the children in this school are gifted: some of them are good at programming, some are good at maths, others are good at PE (Physical Education). Hence, for each child we know value ti:  ti = 1, if the i-th child is good at programming,  ti = 2, if the i-th child is good at maths,  ti = 3, if the i-th child is good at PE Each child happens to be good at exactly one of these three subjects.The Team Scientific Decathlon Olympias requires teams of three students. The school teachers decided that the teams will be composed of three children that are good at different subjects. That is, each team must have one mathematician, one programmer and one sportsman. Of course, each child can be a member of no more than one team.What is the maximum number of teams that the school will be able to present at the Olympiad? How should the teams be formed for that?

The first line contains integer n (1 ≤ n ≤ 5000) — the number of children in the school. The second line contains n integers t1, t2, ..., tn (1 ≤ ti ≤ 3), where ti describes the skill of the i-th child.

In the first line output integer w — the largest possible number of teams.  Then print w lines, containing three numbers in each line. Each triple represents the indexes of the children forming the team. You can print both the teams, and the numbers in the triplets in any order. The children are numbered from 1 to n in the order of their appearance in the input. Each child must participate in no more than one team. If there are several solutions, print any of them. If no teams can be compiled, print the only line with value w equal to 0.

main :: IO()
main = output . solve . tail . map read . words =<< getContents

solve :: [Int] -> [(Int, Int, Int)]
solve a = solve' a a a 1 1 1

solve' :: [Int] -> [Int] -> [Int] -> Int -> Int -> Int -> [(Int, Int, Int)]
solve' []     _      _      _  _  _  = []
solve' _      []     _      _  _  _  = []
solve' _      _      []     _  _  _  = []
solve' (a:ax) (b:bx) (c:cx) ia ib ic | a /= 1    = solve' ax (b:bx) (c:cx) (ia + 1) ib ic
                                     | b /= 2    = solve' (a:ax) bx (c:cx) ia (ib + 1) ic
                                     | c /= 3    = solve' (a:ax) (b:bx) cx ia ib (ic + 1)
                                     | otherwise = (ia, ib, ic) : (solve' ax bx cx (ia + 1) (ib + 1) (ic + 1))

output :: [(Int, Int, Int)] -> IO()
output ans = do
    print (length ans)
    output' ans

output' :: [(Int, Int, Int)] -> IO()
output' [] = putStrLn ""
output' ((a, b, c):x) = do
    putStrLn (unwords (map show [a, b, c]))
    output' x

main = do
  getLine
  ts <- fmap (map read . words) getLine

  let
    t1 = map snd $ filter (\x -> fst x == 1) $ zip ts [1..]
    t2 = map snd $ filter (\x -> fst x == 2) $ zip ts [1..]
    t3 = map snd $ filter (\x -> fst x == 3) $ zip ts [1..]

    r = zip3 t1 t2 t3

  print $ length r
  putStrLn $ unlines $ map (\(a, b, c) -> show a ++ " " ++ show b ++ " " ++ show c) r

filter_by_value b v = map snd $ filter (\(x,_) -> x == v) b

out a = len_str : (foldr (:) [] a)
  where len_str = show $ length a

solve a = map (unwords . map show . (\(i,(j,k)) -> [i,j,k])) c
  where b = zip a [1..]
        c = zip (filter_by_value b 1) $ zip (filter_by_value b 2) (filter_by_value b 3)

main = interact $ unlines . out . solve . map read . words . (!!1) . lines

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =getLine >> (solve =<< map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = let ys = slv2 $ slv1 $ zip [1..] xs; l=length ys in print l >> mapM_ (putStrLn.unwords.(map show)) ys
slv1 ts = foldr (\(a1,a2) [bs1,bs2,bs3] -> if a2==1 then [a1:bs1,bs2,bs3] else if a2==2 then [bs1,a1:bs2,bs3] else [bs1,bs2,a1:bs3]) [[],[],[]] ts
slv2 [xs1,xs2,xs3]=zipWith (\a b->a:b) xs1 $ zipWith (\a b->a:b:[]) xs2 xs3

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

main :: IO ()
main = do
    _  <- getLine
    ts <- words <$> getLine
    let ws = reverse (sol ts)
    print $ length ws
    mapM_ putStrLn ws

sol :: [String] -> [String]
sol ts = zipWith3 str ps ms es
  where
  str p m e = p ++ " " ++ m ++ " " ++ e
  (ps, ms, es, n) = foldr step ([], [], [], 1) (reverse ts)
  step t (ps, ms, es, i) = case t of
    "1" -> (show i:ps, ms, es, i+1)
    "2" -> (ps, show i:ms, es, i+1)
    "3" -> (ps, ms, show i:es, i+1)

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

process::[Integer]->IO ()
process q = do
              print y
              (mapM_ (\z->putStrLn $ intercalate " " $ map show z) xx)
  where x = map (map snd) $ groupBy (\z1 z2 -> fst z1==fst z2) $ sort $ zip q [1..]
        y | length x ==3 = minimum $ map length x
          | otherwise = 0
        xx =  transpose $  map (take y) x

main=do
    n<-     read  <$> getLine::IO Integer
    q<-    map read <$> words <$> getLine::IO [Integer]
    process q

import Data.List (elemIndex, unfoldr)

main :: IO ()
main = getContents >>= mapM_ (putStrLn . unwords . map show) . solve . map read . words . (!!1) . lines

solve :: [Int] -> [[Int]]
solve ts = [length xs] : xs
  where xs = unfoldr f ts
        f as = case (elemIndex 1 as, elemIndex 2 as, elemIndex 3 as) of
                    (Just i1, Just i2, Just i3) -> Just ([ i1 + 1, i2 + 1, i3 + 1 ], zipWith g [0..] as)
                      where g i a | i `elem` [ i1, i2, i3 ] = 0 | otherwise = a
                    _ -> Nothing

import Data.List
import Control.Monad
main = do
  getLine -- n
  ts <- fmap (zip [1..] . map read . words) getLine
  let (t1,ts') = partition ((== 1) . snd) ts
      (t2,t3) = partition ((== 2) . snd) ts'
      ws = zip3 t1 t2 t3
  print (length ws)
  forM_ ws $ \((i,_),(j,_),(k,_)) -> putStrLn $ unwords $ map show [i,j,k]

import Control.Applicative
import Data.List

process::[[Int]]->IO ()
process [[], _, _] = return ()
process [_ ,[], _] = return ()
process [_, _ ,[]] = return ()
process [(x:xs), (y:ys), (z:zs)] = do
					putStrLn (show x++" "++show y++ " "++ show z)
					process [xs, ys, zs]

main=do

	c<- read <$> getLine::IO Int
	a<-map read.words <$> getLine::IO [Int]
	let r1= groupBy (\a b -> fst a ==fst b) ( sort ( zip a [1..]) )
	let r = map (map snd) r1
	let rlen = minimum ( map length r)
	if length r <3 then print 0 else print rlen
	if (length r==3) then  (process r  ) else return ()

process :: [Int] -> [(Int,Int,Int)]
process ts = zip3 xs ys zs
    where
        (xs,ys,zs) = f $ zip [1..] ts
        f [] = ([],[],[])
        f ((i,t):ps)
            | t == 1 = ((i:xs),ys,zs)
            | t == 2 = (xs,(i:ys),zs)
            | t == 3 = (xs,ys,(i:zs))
            where
                (xs,ys,zs) = f ps

readInt :: String -> Int
readInt = read

printTriple :: (Int,Int,Int) -> IO ()
printTriple (x,y,z) = putStrLn.unwords.map show $ [x,y,z]

main :: IO ()
main = do
    n <- fmap readInt getLine
    ts <- fmap (map readInt.words) getLine
    let xs = process ts
    print $ length xs
    mapM_ printTriple xs

import Data.List
import Control.Applicative

main :: IO ()
main = interact solve

solve :: String -> String
solve s = unlines $ show (length teams) : fmap (unwords . fmap show) teams
    where (_:xs) = read <$> words s :: [Int]
          arr = sequence (select <$> [1..3])  (zip xs [1::Int ..]) :: [[Int]]
          teams = takeWhile ((==3).length) (transpose arr) ::[[Int]]

select :: (Eq a) => a -> [(a, b)] -> [b]
select key = fmap snd . filter ((==key).fst)

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

process::[Integer]->IO ()
process q = do
              print y
              mapM_ (\z->putStrLn $ intercalate " " $ map show z) xx
  where x = map (map snd) $ groupBy (\z1 z2 -> fst z1==fst z2) $ sort $ zip q [1..]
        y = minimum $ map length x
        xx =  transpose $  map (take y) x

main=do
    n<-     read  <$> getLine::IO Integer
    q<-    map read <$> words <$> getLine::IO [Integer]
    process q


You've got another geometrical task. You are given two non-degenerate polygons A and B as vertex coordinates. Polygon A is strictly convex. Polygon B is an arbitrary polygon without any self-intersections and self-touches. The vertices of both polygons are given in the clockwise order. For each polygon no three consecutively following vertices are located on the same straight line.Your task is to check whether polygon B is positioned strictly inside polygon A. It means that any point of polygon B should be strictly inside polygon A. "Strictly" means that the vertex of polygon B cannot lie on the side of the polygon A.

The first line contains the only integer n (3 ≤ n ≤ 105) — the number of vertices of polygon A. Then n lines contain pairs of integers xi, yi (|xi|, |yi| ≤ 109) — coordinates of the i-th vertex of polygon A. The vertices are given in the clockwise order. The next line contains a single integer m (3 ≤ m ≤ 2·104) — the number of vertices of polygon B. Then following m lines contain pairs of integers xj, yj (|xj|, |yj| ≤ 109) — the coordinates of the j-th vertex of polygon B. The vertices are given in the clockwise order. The coordinates of the polygon's vertices are separated by a single space. It is guaranteed that polygons A and B are non-degenerate, that polygon A is strictly convex, that polygon B has no self-intersections and self-touches and also for each polygon no three consecutively following vertices are located on the same straight line.

Print on the only line the answer to the problem — if polygon B is strictly inside polygon A, print "YES", otherwise print "NO" (without the quotes).

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Int

data Point = Point Int64 Int64 deriving (Show)

instance Read Point where
	readsPrec _ s = [(Point x y, [])]
		where [x, y] = map read $ words s

data Vector = Vector Int64 Int64

Point x1 y1 `vector` Point x2 y2 = Vector (x2 - x1) (y2 - y1)

Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1

instance Eq Vector where
	u == v = u `cross` v == 0

instance Ord Vector where
	u `compare` v = u `cross` v `compare` 0

main = do
	n <- readLn
	ps <- listArray (1,n) <$> replicateM n readLn

	m <- readLn
	qs <- replicateM m readLn

	let
		isInside p =
				vs!2 < v && vs!n > v &&
					vs!l <= v && vs!(l+1) >= v &&
					ps!l `vector` (ps!(l+1)) < ps!l `vector` p
			where
				v = ps!1 `vector` p
				vs = (ps!1 `vector`) <$> ps

				find l r
					| l >= r = (l, r)
					| vs!m <= v = find m r
					| otherwise = find l (m-1)
					where m = (l+r+1) `div` 2
				(l, r) = find 1 (n-1)

	putStrLn $ if all isInside qs then "YES" else "NO"

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Int

data Point = Point Int64 Int64 deriving (Show)

instance Read Point where
	readsPrec _ s = [(Point x y, [])]
		where [x, y] = map read $ words s

data Vector = Vector Int64 Int64

Point x1 y1 `vector` Point x2 y2 = Vector (x2 - x1) (y2 - y1)

Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1

instance Eq Vector where
	u == v = u `cross` v == 0

instance Ord Vector where
	u `compare` v = u `cross` v `compare` 0

main = do
	n <- readLn
	ps <- listArray (1,n) <$> replicateM n readLn

	m <- readLn
	qs <- replicateM m readLn

	let
		isInside p =
				vs!2 < v && vs!n > v &&
					vs!l <= v && vs!(l+1) >= v &&
					ps!l `vector` (ps!(l+1)) < ps!l `vector` p
			where
				v = ps!1 `vector` p
				vs = (ps!1 `vector`) <$> ps

				find l r
					| l >= r = (l, r)
					| vs!m <= v = find m r
					| otherwise = find l (m-1)
					where m = (l+r+1) `div` 2
				(l, r) = find 1 (n-1)

	putStrLn $ if and $ map isInside qs then "YES" else "NO"

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

import Debug.Trace

parseInput = do
    n <- readInt
    a <- replicateM n ((,) <$> readInt64 <*> readInt64)
    m <- readInt
    b <- replicateM m ((,) <$> readInt64 <*> readInt64)
    return (reverse a, b)
  where
    readInt64 = fromIntegral <$> readInt :: State ByteString Int64
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

det :: Num a => (a, a) -> (a, a) -> a
det (x1, y1) (x2, y2) = x1 * y2 - x2 * y1
{-# INLINE det #-}

dot :: Num a => (a, a) -> (a, a) -> a
dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2
{-# INLINE dot #-}

det3 :: Num a => (a, a) -> (a, a) -> (a, a) -> a
det3 (x0, y0) (x1, y1) (x2, y2) = det (x1 - x0, y1 - y0) (x2 - x0, y2 - y0)
{-# INLINE det3 #-}

convex :: [(Int64, Int64)] -> [(Int64, Int64)]
convex pts' = leftToRight pts []
  where
    pts = sort pts'

    leftToRight [] stack = rightToLeft (tail $ reverse pts) stack
    leftToRight (p:ps) (a:b:cs)
        | det3 b a p < 0 = leftToRight (p:ps) (b:cs)
    leftToRight (p:ps) st = leftToRight ps (p:st)

    rightToLeft [] stack = reverse $ tail stack
    rightToLeft (p:ps) (a:b:cs)
        | det3 b a p < 0 = rightToLeft (p:ps) (b:cs)
    rightToLeft (p:ps) st = rightToLeft ps (p:st)

area :: [(Int64, Int64)] -> Int64
area (x:xs) = foldl' (+) 0 $ zipWith det (x:xs) (xs++[x])

solve (a, b)
    | area a == area c && length a == length c = "YES"
    | otherwise                                = "NO"
  where
    c = convex (a ++ b)

-- {{{ A minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
-- }}}

{-# LANGUAGE BangPatterns, ViewPatterns #-}

import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Control.Applicative

readInt64 bs = case B.readInt bs of Just (n,_) -> fromIntegral n

main = do
  n <- readLn
  (toVec2s->tas,toVec2s.tail->bs) <- splitAt (2*n).map readInt64.B.words <$> B.getContents
  let as = ys ++ xs
         where
--           mina = minimum tas
           (xs,ys) = break (minimum tas==) tas
  if as == grahamScan (as++bs)
     then putStrLn "YES"
     else putStrLn "NO"

grahamScan ps = case go [v1,v0] vs of xs -> v0:init xs
   where
     v0 = minimum ps
     v1:vs = sortBy (compCCW v0) $ delete v0 ps
     go (p:q:conv) (r:rs) = case compare 0 $ (p-q)`cross`(r-q) of
                              LT -> go (r:p:q:conv) rs
                              GT -> go (q:conv) (r:rs)
                              EQ | dist2 p q < dist2 r q -> go (r:p:q:conv) (rs)
                                 | otherwise -> go (p:r:q:conv) rs
     go [p] (r:rs) = go [r,p] rs
     go conv [] = conv

type Point = Vec2

data Vec2 = V2 {
  px :: {-# UNPACK #-} !Int64,
  py :: {-# UNPACK #-} !Int64} deriving (Eq,Ord)

instance Num Vec2 where
  (V2 x0 y0)+(V2 x1 y1) = V2 (x0+x1) (y0+y1)
  (V2 x0 y0)-(V2 x1 y1) = V2 (x0-x1) (y0-y1)
  (V2 x0 y0)*(V2 x1 y1) = V2 (x0*x1-y0*y1) (x0*y1+x1*y0)
  negate (V2 x y) = V2 (negate x) (negate y)
  abs (V2 x y) = undefined
  signum (V2 x y) = undefined
  fromInteger n = V2 (fromInteger n) 0

instance Show Vec2 where
  show (V2 x y) = concat ["(",show x,",",show y,")"]

cross :: Vec2 -> Vec2 -> Int64
cross (V2 x0 y0) (V2 x1 y1) = x0*y1 - y0*x1

norm2 :: Vec2 -> Int64
norm2 (V2 x y) = x*x + y*y

dist2 :: Point -> Point -> Int64
dist2 u v = norm2 $ u-v

compCCW :: Point -> Point -> Point -> Ordering
compCCW o u v = compare 0 $ (u-o)`cross`(v-o)

toVec2s :: [Int64] -> [Vec2]
toVec2s (x:y:xys) = (V2 x y):toVec2s xys
toVec2s _ = []

import Data.Char
import Data.List
type Pt = (Integer, Integer)

data Tree = Split Tree Pt Tree | Segment deriving Eq
type Conv = (Pt, Tree, Pt)
type Seg = (Pt, Pt)

data Dir = L | In | Out | R deriving (Show, Eq)
cross :: Pt -> Pt -> Integer
cross (x1, y1) (x2, y2) = x1 * y2 - x2 * y1

dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2

diffV (x1, y1) (x2, y2) = (x2-x1, y2-y1)

dir :: Pt -> Seg -> Dir
dir p (a, b)
    | c < 0 = L
    | c > 0 = R
    | d1 > 0 && d2 > 0 = In
    | otherwise = Out where
  c = cross (diffV b a) (diffV p a)
  d1 = dot (diffV b a) (diffV p a)
  d2 = dot (diffV a b) (diffV p b)

inside' :: Pt -> Conv -> Bool
inside' p (l, Segment, r) = False
inside' p (l, Split lt s rt, r) = case (dir p (l, s), dir p (r, s)) of
  (R, L) -> True
  (L, R) -> False
  (Out, _) -> False
  (_, Out) -> False
  (In, L) -> lt /= Segment
  (R, In) -> rt /= Segment
  (L, L) -> inside' p (l, lt, s)
  (R, R) -> inside' p (s, rt, r)
  x -> error $ show x

inside p (l, tr, r) = dir p (l, r) == L && inside' p (l, tr, r)

myr = foldl (\s c->s*10+ord c-ord '0') 0

myread :: String -> Int
myread ('-':t) = -myr t
myread t = myr t

mkTr :: [Pt] -> Tree
mkTr [] = Segment
mkTr pts = Split (mkTr l) s (mkTr r) where
  (l, s : r) = splitAt (length pts `div` 2) pts

mkConv :: [Pt] -> Conv
mkConv pts = (head pts, mkTr (init $ tail pts), last pts)

s([n]:t)|all (`inside` conv) ps = "YES"
  | otherwise = "NO"  where
  (a,b) = genericSplitAt n t
  conv = mkConv (reverse $ map (\[a,b]->(a,b)) a)
  ([m]:c) = b
  ps = map (\[a,b]->(a,b)) c

main=interact$s.map(map(fromIntegral.myread).words).lines

import Control.Applicative
import Control.Monad
import Data.Array

data Point = Point Int Int deriving (Show)

instance Read Point where
	readsPrec _ s = [(Point x y, [])]
		where [x, y] = map read $ words s

data Vector = Vector Int Int

Point x1 y1 `vector` Point x2 y2 = Vector (x2 - x1) (y2 - y1)

Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1

instance Eq Vector where
	u == v = u `cross` v == 0

instance Ord Vector where
	u `compare` v = u `cross` v `compare` 0

main = do
	n <- readLn
	ps <- listArray (1,n) <$> replicateM n readLn

	m <- readLn
	qs <- replicateM m readLn

	let
		isInside p =
				vs!2 < v && vs!n > v &&
					vs!l <= v && vs!(l+1) >= v &&
					ps!l `vector` (ps!(l+1)) < ps!l `vector` p
			where
				v = ps!1 `vector` p
				vs = (ps!1 `vector`) <$> ps

				find l r
					| l >= r = (l, r)
					| vs!m <= v = find m r
					| otherwise = find l (m-1)
					where m = (l+r+1) `div` 2
				(l, r) = find 1 (n-1)

	putStrLn $ if and $ map isInside qs then "YES" else "NO"

import Control.Applicative
import Control.Monad
import Data.Array

data Point = Point Int Int deriving (Show)

instance Read Point where
	readsPrec _ s = [(Point x y, [])]
		where [x, y] = map read $ words s

data Vector = Vector Int Int

Point x1 y1 `vector` Point x2 y2 = Vector (x2 - x1) (y2 - y1)

Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1

instance Eq Vector where
	u == v = u `cross` v == 0

instance Ord Vector where
	u `compare` v = u `cross` v `compare` 0

main = do
	n <- readLn
	ps <- listArray (1,n) <$> replicateM n readLn

	m <- readLn
	qs <- replicateM m readLn

	let
		isInside p =
				vs!2 < v && vs!n > v &&
					vs!l <= v && vs!(l+1) >= v &&
					(ps!l) `vector` (ps!(l+1)) < (ps!l) `vector` p
			where
				v = ps!1 `vector` p
				vs = (ps!1 `vector`) <$> ps

				find l r
					| l >= r = (l, r)
					| vs!m <= v = find m r
					| otherwise = find l (m-1)
					where m = (l+r+1) `div` 2
				(l, r) = find 1 (n-2)

	putStrLn $ if and $ map isInside qs then "YES" else "NO"

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

import Debug.Trace

parseInput = do
    n <- readInt
    a <- replicateM n ((,) <$> readInt64 <*> readInt64)
    m <- readInt
    b <- replicateM m ((,) <$> readInt64 <*> readInt64)
    return (reverse a, b)
  where
    readInt64 = fromIntegral <$> readInt :: State ByteString Int64
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

det :: Num a => (a, a) -> (a, a) -> a
det (x1, y1) (x2, y2) = x1 * y2 - x2 * y1
{-# INLINE det #-}

dot :: Num a => (a, a) -> (a, a) -> a
dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2
{-# INLINE dot #-}

det3 :: Num a => (a, a) -> (a, a) -> (a, a) -> a
det3 (x0, y0) (x1, y1) (x2, y2) = det (x1 - x0, y1 - y0) (x2 - x0, y2 - y0)
{-# INLINE det3 #-}

convex :: [(Int64, Int64)] -> [(Int64, Int64)]
convex pts' = leftToRight pts []
  where
    pts = map head $ group $ sort pts'

    leftToRight [] stack = rightToLeft (tail $ reverse pts) stack
    leftToRight (p:ps) (a:b:cs)
        | det3 b a p <= 0 = leftToRight (p:ps) (b:cs)
    leftToRight (p:ps) st = leftToRight ps (p:st)

    rightToLeft [] stack = reverse $ tail stack
    rightToLeft (p:ps) (a:b:cs)
        | det3 b a p <= 0 = rightToLeft (p:ps) (b:cs)
    rightToLeft (p:ps) st = rightToLeft ps (p:st)

area :: [(Int64, Int64)] -> Int64
area (x:xs) = foldl' (+) 0 $ zipWith det (x:xs) (xs++[x])

solve (a, b)
    | area a == area (convex (a ++ b)) = "YES"
    | otherwise                        = "NO"

-- {{{ A minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
-- }}}

import Data.Char
import Data.List
type Pt = (Integer, Integer)

data Tree = Split Tree Pt Tree | Segment deriving Eq
type Conv = (Pt, Tree, Pt)
type Seg = (Pt, Pt)

data Dir = L | In | Out | R deriving (Show, Eq)
cross :: Pt -> Pt -> Integer
cross (x1, y1) (x2, y2) = x1 * y2 - x2 * y1

dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2

diffV (x1, y1) (x2, y2) = (x2-x1, y2-y1)

dir :: Pt -> Seg -> Dir
dir p (a, b)
    | c < 0 = L
    | c > 0 = R
    | d1 > 0 && d2 > 0 = In
    | otherwise = Out where
  c = cross (diffV b a) (diffV p a)
  d1 = dot (diffV b a) (diffV p a)
  d2 = dot (diffV a b) (diffV p b)

inside' :: Pt -> Conv -> Bool
inside' p (l, Segment, r) = False
inside' p (l, Split lt s rt, r) = case (dir p (l, s), dir p (r, s)) of
  (R, L) -> True
  (Out, _) -> False
  (_, Out) -> False
  (In, L) -> lt /= Segment
  (R, In) -> rt /= Segment
  (L, L) -> inside' p (l, lt, s)
  (R, R) -> inside' p (s, rt, r)
  x -> error $ show x

inside p (l, tr, r) = dir p (l, r) == L && inside' p (l, tr, r)

myr = foldl (\s c->s*10+ord c-ord '0') 0

myread :: String -> Int
myread ('-':t) = -myr t
myread t = myr t

mkTr :: [Pt] -> Tree
mkTr [] = Segment
mkTr pts = Split (mkTr l) s (mkTr r) where
  (l, s : r) = splitAt (length pts `div` 2) pts

mkConv :: [Pt] -> Conv
mkConv pts = (head pts, mkTr (init $ tail pts), last pts)

s([n]:t)|all (`inside` conv) ps = "YES"
  | otherwise = "NO"  where
  (a,b) = genericSplitAt n t
  conv = mkConv (map (\[a,b]->(a,b)) a)
  ([m]:c) = b
  ps = map (\[a,b]->(a,b)) c

main=interact$s.map(map(fromIntegral.myread).words).lines


Yura is tasked to build a closed fence in shape of an arbitrary non-degenerate simple quadrilateral. He's already got three straight fence segments with known lengths $$$a$$$, $$$b$$$, and $$$c$$$. Now he needs to find out some possible integer length $$$d$$$ of the fourth straight fence segment so that he can build the fence using these four segments. In other words, the fence should have a quadrilateral shape with side lengths equal to $$$a$$$, $$$b$$$, $$$c$$$, and $$$d$$$. Help Yura, find any possible length of the fourth side.A non-degenerate simple quadrilateral is such a quadrilateral that no three of its corners lie on the same line, and it does not cross itself.

The first line contains a single integer $$$t$$$ — the number of test cases ($$$1 \le t \le 1000$$$). The next $$$t$$$ lines describe the test cases. Each line contains three integers $$$a$$$, $$$b$$$, and $$$c$$$ — the lengths of the three fence segments ($$$1 \le a, b, c \le 10^9$$$).

For each test case print a single integer $$$d$$$ — the length of the fourth fence segment that is suitable for building the fence. If there are multiple answers, print any. We can show that an answer always exists.

NoteWe can build a quadrilateral with sides $$$1$$$, $$$2$$$, $$$3$$$, $$$4$$$.We can build a quadrilateral with sides $$$12$$$, $$$34$$$, $$$56$$$, $$$42$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = readIntegers >>= print . pred . sum

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = readIntegers >>= print . succ . sum

import Control.Monad ( replicateM_ )

main :: IO ()
main = do
  t <- getLine >>= return . read
  replicateM_ t solve

solve :: IO ()
solve = do
  [a, b, c] <- getLine >>= return . (map read) . words
  print $ a + b + c - e where e = 1e-3