This problem uses a simplified network topology model, please read the problem statement carefully and use it as a formal document as you develop the solution.Polycarpus continues working as a system administrator in a large corporation. The computer network of this corporation consists of n computers, some of them are connected by a cable. The computers are indexed by integers from 1 to n. It's known that any two computers connected by cable directly or through other computersPolycarpus decided to find out the network's topology. A network topology is the way of describing the network configuration, the scheme that shows the location and the connections of network devices.Polycarpus knows three main network topologies: bus, ring and star. A bus is the topology that represents a shared cable with all computers connected with it. In the ring topology the cable connects each computer only with two other ones. A star is the topology where all computers of a network are connected to the single central node.Let's represent each of these network topologies as a connected non-directed graph. A bus is a connected graph that is the only path, that is, the graph where all nodes are connected with two other ones except for some two nodes that are the beginning and the end of the path. A ring is a connected graph, where all nodes are connected with two other ones. A star is a connected graph, where a single central node is singled out and connected with all other nodes. For clarifications, see the picture.    (1) — bus, (2) — ring, (3) — star You've got a connected non-directed graph that characterizes the computer network in Polycarpus' corporation. Help him find out, which topology type the given network is. If that is impossible to do, say that the network's topology is unknown.

The first line contains two space-separated integers n and m (4 ≤ n ≤ 105; 3 ≤ m ≤ 105) — the number of nodes and edges in the graph, correspondingly. Next m lines contain the description of the graph's edges. The i-th line contains a space-separated pair of integers xi, yi (1 ≤ xi, yi ≤ n) — the numbers of nodes that are connected by the i-the edge. It is guaranteed that the given graph is connected. There is at most one edge between any two nodes. No edge connects a node with itself.

In a single line print the network topology name of the given graph. If the answer is the bus, print "bus topology" (without the quotes), if the answer is the ring, print "ring topology" (without the quotes), if the answer is the star, print "star topology" (without the quotes). If no answer fits, print "unknown topology" (without the quotes).

bus topology
ring topology
star topology
unknown topology

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  (n:m:a) <- map readInt . C.words <$> C.getContents
  let s = maximum $ map length $ group $ sort a
      ans = if m == n - 1 then
              if s == 2 then "bus"
              else if s == n - 1 then "star"
              else "unknown"
            else if m == n then
              if s == 2 then "ring"
              else "unknown"
            else "unknown"
  putStrLn $ ans ++ " topology"

import Data.List

main::IO()
main =
 do
 input <- getContents
 let
  numbers = map read (words input)
  n = head numbers
  degree = map length (group $ sort $ tail $ tail numbers::[[Int]])
  cnt1 = length $ filter (==1) degree
  cnt2 = length $ filter (==2) degree
 putStr $
  if cnt1==2&&cnt2==n-2
   then "bus topology\n"
  else if cnt2==n
   then "ring topology\n"
  else if cnt1==n-1
   then "star topology\n"
   else "unknown topology\n"

import Data.List

main::IO()
main =
 do
 input <- getContents
 let
  (n:_:lst) = map read (words input)::[Int]
  degree = map length (group $ sort $ lst)
  cnt x = length $ filter (==x) degree
  cnt1 = cnt 1
  cnt2 = cnt 2
 putStrLn $
  if cnt1==2&&cnt2==n-2
   then "bus topology"
  else if cnt2==n
   then "ring topology"
  else if cnt1==n-1
   then "star topology"
   else "unknown topology"

import Control.Monad (liftM, replicateM)
import Data.Array (accumArray, elems)
import Data.Char (ord, toLower, toUpper)
import Data.List (intercalate, nub, sort)

data NetType  =  Bus | Ring | Star | Unknown

instance Show NetType
  where
    show Bus   =  "bus topology"
    show Ring  =  "ring topology"
    show Star  =  "star topology"
    show _     =  "unknown topology"

solve :: Int -> Int -> [[Int]] -> NetType
solve n m edges
  | n == m && zip == [2]  =  Ring
  | n == (m+1) && zip == [1,2]  =  Bus
  | n == (m+1) && zip == [1,n-1]  =  Star
  | otherwise  =  Unknown
  where
    d  =  accumArray (+) 0 (1, n) [(v, 1) | v <- concat edges]
    zip  =  sort $ nub $ elems d

main :: IO ()
main  =  do
    [n, m]  <-  reads
    edges  <-  replicateM m reads
    print $ solve n m edges

  where

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

import Data.List

main:: IO()
main = do
	input <- getContents
	let
		(n:m:b) = map read (words input)::[Int]
		u = map length ( group $ sort b )
		cnt1=sum [1|x<-u,x==1]
		cnt2=sum [1|x<-u,x==2]
		ans = if(cnt1==2 && cnt2==n-2)
				then "bus topology"
			  else if( cnt1==0 && cnt2==n)
				then "ring topology"
			  else if( cnt1==n-1 )
				then "star topology"
			  else "unknown topology"
	putStrLn ans

import Data.List

main:: IO()
main = do
	input <- getContents
	let
		(n:m:b) = map read (words input)::[Int]
		sorted = sort b
		degree = group sorted
		u = foldl'(\t a -> (length a):t) [] degree
		cnt1=sum [1|x<-u,x==1]
		cnt2=sum [1|x<-u,x==2]
		ans = if(cnt1==2 && cnt2==n-2)
				then "bus topology"
			  else if( cnt1==0 && cnt2==n)
				then "ring topology"
			  else if( cnt1==n-1 )
				then "star topology"
			  else "unknown topology"
	putStrLn ans

import Data.List

main::IO()
main =
 do
 input <- getContents
 let
  numbers = map read (words input)
  n = head numbers
  degree = map length (group $ sort $ tail $ tail numbers::[[Int]])
  cnt1 = length $ filter (==1) degree
  cnt2 = length $ filter (==2) degree
 print $
  if cnt1==2&&cnt2==n-2
   then "bus topology"
  else if cnt2==n
   then "ring topology"
  else if cnt1==n-1
   then "star topology"
   else "unknown topology"


This is the first subtask of problem F. The only differences between this and the second subtask are the constraints on the value of $$$m$$$ and the time limit. You need to solve both subtasks in order to hack this one.There are $$$n+1$$$ distinct colours in the universe, numbered $$$0$$$ through $$$n$$$. There is a strip of paper $$$m$$$ centimetres long initially painted with colour $$$0$$$. Alice took a brush and painted the strip using the following process. For each $$$i$$$ from $$$1$$$ to $$$n$$$, in this order, she picks two integers $$$0 \leq a_i < b_i \leq m$$$, such that the segment $$$[a_i, b_i]$$$ is currently painted with a single colour, and repaints it with colour $$$i$$$. Alice chose the segments in such a way that each centimetre is now painted in some colour other than $$$0$$$. Formally, the segment $$$[i-1, i]$$$ is painted with colour $$$c_i$$$ ($$$c_i \neq 0$$$). Every colour other than $$$0$$$ is visible on the strip.Count the number of different pairs of sequences $$$\{a_i\}_{i=1}^n$$$, $$$\{b_i\}_{i=1}^n$$$ that result in this configuration. Since this number may be large, output it modulo $$$998244353$$$.

The first line contains a two integers $$$n$$$, $$$m$$$ ($$$1 \leq n \leq 500$$$, $$$n = m$$$) — the number of colours excluding the colour $$$0$$$ and the length of the paper, respectively. The second line contains $$$m$$$ space separated integers $$$c_1, c_2, \ldots, c_m$$$ ($$$1 \leq c_i \leq n$$$) — the colour visible on the segment $$$[i-1, i]$$$ after the process ends. It is guaranteed that for all $$$j$$$ between $$$1$$$ and $$$n$$$ there is an index $$$k$$$ such that $$$c_k = j$$$. Note that since in this subtask $$$n = m$$$, this means that $$$c$$$ is a permutation of integers $$$1$$$ through $$$n$$$.

Output a single integer — the number of ways Alice can perform the painting, modulo $$$998244353$$$.

NoteIn the first example, there are $$$5$$$ ways, all depicted in the figure below. Here, $$$0$$$ is white, $$$1$$$ is red, $$$2$$$ is green and $$$3$$$ is blue.Below is an example of a painting process that is not valid, as in the second step the segment 1 3 is not single colour, and thus may not be repainted with colour $$$2$$$.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM_)
import Control.Monad.ST (ST, runST)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Array.IArray ((!), listArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftL)
import Data.Char (ord)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap, (!?), empty, insert)
import Data.List (group)
import Data.Ratio (denominator, numerator)
import Data.Sequence
  ( Seq
  , Seq((:<|))
  , Seq((:|>))
  , Seq(Empty)
  , (><)
  , fromList
  , index
  , spanl
  , spanr
  , update
  )
import qualified Data.Sequence as S (length, replicate, splitAt)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField 998244353

type Hash = IntMap MField

data Node =
  Node
    { getIndex :: !Int
    , getValue :: !Int
    , getExt :: !Int
    }
  deriving (Show, Eq)

hash l r = l `shiftL` 10 .|. r

{-# INLINE hash #-}
mm = 998244353 :: Int64

madd :: Int64 -> Int64 -> Int64
madd a b
  | a + b < mm = a + b
  | otherwise = (a + b) - mm

{-# INLINE madd #-}
mmul :: Int64 -> Int64 -> Int64
mmul a b = a * b `mod` mm

{-# INLINE mmul #-}
search ::
     forall s.
     (UArray Int Int, UArray Int Int)
  -> STUArray s Int Int64
  -> (Int, Int)
  -> ST s ()
search (value, ext) mem (left, right)
  | left == right = return ()
  | otherwise = do
    let hc = hash left right
        mlo =
          foldl
            (\mm i ->
               mm >>= \m ->
                 if ext ! i >= right
                   then Nothing
                   else Just (min m (value ! i)))
            (Just (value ! left))
            [left .. right - 1]
    ret <-
      case mlo of
        Nothing -> return 0
        Just lo ->
          let loop f s i
                | f i = loop f s (s i)
                | otherwise = i
              findNext = loop ((/=) lo . (value !))
              !lp = findNext succ left
              !rp = findNext pred (right - 1)
              lov = single (lp, rp)
              single (l, r)
                | l == r = return 1
                | value ! l == lo = single (l + 1, r)
                | otherwise =
                  liftA2 mmul (readArray mem (hash l l')) (single (l', r))
                where
                  l' = findNext succ l
              lv = match (left, left, lp)
              rv = match (rp + 1, rp + 1, right)
              match (l, m, r)
                | m > r = return 0
                | m == r = readArray mem (hash l m)
                | otherwise =
                  let m' = (ext ! m) + 1
                   in liftA2
                        madd
                        (liftA2
                           mmul
                           (readArray mem (hash l m))
                           (readArray mem (hash m r)))
                        (match (l, m', r))
           in liftA2 mmul lov (liftA2 mmul lv rv)
    writeArray mem hc ret

solve :: Int -> [Int] -> Int64
solve n a = runST recur
  where
    a' = reverse (zip a [0 ..])
    es = evalState (mapM findNext a') (S.replicate (n + 1) (-1))
    findNext :: (Int, Int) -> State (Seq Int) Int
    findNext (v, i) = do
      next <- get
      let p = index next v
      put (update v i next)
      if p == -1
        then return i
        else return p
    m = length a
    value = listArray (0, m - 1) a :: UArray Int Int
    ext = listArray (0, m - 1) (reverse es) :: UArray Int Int
    recur :: forall s. ST s Int64
    recur = do
      mem <- newArray (0, 1 `shiftL` 20) 1 :: ST s (STUArray s Int Int64)
      sequence_
        [ search (value, ext) mem (left, left + len)
        | len <- [1 .. m]
        , left <- [0 .. m - len]
        ]
      readArray mem (hash 0 m)

main = do
  [n, m] <- fmap parseInts getLine
  a <- fmap parseInts getLine
  let a' = group a
  if length a' > 2 * n
    then print 0
    else print . solve n . fmap head $ a'

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM_)
import Control.Monad.ST (ST, runST)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Array.IArray ((!), listArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftL, shiftR)
import Data.Char (ord, isSpace)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap, (!?), empty, insert)
import Data.List (group)
import Data.Ratio (denominator, numerator)
import Data.Sequence
  ( Seq
  , Seq((:<|))
  , Seq((:|>))
  , Seq(Empty)
  , (><)
  , fromList
  , index
  , spanl
  , spanr
  , update
  )
import qualified Data.Sequence as S (length, replicate, splitAt)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)
import qualified Data.ByteString.Char8 as BS (readInt, getContents, getLine, dropWhile)

parseInts s = parse id s []
  where
    parse r s = case BS.readInt (BS.dropWhile isSpace s) of
                  Nothing -> r
                  Just (i, s') -> parse (r . (i :)) s'

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField 998244353

type Hash = IntMap MField

data Node =
  Node
    { getIndex :: !Int
    , getValue :: !Int
    , getExt :: !Int
    }
  deriving (Show, Eq)

hash l r = l `shiftL` 10 .|. r

{-# INLINE hash #-}
mm = 998244353 :: Int64

madd :: Int64 -> Int64 -> Int64
madd a b
  | a + b < mm = a + b
  | otherwise = (a + b) - mm

{-# INLINE madd #-}
mmul :: Int64 -> Int64 -> Int64
mmul a b = a * b `mod` mm

{-# INLINE mmul #-}
search ::
     forall s.
     (UArray Int Int, UArray Int Int)
  -> STUArray s Int Int64
  -> (Int, Int)
  -> ST s ()
search (value, ext) mem (left, right) = do
  let hc = hash left right
      mlo =
        foldl
          (\mm i ->
             mm >>= \m ->
               if ext ! i >= right
                 then Nothing
                 else Just (min m (value ! i)))
          (Just (value ! left))
          [left .. right - 1]
  ret <-
    case mlo of
      Nothing -> return 0
      Just lo ->
        let loop f s i
              | f i = loop f s (s i)
              | otherwise = i
            findNext = loop ((/=) lo . (value !))
            !lp = findNext succ left
            !rp = findNext pred (right - 1)
            lov = single (lp, rp)
            access l r = readArray mem (hash l r)
            single (l, r)
              | l == r = return 1
              | value ! l == lo = single (l + 1, r)
              | otherwise = liftA2 mmul (access l l') (single (l', r))
              where
                l' = findNext succ l
            lv = match (left, lp)
            rv = match (rp + 1, right)
            match (l, r) =
              foldr
                (liftA2 madd)
                (return 0)
                [liftA2 mmul (access l m) (access m r) | m <- [l .. r]]
         in liftA2 mmul lov (liftA2 mmul lv rv)
  writeArray mem hc ret

solve :: Int -> [Int] -> Int64
solve n a = runST recur
  where
    a' = reverse (zip a [0 ..])
    es = evalState (mapM findNext a') (S.replicate (n + 1) (-1))
    findNext :: (Int, Int) -> State (Seq Int) Int
    findNext (v, i) = do
      next <- get
      let p = index next v
      put (update v i next)
      if p == -1
        then return i
        else return p
    m = length a
    value = listArray (0, m - 1) a :: UArray Int Int
    ext = listArray (0, m - 1) (reverse es) :: UArray Int Int
    recur :: forall s. ST s Int64
    recur = do
      mem <- newArray (0, 1 `shiftL` 20) 1 :: ST s (STUArray s Int Int64)
      sequence_
        [ search (value, ext) mem (left, left + len)
        | len <- [1 .. m]
        , left <- [0 .. m - len]
        ]
      readArray mem (hash 0 m)

main = do
  [n, m] <- fmap parseInts BS.getLine
  a <- fmap parseInts BS.getLine
  let a' = group a
  if length a' > 2 * n
    then print 0
    else print . solve n . fmap head $ a'

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM_)
import Control.Monad.ST (ST, runST)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Array.IArray ((!), listArray)
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftL)
import Data.Char (ord)
import Data.IntMap.Strict (IntMap, (!?), empty, insert)
import Data.List (group)
import Data.Ratio (denominator, numerator)
import Data.Int (Int64)
import Data.Sequence
  ( Seq
  , Seq((:<|))
  , Seq((:|>))
  , Seq(Empty)
  , (><)
  , fromList
  , index
  , spanl
  , spanr
  , update
  )
import qualified Data.Sequence as S (length, replicate, splitAt)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField 998244353

type Hash = IntMap MField

data Node =
  Node
    { getIndex :: !Int
    , getValue :: !Int
    , getExt :: !Int
    }
  deriving (Show, Eq)

hash l r = l `shiftL` 10 .|. r

{-# INLINE hash #-}

mm = 998244353 :: Int64
madd :: Int64 -> Int64 -> Int64
madd a b
  | a + b < mm = a + b
  | otherwise = a + b - mm

{-# INLINE madd #-}

mmul :: Int64 -> Int64 -> Int64
mmul a b = fromIntegral (toInteger a * toInteger b `mod` toInteger mm)
{-# INLINE mmul #-}

search ::
     forall s. (UArray Int Int, UArray Int Int)
  -> STUArray s Int Int64
  -> (Int, Int)
  -> ST s ()
search (value, ext) mem (left, right)
  | left == right = return ()
  | otherwise = do
    let hc = hash left right
        mlo =
          foldl
            (\mm i ->
               mm >>= \m ->
                 if ext ! i >= right
                   then Nothing
                   else Just (min m (value ! i)))
            (Just (value ! left))
            [left .. right - 1]
    ret <-
      case mlo of
        Nothing -> return 0
        Just lo ->
          let loop f s i
                | f i = loop f s (s i)
                | otherwise = i
              findNext = loop ((/=) lo . (value !))
              !lp = findNext succ left
              !rp = findNext pred (right - 1)
              lov = single (lp, rp)
              single (l, r)
                | l == r = return 1
                | value ! l == lo = single (l + 1, r)
                | otherwise =
                  liftA2 mmul (readArray mem (hash l l')) (single (l', r))
                where
                  l' = findNext succ l
              lv = match (left, left, lp)
              rv = match (rp + 1, rp + 1, right)
              match (l, m, r)
                | m > r = return 0
                | m == r = readArray mem (hash l m)
                | otherwise =
                  let m' = (ext ! m) + 1
                   in liftA2
                        madd
                        (liftA2
                           mmul
                           (readArray mem (hash l m))
                           (readArray mem (hash m r)))
                        (match (l, m', r))
           in fmap product (sequence [lov, lv, rv])
    writeArray mem hc ret

solve :: Int -> [Int] -> Int64
solve n a = runST recur
  where
    a' = reverse (zip a [0 ..])
    es = evalState (mapM findNext a') (S.replicate (n + 1) (-1))
    findNext :: (Int, Int) -> State (Seq Int) Int
    findNext (v, i) = do
      next <- get
      let p = index next v
      put (update v i next)
      if p == -1
        then return i
        else return p
    m = length a
    value = listArray (0, m - 1) a :: UArray Int Int
    ext = listArray (0, m - 1) (reverse es) :: UArray Int Int
    recur :: forall s. ST s Int64
    recur = do
      mem <- newArray (0, 1 `shiftL` 20) 1 :: ST s (STUArray s Int Int64)
      sequence_
        [ search (value, ext) mem (left, left + len)
        | len <- [1 .. m]
        , left <- [0 .. m - len]
        ]
      readArray mem (hash 0 m)

main = do
  [n, m] <- fmap parseInts getLine
  a <- fmap parseInts getLine
  let a' = group a
  if length a' > 2 * n
    then print 0
    else print . solve n . fmap head $ a'

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM_)
import Control.Monad.ST (ST, runST)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Array.IArray ((!), listArray)
import Data.Array.ST.Safe (STArray, STUArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.Bits ((.|.), shiftL)
import Data.Char (ord)
import Data.IntMap.Strict (IntMap, (!?), empty, insert)
import Data.List (group)
import Data.Ratio (denominator, numerator)
import Data.Int (Int64)
import Data.Sequence
  ( Seq
  , Seq((:<|))
  , Seq((:|>))
  , Seq(Empty)
  , (><)
  , fromList
  , index
  , spanl
  , spanr
  , update
  )
import qualified Data.Sequence as S (length, replicate, splitAt)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

newtype PrimeField (p :: Nat) =
  PrimeField Natural
  deriving (Eq)

char :: KnownNat p => PrimeField p -> Natural
char = natVal

instance KnownNat p => Show (PrimeField p) where
  show (PrimeField a) = show a

instance KnownNat p => Num (PrimeField p) where
  (+) x@(PrimeField a) (PrimeField b) =
    PrimeField $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(PrimeField a) (PrimeField b) = PrimeField $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = PrimeField . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(PrimeField a) =
    PrimeField $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

instance KnownNat p => Fractional (PrimeField p) where
  recip x@(PrimeField a)
    | a == 0 = undefined
    | a == 1 = 1
    | otherwise = negate (PrimeField q) * recip (PrimeField r)
    where
      mm = char x
      (q, r) = mm `divMod` a
  fromRational =
    liftA2 (/) (fromInteger . numerator) (fromInteger . denominator)

type MField = PrimeField 998244353

type Hash = IntMap MField

data Node =
  Node
    { getIndex :: !Int
    , getValue :: !Int
    , getExt :: !Int
    }
  deriving (Show, Eq)

hash l r = l `shiftL` 10 .|. r

{-# INLINE hash #-}

mm = 998244353 :: Int64
madd :: Int64 -> Int64 -> Int64
madd a b
  | a + b < mm = a + b
  | otherwise = a + b - mm

{-# INLINE madd #-}

mmul :: Int64 -> Int64 -> Int64
mmul a b = a * b `mod` mm
{-# INLINE mmul #-}

search ::
     forall s. (UArray Int Int, UArray Int Int)
  -> STUArray s Int Int64
  -> (Int, Int)
  -> ST s ()
search (value, ext) mem (left, right)
  | left == right = return ()
  | otherwise = do
    let hc = hash left right
        mlo =
          foldl
            (\mm i ->
               mm >>= \m ->
                 if ext ! i >= right
                   then Nothing
                   else Just (min m (value ! i)))
            (Just (value ! left))
            [left .. right - 1]
    ret <-
      case mlo of
        Nothing -> return 0
        Just lo ->
          let loop f s i
                | f i = loop f s (s i)
                | otherwise = i
              findNext = loop ((/=) lo . (value !))
              !lp = findNext succ left
              !rp = findNext pred (right - 1)
              lov = single (lp, rp)
              single (l, r)
                | l == r = return 1
                | value ! l == lo = single (l + 1, r)
                | otherwise =
                  liftA2 mmul (readArray mem (hash l l')) (single (l', r))
                where
                  l' = findNext succ l
              lv = match (left, left, lp)
              rv = match (rp + 1, rp + 1, right)
              match (l, m, r)
                | m > r = return 0
                | m == r = readArray mem (hash l m)
                | otherwise =
                  let m' = (ext ! m) + 1
                   in liftA2
                        madd
                        (liftA2
                           mmul
                           (readArray mem (hash l m))
                           (readArray mem (hash m r)))
                        (match (l, m', r))
           in fmap product (sequence [lov, lv, rv])
    writeArray mem hc ret

solve :: Int -> [Int] -> Int64
solve n a = runST recur
  where
    a' = reverse (zip a [0 ..])
    es = evalState (mapM findNext a') (S.replicate (n + 1) (-1))
    findNext :: (Int, Int) -> State (Seq Int) Int
    findNext (v, i) = do
      next <- get
      let p = index next v
      put (update v i next)
      if p == -1
        then return i
        else return p
    m = length a
    value = listArray (0, m - 1) a :: UArray Int Int
    ext = listArray (0, m - 1) (reverse es) :: UArray Int Int
    recur :: forall s. ST s Int64
    recur = do
      mem <- newArray (0, 1 `shiftL` 20) 1 :: (ST s) (STUArray s Int Int64)
      sequence_
        [ search (value, ext) mem (left, left + len)
        | len <- [1 .. m]
        , left <- [0 .. m - len]
        ]
      readArray mem (hash 0 m)

main = do
  [n, m] <- fmap parseInts getLine
  a <- fmap parseInts getLine
  let a' = group a
  if length a' > 2 * n
    then print 0
    else print . solve n . fmap head $ a'


Your favorite shop sells $$$n$$$ Kinder Surprise chocolate eggs. You know that exactly $$$s$$$ stickers and exactly $$$t$$$ toys are placed in $$$n$$$ eggs in total.Each Kinder Surprise can be one of three types:  it can contain a single sticker and no toy;  it can contain a single toy and no sticker;  it can contain both a single sticker and a single toy. But you don't know which type a particular Kinder Surprise has. All eggs look identical and indistinguishable from each other.What is the minimum number of Kinder Surprise Eggs you have to buy to be sure that, whichever types they are, you'll obtain at least one sticker and at least one toy?Note that you do not open the eggs in the purchasing process, that is, you just buy some number of eggs. It's guaranteed that the answer always exists.

The first line contains the single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of queries. Next $$$T$$$ lines contain three integers $$$n$$$, $$$s$$$ and $$$t$$$ each ($$$1 \le n \le 10^9$$$, $$$1 \le s, t \le n$$$, $$$s + t \ge n$$$) — the number of eggs, stickers and toys. All queries are independent.

Print $$$T$$$ integers (one number per query) — the minimum number of Kinder Surprise Eggs you have to buy to be sure that, whichever types they are, you'll obtain at least one sticker and one toy

NoteIn the first query, we have to take at least $$$6$$$ eggs because there are $$$5$$$ eggs with only toy inside and, in the worst case, we'll buy all of them.In the second query, all eggs have both a sticker and a toy inside, that's why it's enough to buy only one egg.In the third query, we have to buy both eggs: one with a sticker and one with a toy.

main = interact $ unlines . map (show . solve) . triplets . map read . tail . words
triplets (a:b:c:xs) = (a,b,c) : triplets xs
triplets [] = []
solve (n,s,t) = 1 + max (min s (n-t)) (min t (n-s))


Winters are just damn freezing cold in Nvodsk! That's why a group of n friends prefers to take a taxi, order a pizza and call girls. The phone numbers in the city consist of three pairs of digits (for example, 12-34-56). Each friend has a phonebook of size si (that's the number of phone numbers). We know that taxi numbers consist of six identical digits (for example, 22-22-22), the numbers of pizza deliveries should necessarily be decreasing sequences of six different digits (for example, 98-73-21), all other numbers are the girls' numbers.You are given your friends' phone books. Calculate which friend is best to go to when you are interested in each of those things (who has maximal number of phone numbers of each type). If the phone book of one person contains some number two times, you should count it twice. That is, each number should be taken into consideration the number of times it occurs in the phone book.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of friends.  Then follow n data blocks that describe each friend's phone books. Each block is presented in the following form: first goes the line that contains integer si and string namei (0 ≤ si ≤ 100) — the number of phone numbers in the phone book of the i-th friend and the name of the i-th friend. The name is a non-empty sequence of uppercase and lowercase Latin letters, containing no more than 20 characters. Next si lines contain numbers as "XX-XX-XX", where X is arbitrary digits from 0 to 9.

In the first line print the phrase "If you want to call a taxi, you should call: ". Then print names of all friends whose phone books contain maximal number of taxi phone numbers.  In the second line print the phrase "If you want to order a pizza, you should call: ". Then print names of all friends who have maximal number of pizza phone numbers.  In the third line print the phrase "If you want to go to a cafe with a wonderful girl, you should call: ". Then print names of all friends who have maximal number of girls' phone numbers.  Print the names in the order in which they are given in the input data. Separate two consecutive names with a comma and a space. Each line should end with exactly one point. For clarifications concerning the output form, see sample tests. It is necessary that you follow the output form strictly. Extra spaces are not allowed.

If you want to call a taxi, you should call: Rogulenko.
If you want to order a pizza, you should call: Fedorov, Rogulenko, Kaluzhin.
If you want to go to a cafe with a wonderful girl, you should call: Melnikov.

If you want to call a taxi, you should call: Gleb.
If you want to order a pizza, you should call: Gleb, Serega.
If you want to go to a cafe with a wonderful girl, you should call: Melnik.

If you want to call a taxi, you should call: Pachocki.
If you want to order a pizza, you should call: Kulczynski, Pachocki.
If you want to go to a cafe with a wonderful girl, you should call: Kulczynski.

NoteIn the first sample you are given four friends. Fedorov's phone book contains one taxi number and one pizza delivery number, Melnikov's phone book only has 3 numbers of girls, Rogulenko's one has 6 taxi numbers and one pizza delivery number, Kaluzhin's one contains 2 taxi numbers and one pizza delivery number.Thus, if you need to order a taxi, you should obviously call Rogulenko, if you need to order a pizza you should call anybody of the following: Rogulenko, Fedorov, Kaluzhin (each of them has one number). Melnikov has maximal number of phone numbers of girls.

import Data.List
p[]f=[]
p(h:t)f=(s,length(filter f a)):p r f where[z,s]=words h;(a,r)=splitAt(read z)t
t=(==1).length.nub
z x=and$zipWith(>)x(tail x)
l x=not$z x||t x
s p=g"call a taxi"t++g"order a pizza"z++g"go to a cafe with a wonderful girl"l where g s f="If you want to "++s++", you should call: "++intercalate", "(b$p f)++".\n";b l=[x|(x,y)<-l,y==maximum(map snd l)]
main=interact$s.p.tail.map(filter(/='-')).lines

import Data.List (intercalate)

type Phone  =  String

isTaxi :: Phone -> Bool
isTaxi [c1, c2, _, c3, c4, _, c5, c6]
    =  c1 == c2
    && c1 == c3
    && c1 == c4
    && c1 == c5
    && c1 == c6
isTaxi s  =  error $ "isTaxi: incorrect format:" ++ s

isPizza :: Phone -> Bool
isPizza [c1, c2, _, c3, c4, _, c5, c6]
    =  c1 > c2
    && c2 > c3
    && c3 > c4
    && c4 > c5
    && c5 > c6
isPizza s  =  error $ "isPizza: incorrect format:" ++ s

isGirl :: Phone -> Bool
isGirl s  =  not (isPizza s) && not (isTaxi s)

--------------------------------------------------------------------------------

type Friend  =  (String, [Phone])

countPhones :: (Phone -> Bool) -> Friend -> Int
countPhones f (_, phones)  =  length $ filter f phones

replicateM :: Monad m => Int -> m a -> m [a]
replicateM n action  =  sequence (map (\x -> action) [1..n])

readFriend :: IO Friend
readFriend  =  do
    line <- getLine
    let m  =  read $ head $ words line
    let name  =  words line !! 1
    phones <- replicateM m getLine
    return (name, phones)

--------------------------------------------------------------------------------

solve :: [Friend] -> ([Friend], [Friend], [Friend])
solve friends  =  solve' friends ([], [], [])
  where
    maxTaxi   =  maximum (map (countPhones isTaxi ) friends)
    maxPizza  =  maximum (map (countPhones isPizza) friends)
    maxGirl   =  maximum (map (countPhones isGirl ) friends)
    solve' [] (t, p, g)  =  (reverse t, reverse p, reverse g)
    solve' (f:fs) (t, p, g)  =  solve' fs (ts, ps, gs)
      where
        ts  =  if countPhones isTaxi  f == maxTaxi  then f:t else t
        ps  =  if countPhones isPizza f == maxPizza then f:p else p
        gs  =  if countPhones isGirl  f == maxGirl  then f:g else g

text1 = "If you want to call a taxi, you should call: "
text2 = "If you want to order a pizza, you should call: "
text3 = "If you want to go to a cafe with a wonderful girl, you should call: "

printAns :: ([Friend], [Friend], [Friend]) -> IO ()
printAns (f1, f2, f3)  =  do
    putStr text1 >> putStr (show' f1) >> putStrLn "."
    putStr text2 >> putStr (show' f2) >> putStrLn "."
    putStr text3 >> putStr (show' f3) >> putStrLn "."
      where
        show' fs  =  intercalate ", " (map fst fs)

main :: IO ()
main  =  do
    n <- readLn
    friends <- replicateM n readFriend
    printAns $ solve friends

import Data.List
import Control.Monad

data Contacts = Contacts String [String]

mxnames myfunc contacts = map (\(Contacts name nos) -> name) $ myfunc contacts
isTaxi = (1==).length.nub
isPizza x = x == (reverse.sort.nub) x
isGirl x = (not (isTaxi x)) && (not (isPizza x))

getMax myfunc contacts = intercalate ", " $ mxnames myMaxes contacts
  where mylen (Contacts name nos) = length $ filter myfunc nos
        myMaxes contacts = filter ((mval==).mylen) contacts
          where mval = maximum $ map mylen contacts

readContact :: IO Contacts
readContact = do
  [n1, name] <- fmap words getLine
  let n = read n1
      getno = do
        no <- fmap (filter (/= '-')) getLine
        return no
  nos <- replicateM n getno
  return $ Contacts name nos

main = do
  n <- fmap read getLine
  contacts <- replicateM n readContact
  putStrLn $ "If you want to call a taxi, you should call: " ++ (getMax isTaxi contacts) ++ "."
  putStrLn $ "If you want to order a pizza, you should call: " ++ (getMax isPizza contacts) ++ "."
  putStrLn $ "If you want to go to a cafe with a wonderful girl, you should call: " ++ (getMax isGirl contacts) ++ "."

import Data.List

data Contacts = Contacts Int String [String]

mxnames myfunc contacts = map (\(Contacts n name nos) -> name) $ myfunc contacts
isTaxi x = 1 == (length.nub) x
isPizza x = x == (reverse.sort.nub) x
isGirl x = (not (isTaxi x)) && (not (isPizza x))

getMaxTaxis contacts = intercalate ", " $ mxnames mxTaxis contacts
  where taxis (Contacts n name nos) = length $ filter isTaxi nos
        mxTaxis contacts = filter (\x -> taxis x == mval) contacts
          where mval = maximum $ map taxis contacts

getMaxPizza contacts = intercalate ", " $ mxnames mxPizzas contacts
  where pizzas (Contacts n name nos) = length $ filter isPizza nos
        mxPizzas contacts = filter (\x -> pizzas x == mval) contacts
          where mval = maximum $ map pizzas contacts

getMaxGirls contacts = intercalate ", " $ mxnames mxGirls contacts
  where girls (Contacts n name nos) = length $ filter isGirl nos
        mxGirls contacts = filter (\x -> girls x == mval) contacts
          where mval = maximum $ map girls contacts

readContact :: IO Contacts
readContact = do
  [n1, name] <- fmap words getLine
  let n = read n1
      getno = do
        no <- fmap (filter (\x -> x /= '-')) getLine
        return no
  nos <- sequence $ take n $ repeat getno
  return $ Contacts n name nos

main = do
  n <- fmap read getLine
  contacts <- sequence $ take n $ repeat readContact
  putStrLn $ "If you want to call a taxi, you should call: " ++ (getMaxTaxis contacts) ++ "."
  putStrLn $ "If you want to order a pizza, you should call: " ++ (getMaxPizza contacts) ++ "."
  putStrLn $ "If you want to go to a cafe with a wonderful girl, you should call: " ++ (getMaxGirls contacts) ++ "."

import Data.List

data Contacts = Contacts Int String [String]

mxnames myfunc contacts = map (\(Contacts n name nos) -> name) $ myfunc contacts
isTaxi x = 1 == (length.nub) x
isPizza x = x == (reverse.sort.nub) x
isGirl x = (not (isTaxi x)) && (not (isPizza x))

getMax myfunc contacts = intercalate ", " $ mxnames myMaxes contacts
  where mylen (Contacts n name nos) = length $ filter myfunc nos
        myMaxes contacts = filter (\x -> mylen x == mval) contacts
          where mval = maximum $ map mylen contacts

readContact :: IO Contacts
readContact = do
  [n1, name] <- fmap words getLine
  let n = read n1
      getno = do
        no <- fmap (filter (\x -> x /= '-')) getLine
        return no
  nos <- sequence $ take n $ repeat getno
  return $ Contacts n name nos

main = do
  n <- fmap read getLine
  contacts <- sequence $ take n $ repeat readContact
  putStrLn $ "If you want to call a taxi, you should call: " ++ (getMax isTaxi contacts) ++ "."
  putStrLn $ "If you want to order a pizza, you should call: " ++ (getMax isPizza contacts) ++ "."
  putStrLn $ "If you want to go to a cafe with a wonderful girl, you should call: " ++ (getMax isGirl contacts) ++ "."

import Data.List (intercalate, nub, sortBy, unfoldr)
import Data.Char (isDigit)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . lines

data Phone = Phone { name :: String, taxi :: Int, pizza :: Int, girl :: Int } deriving Show

solve :: [String] -> [String]
solve (_:cs) = let cs' = unfoldr f cs in solve' cs'
  where f [] = Nothing
        f (x:xs) = Just (classify n numbers, rest)
          where [ si, n ] = words x
                (numbers, rest) = splitAt (read si) xs
solve _ = undefined

solve' :: [Phone] -> [String]
solve' phones = zipWith (++) prefixes [ (++".") $ intercalate ", " $ map name
              $ filter ((==maximum (map f phones)) . f) phones | f <- [ taxi, pizza, girl ] ]
  where prefixes = [ "If you want to call a taxi, you should call: ",
                     "If you want to order a pizza, you should call: ",
                     "If you want to go to a cafe with a wonderful girl, you should call: " ]

isTaxi :: String -> Bool
isTaxi xs = length (nub (filter isDigit xs)) == 1

isPizza :: String -> Bool
isPizza xs = sortBy (flip compare) (nub xs') == xs'
  where xs' = filter isDigit xs

classify :: String -> [String] -> Phone
classify n xs = Phone n t p (length xs - t - p)
  where t = length (filter isTaxi xs)
        p = length (filter isPizza xs)

import Data.List (intercalate, nub, sortBy, unfoldr)
import Data.Char (isDigit)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . lines

data Phone = Phone { name :: String, taxi :: Int, pizza :: Int, girl :: Int } deriving Show

solve :: [String] -> [String]
solve (_:cs) = let cs' = unfoldr f cs in solve' cs'
  where f [] = Nothing
        f (x:xs) = Just (classify n numbers, rest)
          where [ si, n ] = words x
                (numbers, rest) = splitAt (read si) xs
solve _ = undefined

solve' :: [Phone] -> [String]
solve' phones = zipWith (++) prefixes [ (++".") $ intercalate ", " $ map name
              $ filter ((==maximum (map f phones)) . f) phones | f <- [ taxi, pizza, girl ] ]
  where prefixes = [ "If you want to call a taxi, you should call: ",
                     "If you want to order a pizza, you should call: ",
                     "If you want to go to a cafe with a wonderful girl, you should call: " ]

isTaxi :: String -> Bool
isTaxi xs = length (nub (filter isDigit xs)) == 1

isPizza :: String -> Bool
isPizza xs = length (nub xs') == 6 && xs' == sortBy (flip compare) xs'
  where xs' = filter isDigit xs

classify :: String -> [String] -> Phone
classify n xs = Phone n t p (length xs - t - p)
  where t = length (filter isTaxi xs)
        p = length (filter isPizza xs)

import Data.List (intercalate, nub, sortBy, unfoldr)
import Data.Char (isDigit)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . tail . lines

data Phone = Phone { name :: String, taxi :: Int, pizza :: Int, girl :: Int } deriving Show

solve :: [String] -> [String]
solve = solve' . unfoldr f
  where f [] = Nothing
        f (x:xs) = Just (classify n numbers, rest)
          where [ si, n ] = words x
                (numbers, rest) = splitAt (read si) xs

solve' :: [Phone] -> [String]
solve' phones = zipWith (++) prefixes [ (++".") $ intercalate ", " $ map name
              $ filter ((==maximum (map f phones)) . f) phones | f <- [ taxi, pizza, girl ] ]
  where prefixes = [ "If you want to call a taxi, you should call: ",
                     "If you want to order a pizza, you should call: ",
                     "If you want to go to a cafe with a wonderful girl, you should call: " ]

isTaxi :: String -> Bool
isTaxi xs = length (nub (filter isDigit xs)) == 1

isPizza :: String -> Bool
isPizza xs = sortBy (flip compare) (nub xs') == xs'
  where xs' = filter isDigit xs

classify :: String -> [String] -> Phone
classify n xs = Phone n t p (length xs - t - p)
  where t = length (filter isTaxi xs)
        p = length (filter isPizza xs)

import Data.List
import Data.Ord
import Control.Monad
main = do
  n <- readLn
  rs <- replicateM n $ do
    [s,nm] <- liftM words getLine
    (t,p,g) <- liftM classify $ replicateM (read s) $
               liftM (filter (/= '-')) getLine
    return (nm,t,p,g)
  let mt = taxis $ maximumBy (comparing taxis) rs
      mp = pizzas $ maximumBy (comparing pizzas) rs
      mg = girls $ maximumBy (comparing girls) rs
  putStrLn $ "If you want to call a taxi, you should call: " ++
             intercalate ", " (map name $ filter ((== mt) . taxis) rs) ++ "."
  putStrLn $ "If you want to order a pizza, you should call: " ++
             intercalate ", " (map name $ filter ((== mp) . pizzas) rs) ++ "."
  putStrLn $ "If you want to go to a cafe with a wonderful girl, you should call: " ++ intercalate ", " (map name $ filter ((== mg) . girls) rs) ++ "."
name (n,_,_,_) = n
taxis (_,t,_,_) = t
pizzas (_,_,p,_) = p
girls (_,_,_,g) = g
classify ns = (length ts,length ps,length gs)
    where (ts,ts') = partition isTaxi ns
          (ps,gs) = partition isPizza ts'
isTaxi (x:y:zs) = x == y && isTaxi (y:zs)
isTaxi _ = True
isPizza (x:y:zs) = x > y && isPizza (y:zs)
isPizza _ = True

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

main = do n <- read <$> getLine
          cs <- forM [1..n] $ \_->
                  do [m,name] <- words <$> getLine
                     tels <- forM [1..read m] $ \_-> parse <$> getLine
                     return (name,tels)
          putStrLn $ unlines $ solve cs

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

unwords' :: [String] -> String
unwords' [] = []
unwords' [c] = c++"."
unwords' (c:cs) = c++", "++(unwords' cs)

solve :: [(String,[[Int]])] -> [String]
solve xs = [taxi,pizza,girl]
   where taxi = "If you want to call a taxi, you should call: "++(unwords' $ map fst $ filter maxTaxi ys)
         pizza = "If you want to order a pizza, you should call: "++(unwords' $ map fst $ filter maxPizza ys)
         girl = "If you want to go to a cafe with a wonderful girl, you should call: "++(unwords' $ map fst $ filter maxGirl ys)
         ys = map f xs
         maxt = maximum $ map (\ (_,(x,_,_)) -> x) ys
         maxp = maximum $ map (\ (_,(_,x,_)) -> x) ys
         maxg = maximum $ map (\ (_,(_,_,x)) -> x) ys
         maxTaxi (_,(x,_,_)) = x == maxt
         maxPizza (_,(_,x,_)) = x == maxp
         maxGirl (_,(_,_,x)) = x == maxg

f :: (String,[[Int]]) -> (String,(Int,Int,Int))
f (name,xss) = (name,(g isTaxi xss,g isPizza xss,g isGirl xss))

g :: ([Int] -> Bool) -> [[Int]] -> Int
g p xss = length $ filter p xss

isTaxi (x:xs) = all (x==) xs
isPizza [x] = True
isPizza (x:xs) = all (<x) xs && isPizza xs
isGirl xs = not (isTaxi xs || isPizza xs)

import Data.List

addNumber [t,p,g] = parse.filter (/='-') where
	parse s
		| length (nub s) == 1 = [t+1,p,g]
		| s==reverse (sort s) && length (nub s)==6 = [t,p+1,g]
		| otherwise = [t,p,g+1]

consume [] = []
consume ([count,name]:t) = (name, nCount):consume rest where
	(phones,rest) = splitAt (read count) t
	nCount = foldl (addNumber) [0,0,0] (map head phones)

printInfo info = unlines [tm,pm,gm] where
	getX x = (!!x).snd
	maxX x = maximum (map (getX x) info)
	bstsX x = concat.intersperse ", ".map fst.filter ((==) (maxX x).getX x)$info
	tm = "If you want to call a taxi, you should call: "++bstsX 0++"."
	pm = "If you want to order a pizza, you should call: "++bstsX 1++"."
	gm = "If you want to go to a cafe with a wonderful girl, you should call: "++bstsX 2++"."

main=interact$printInfo.consume.map words.tail.lines

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

isPizza list = and $ zipWith (>) list (tail list)
isTaxi list = and $ zipWith (==) list (tail list)
isGirl list = not (isPizza list) && not (isTaxi list)

process str f friends =
    let c = [ (name, length $ filter f phone) | (name, phone) <- friends]
        mx = maximum $ map snd c
        ans = map fst $ filter ((== mx) . snd) c
    in str ++ intercalate ", " ans ++ "."

main = do
    n <- liftM read getLine
    friends <- replicateM (n :: Int) $ do
        [m', name] <- liftM words getLine

        phones <- replicateM (read m' :: Int) $ do
            line <- getLine
            return [ord c - ord '0' |
                    p <- [0, 1, 3, 4, 6, 7],
                    let c = line !! p]

        return (name, phones)

    putStrLn $ process "If you want to call a taxi, you should call: " isTaxi friends
    putStrLn $ process "If you want to order a pizza, you should call: " isPizza friends
    putStrLn $ process "If you want to go to a cafe with a wonderful girl, you should call: " isGirl friends

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Function
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

type Book = ([Number], [Number], [Number])
type Number = (Int, Int, Int, Int, Int, Int)

getNumber :: IO Number
getNumber = do {(a:b:_:c:d:_:e:f:_) <- getLine;return (digitToInt a,digitToInt b,digitToInt c,digitToInt d,digitToInt e,digitToInt f)}

isTaxi :: Number -> Bool
isTaxi (a,b,c,d,e,f) = a==b && a==c && a==d && a==e && a==f

isPizza :: Number -> Bool
isPizza (a,b,c,d,e,f) = a>b && b>c && c>d && d>e && e>f

main_loop2 :: Int -> Book -> IO Book
main_loop2 n b@(b1,b2,b3) = if n == 0 then return b
                            else
                                do pn <- getNumber
                                   if isTaxi pn then
                                       main_loop2 (n-1) (pn:b1, b2, b3)
                                    else
                                       if isPizza pn then
                                           main_loop2 (n-1) (b1, pn:b2, b3)
                                        else
                                           main_loop2 (n-1) (b1, b2, pn:b3)

main_loop :: Int -> [(String, Book)] -> IO [(String, Book)]
main_loop n b = if n==0 then return b
                else
                    do
                      (m, name) <- scan :: IO (Int, String)
                      book <- main_loop2 m ([],[],[])
                      main_loop (n-1) ((name, book):b)

solve :: [(String, Book)] -> String
solve books = let phonedata = map (\(name,book) -> (name, (\(a,b,c) -> (length a, length b, length c)) book)) books
                  taxiorder = sortBy (compare `on` (\(_,(x,_,_)) -> -x)) phonedata
                  pizzaorder = sortBy (compare `on` (\(_,(_,x,_)) -> -x)) phonedata
                  girlorder = sortBy (compare `on` (\(_,(_,_,x)) -> -x)) phonedata
                  maxTaxi = (\(x,_,_) -> x).snd.head $ taxiorder
                  maxPizza = (\(_,x,_) -> x).snd.head $ pizzaorder
                  maxGirl = (\(_,_,x) -> x).snd.head $ girlorder
                  maximulTaxi = concat.reverse.intersperse ", ".map fst.takeWhile (\(_,(x,_,_)) -> x==maxTaxi) $ taxiorder
                  maximulPizza = concat.reverse.intersperse ", ".map fst.takeWhile (\(_,(_,x,_)) -> x==maxPizza) $ pizzaorder
                  maximulGirl = concat.reverse.intersperse ", ".map fst.takeWhile (\(_,(_,_,x)) -> x==maxGirl) $ girlorder
              in
                "If you want to call a taxi, you should call: "++ maximulTaxi++".\nIf you want to order a pizza, you should call: " ++ maximulPizza++".\nIf you want to go to a cafe with a wonderful girl, you should call: "++ maximulGirl ++"."

main = do n <- scan :: IO Int
          books <- main_loop n []
          putStrLn.solve $ books

import Data.List
import Data.Ord
import Control.Monad
main = do
  n <- readLn
  rs <- replicateM n $ do
    [s,nm] <- liftM words getLine
    (t,p,g) <- liftM classify $ replicateM (read s) $
               liftM (filter (/= '-')) getLine
    return (nm,t,p,g)
  let mt = taxis $ maximumBy (comparing taxis) rs
      mp = pizzas $ maximumBy (comparing pizzas) rs
      mg = girls $ maximumBy (comparing girls) rs
  putStrLn $ "If you want to call a taxi, you should call: " ++
             intercalate ", " (map name $ filter ((== mt) . taxis) rs) ++ "."
  putStrLn $ "If you want to order a pizza, you should call: " ++
             intercalate ", " (map name $ filter ((== mp) . pizzas) rs) ++ "."
  putStrLn $ "Of you want to go to a cafe with a wonderful girl, you should call: " ++ intercalate ", " (map name $ filter ((== mg) . girls) rs) ++ "."
name (n,_,_,_) = n
taxis (_,t,_,_) = t
pizzas (_,_,p,_) = p
girls (_,_,_,g) = g
classify ns = (length ts,length ps,length gs)
    where (ts,ts') = partition isTaxi ns
          (ps,gs) = partition isPizza ts'
isTaxi (x:y:zs) = x == y && isTaxi (y:zs)
isTaxi _ = True
isPizza (x:y:zs) = x > y && isPizza (y:zs)
isPizza _ = True

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Function
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

type Book = ([Number], [Number], [Number])
type Number = (Int, Int, Int, Int, Int, Int)

getNumber :: IO Number
getNumber = do {(a:b:_:c:d:_:e:f:_) <- getLine;return (digitToInt a,digitToInt b,digitToInt c,digitToInt d,digitToInt e,digitToInt f)}

isTaxi :: Number -> Bool
isTaxi (a,b,c,d,e,f) = a==b && a==c && a==d && a==e && a==f

isPizza :: Number -> Bool
isPizza (a,b,c,d,e,f) = a>b && b>c && c>d && d>e && e>f

main_loop2 :: Int -> Book -> IO Book
main_loop2 n b@(b1,b2,b3) = if n == 0 then return b
                            else
                                do pn <- getNumber
                                   if isTaxi pn then
                                       main_loop2 (n-1) (pn:b1, b2, b3)
                                    else
                                       if isPizza pn then
                                           main_loop2 (n-1) (b1, pn:b2, b3)
                                        else
                                           main_loop2 (n-1) (b1, b2, pn:b3)

main_loop :: Int -> [(String, Book)] -> IO [(String, Book)]
main_loop n b = if n==0 then return b
                else
                    do
                      (m, name) <- scan :: IO (Int, String)
                      book <- main_loop2 m ([],[],[])
                      main_loop (n-1) ((name, book):b)

solve :: [(String, Book)] -> String
solve books = let phonedata = map (\(name,book) -> (name, (\(a,b,c) -> (length a, length b, length c)) book)) books
                  taxiorder = sortBy (compare `on` (\(_,(x,_,_)) -> -x)) phonedata
                  pizzaorder = sortBy (compare `on` (\(_,(_,x,_)) -> -x)) phonedata
                  girlorder = sortBy (compare `on` (\(_,(_,_,x)) -> -x)) phonedata
                  maxTaxi = (\(x,_,_) -> x).snd.head $ taxiorder
                  maxPizza = (\(_,x,_) -> x).snd.head $ pizzaorder
                  maxGirl = (\(_,_,x) -> x).snd.head $ girlorder
                  maximulTaxi = reverse.concat.intersperse ", ".map fst.takeWhile (\(_,(x,_,_)) -> x==maxTaxi) $ taxiorder
                  maximulPizza = reverse.concat.intersperse ", ".map fst.takeWhile (\(_,(_,x,_)) -> x==maxPizza) $ pizzaorder
                  maximulGirl = reverse.concat.intersperse ", ".map fst.takeWhile (\(_,(_,_,x)) -> x==maxGirl) $ girlorder
              in
                "If you want to call a taxi, you should call: "++ maximulTaxi++".\nIf you want to order a pizza, you should call: " ++ maximulPizza++".\nIf you want to go to a cafe with a wonderful girl, you should call: "++ maximulGirl ++"."

main = do n <- scan :: IO Int
          books <- main_loop n []
          putStrLn.solve $ books

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Function
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

type Book = ([Number], [Number], [Number])
type Number = (Int, Int, Int, Int, Int, Int)

getNumber :: IO Number
getNumber = do {(a:b:_:c:d:_:e:f:_) <- getLine;return (digitToInt a,digitToInt b,digitToInt c,digitToInt d,digitToInt e,digitToInt f)}

isTaxi :: Number -> Bool
isTaxi (a,b,c,d,e,f) = a==b && a==c && a==d && a==e && a==f

isPizza :: Number -> Bool
isPizza (a,b,c,d,e,f) = a>b && b>c && c>d && d>e && e>f

main_loop2 :: Int -> Book -> IO Book
main_loop2 n b@(b1,b2,b3) = if n == 0 then return b
                            else
                                do pn <- getNumber
                                   if isTaxi pn then
                                       main_loop2 (n-1) (pn:b1, b2, b3)
                                    else
                                       if isPizza pn then
                                           main_loop2 (n-1) (b1, pn:b2, b3)
                                        else
                                           main_loop2 (n-1) (b1, b2, pn:b3)

main_loop :: Int -> [(String, Book)] -> IO [(String, Book)]
main_loop n b = if n==0 then return b
                else
                    do
                      (m, name) <- scan :: IO (Int, String)
                      book <- main_loop2 m ([],[],[])
                      main_loop (n-1) ((name, book):b)

solve :: [(String, Book)] -> String
solve books = let phonedata = map (\(name,book) -> (name, (\(a,b,c) -> (length a, length b, length c)) book)) books
                  taxiorder = sortBy (compare `on` (\(_,(x,_,_)) -> -x)) phonedata
                  pizzaorder = sortBy (compare `on` (\(_,(_,x,_)) -> -x)) phonedata
                  girlorder = sortBy (compare `on` (\(_,(_,_,x)) -> -x)) phonedata
                  maxTaxi = (\(x,_,_) -> x).snd.head $ taxiorder
                  maxPizza = (\(_,x,_) -> x).snd.head $ pizzaorder
                  maxGirl = (\(_,_,x) -> x).snd.head $ girlorder
                  maximulTaxi = concat.intersperse ", ".map fst.takeWhile (\(_,(x,_,_)) -> x==maxTaxi) $ taxiorder
                  maximulPizza = concat.intersperse ", ".map fst.takeWhile (\(_,(_,x,_)) -> x==maxPizza) $ pizzaorder
                  maximulGirl = concat.intersperse ", ".map fst.takeWhile (\(_,(_,_,x)) -> x==maxGirl) $ girlorder
              in
                "If you want to call a taxi, you should call: "++ maximulTaxi++".\nIf you want to order a pizza, you should call:" ++ maximulPizza++".\nIf you want to go to a cafe with a wonderful girl, you should call: "++ maximulGirl ++"."

main = do n <- scan :: IO Int
          books <- main_loop n []
          putStrLn.solve $ books


A number $$$a_2$$$ is said to be the arithmetic mean of two numbers $$$a_1$$$ and $$$a_3$$$, if the following condition holds: $$$a_1 + a_3 = 2\cdot a_2$$$. We define an arithmetic mean deviation of three numbers $$$a_1$$$, $$$a_2$$$ and $$$a_3$$$ as follows: $$$d(a_1, a_2, a_3) = |a_1 + a_3 - 2 \cdot a_2|$$$.Arithmetic means a lot to Jeevan. He has three numbers $$$a_1$$$, $$$a_2$$$ and $$$a_3$$$ and he wants to minimize the arithmetic mean deviation $$$d(a_1, a_2, a_3)$$$. To do so, he can perform the following operation any number of times (possibly zero):  Choose $$$i, j$$$ from $$$\{1, 2, 3\}$$$ such that $$$i \ne j$$$ and increment $$$a_i$$$ by $$$1$$$ and decrement $$$a_j$$$ by $$$1$$$ Help Jeevan find out the minimum value of $$$d(a_1, a_2, a_3)$$$ that can be obtained after applying the operation any number of times.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 5000)$$$  — the number of test cases. The first and only line of each test case contains three integers $$$a_1$$$, $$$a_2$$$ and $$$a_3$$$ $$$(1 \le a_1, a_2, a_3 \le 10^{8})$$$.

For each test case, output the minimum value of $$$d(a_1, a_2, a_3)$$$ that can be obtained after applying the operation any number of times.

NoteNote that after applying a few operations, the values of $$$a_1$$$, $$$a_2$$$ and $$$a_3$$$ may become negative.In the first test case, $$$4$$$ is already the Arithmetic Mean of $$$3$$$ and $$$5$$$.$$$d(3, 4, 5) = |3 + 5 - 2 \cdot 4| = 0$$$In the second test case, we can apply the following operation:$$$(2, 2, 6)$$$ $$$\xrightarrow[\text{increment $$$a_2$$$}]{\text{decrement $$$a_1$$$}}$$$ $$$(1, 3, 6)$$$$$$d(1, 3, 6) = |1 + 6 - 2 \cdot 3| = 1$$$It can be proven that answer can not be improved any further.In the third test case, we can apply the following operations:$$$(1, 6, 5)$$$ $$$\xrightarrow[\text{increment $$$a_3$$$}]{\text{decrement $$$a_2$$$}}$$$ $$$(1, 5, 6)$$$ $$$\xrightarrow[\text{increment $$$a_1$$$}]{\text{decrement $$$a_2$$$}}$$$ $$$(2, 4, 6)$$$$$$d(2, 4, 6) = |2 + 6 - 2 \cdot 4| = 0$$$

import Control.Monad (replicateM_)

solve :: IO ()
solve = do
  cs <- getLine
  let [a,b,c] = read <$> words cs  :: [Int]
  let ans = if (a+c-2*b) `mod` 3 == 0 then 0 else 1
  print ans

main :: IO ()
main = do
  nStr <- getLine
  let n = read nStr
  replicateM_ n solve

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

solve :: IO ()
solve = do
    ~[x, y, z] <- readInts
    let m = (x + z - 2 * y) `mod` 3
    print $ m `min` (3 - m)

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [x, y, z] = min 1 $ abs (2 * y - x - z) `mod` 3

import Control.Monad (replicateM_)

solve :: IO ()
solve = do
  cs <- getLine
  let [a,b,c] = read <$> words cs  :: [Int]
  let ans = (abs (a+c-2*b) `mod` 3) `div` 2
  print ans

main :: IO ()
main = do
  nStr <- getLine
  let n = read nStr
  replicateM_ n solve

import Control.Monad (replicateM_)

solve = do
  cs <- getLine
  let [a,b,c] = read <$> words cs  :: [Int]
  let ans = abs (a+c-2*b) `mod` 3
  print ans

main = do
  nStr <- getLine
  let n = read nStr
  replicateM_ n solve

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

solve :: IO ()
solve = do
    ~[x, y, z] <- readInts
    print $ (x + z - 2 * y) `mod` 3

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

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

solve :: IO ()
solve = do
    ~[x, y, z] <- readInts
    print $ (x + y - 2 * z) `mod` 3

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [x, y, z] = abs (2 * y - x - z) `mod` 3


Appleman and Toastman play a game. Initially Appleman gives one group of n numbers to the Toastman, then they start to complete the following tasks:  Each time Toastman gets a group of numbers, he sums up all the numbers and adds this sum to the score. Then he gives the group to the Appleman.  Each time Appleman gets a group consisting of a single number, he throws this group out. Each time Appleman gets a group consisting of more than one number, he splits the group into two non-empty groups (he can do it in any way) and gives each of them to Toastman. After guys complete all the tasks they look at the score value. What is the maximum possible value of score they can get?

The first line contains a single integer n (1 ≤ n ≤ 3·105). The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 106) — the initial group that is given to Toastman.

Print a single integer — the largest possible score.

NoteConsider the following situation in the first example. Initially Toastman gets group [3, 1, 5] and adds 9 to the score, then he give the group to Appleman. Appleman splits group [3, 1, 5] into two groups: [3, 5] and [1]. Both of them should be given to Toastman. When Toastman receives group [1], he adds 1 to score and gives the group to Appleman (he will throw it out). When Toastman receives group [3, 5], he adds 8 to the score and gives the group to Appleman. Appleman splits [3, 5] in the only possible way: [5] and [3]. Then he gives both groups to Toastman. When Toastman receives [5], he adds 5 to the score and gives the group to Appleman (he will throws it out). When Toastman receives [3], he adds 3 to the score and gives the group to Appleman (he will throws it out). Finally Toastman have added 9 + 1 + 8 + 5 + 3 = 26 to the score. This is the optimal sequence of actions.

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = do
  (_:l:_) <- fmap LC.lines LC.getContents
  let a = L.sort $ readInts l
  print $ count 2 a - (toInteger $ last a)

count :: Int -> [Int] -> Integer
count _ [] = 0
count k (x:xs) = toInteger k * toInteger x + count (k+1) xs

-------------------------------------------------------------------------------

readInts :: LC.ByteString -> [Int]
readInts str = map readInt $ LC.words str

readInt :: LC.ByteString -> Int
readInt = LC.foldl' (\x c -> 10 * x + fromEnum c - 48) 0

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = do
  (_:line:_) <- fmap LC.lines LC.getContents
  let a = map toInteger $ L.sort $ readInts line
  print $ (sum $ zipWith (*) [2..] a) - (toInteger $ last a)

-------------------------------------------------------------------------------

readInts :: LC.ByteString -> [Int]
readInts str = map readInt $ LC.words str

readInt :: LC.ByteString -> Int
readInt = LC.foldl' (\x c -> 10 * x + fromEnum c - 48) 0

import Data.List

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

solve :: [Integer] -> Integer
solve a = sum (zipWith (*) [1..] (sort a)) - (maximum a) + (sum a)

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

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

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

main = do
  getLine
  xs <- map fromIntegral <$> getInts :: IO [Int64]

  print $ (sum $ tail $ scanl1 (+) $ reverse $ sort xs) + sum xs

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInteger x
someFunc::IO()
someFunc = (solve.concat=<<forM [1..2] (\i->map rIn.C.words<$>C.getLine) )
solve (x:xs) = print $ (sum $ zipWith (\a b->a*b) [2..] $ sort xs) - maximum xs

import Data.List

main = do
getLine
getLine >>= print . (\x -> let a = sortBy (\ x y -> if x < y then LT else if x > y then GT else EQ)  x in (last a * (toInteger $ length a)) + (sum $ zipWith (*) (init a) [(2::Integer)..]))  . map (\x -> read x :: Integer) . words

import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (foldl')
import Data.Set (fromList, toList)
import Control.Applicative
import Data.Int
import Data.Char
import Data.Array.Unboxed

readInt = B.foldl' (\x c -> 10 * x + fromIntegral (ord c) - 48) 0

main = do
  n <- read <$> getLine
  xs <- map fst . toList . fromList . flip zip [1..] . map readInt . B.words <$> B.getContents :: IO [Int64]
  print $ if null . drop 1 $ xs then head xs else
    let ar = listArray (0,n) $ 0:scanl1 (+) xs :: UArray Int Int64
        sm i = ar ! n - ar ! i
        add  = ar!n - last xs
    in  foldl' (+) 0 . (add:) . map sm $ [0..n-1]

import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (sort,foldl')
import Control.Applicative
import Data.Int
import Data.Char
import Data.Array.Unboxed

readInt = B.foldl' (\x c -> 10 * x + fromIntegral (ord c) - 48) 0

main = do
  n <- read <$> getLine
  xs <- sort . map readInt . B.words <$> B.getContents :: IO [Int64]
  print $ if null . drop 1 $ xs then head xs else
    let ar = listArray (0,n) $ 0:scanl1 (+) xs :: UArray Int Int64
        sm i = ar ! n - ar ! i
        add  = ar!n - last xs
    in  foldl' (+) 0 . (add:) . map sm $ [0..n-1]

import Data.List (sort)

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

solve :: [Integer] -> Integer
solve as = sum (zipWith (*) [1..] (sort as)) - maximum as + sum as

import Data.List
main = print . solve . map read . tail . words =<< getContents
solve xs = sum (zipWith (*) [2..] (sort xs)) - maximum xs

import Control.Applicative
import Data.List
main = do
	getLine
	a <- sort . map read . words <$> getLine :: IO [Integer]
	print $ (sum $ zipWith (*) [2..] a) - (last a)

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

main= do
	s<-  read <$> getLine ::IO Integer
	n<- sort.map (fst.fromJust.B.readInteger).B.words <$> B.getLine::IO [Integer]
	let ans= sum $ zipWith (*) n [2..]
 	if s==1 then print (last n ) else print $ ans - (last n)

import Control.Applicative
import Data.List

main= do
	s<-  read <$> getLine ::IO Integer
	n<- sort.map read.words <$> getLine::IO [Integer]
	let ans= sum $ zipWith (*) n [2..]
 	if s==1 then print (last n ) else print $ ans - (last n)

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as LC

main :: IO ()
main = do
  (_:l:_) <- fmap LC.lines LC.getContents
  let a = L.sort $ readInts l
  print $ count 2 a - last a

count :: Int -> [Int] -> Int
count _ [] = 0
count k (x:xs) = k*x + count (k+1) xs

-------------------------------------------------------------------------------

readInts :: LC.ByteString -> [Int]
readInts str = map readInt $ LC.words str

readInt :: LC.ByteString -> Int
readInt = LC.foldl' (\x c -> 10 * x + fromEnum c - 48) 0

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

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

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

main = do
  getLine
  xs <- getInts

  print $ (sum $ tail $ scanl1 (+) $ reverse $ sort xs) + sum xs

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = (solve.concat=<<forM [1..2] (\i->map rIn.C.words<$>C.getLine) )
solve (x:xs) = print $ (sum $ zipWith (\a b->a*b) [2..] $ sort xs) - maximum xs

import Data.List

main = do
getLine
getLine >>= print . (\x -> let a = sortBy (\ x y -> if x < y then LT else if x > y then GT else EQ)  x in ((toInteger $ last a) * (foldr (+) (0::Integer) a)) + (sum $ zipWith (*) (init a) [(2::Integer)..]))  . map (\x -> read x :: Integer) . words

import Data.List

main = do
getLine
getLine >>= print . (\x -> let a = sort x in (last a * length a) + (sum $ zipWith (*) (init a) [2..]))  . map (\x -> read x :: Int) . words

import Data.List (sort)
import Control.Applicative

main = do
  n <- read <$> getLine
  xs <- sort . map read . words <$> getLine :: IO [Int]
  print $ if null . drop 1 $ xs then head xs else
    let (l:ys) = scanr1 (+) xs
    in sum . (2*l:) . take (n-2) $ ys

import Data.List (sort)

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

solve :: [Int] -> Int
solve as = sum (zipWith (*) [1..] (sort as)) - maximum as + sum as

import Control.Applicative
import Data.List
main = do
    getLine
    a <- sort . map read . words <$> getLine :: IO [Int]
    print $ (sum $ zipWith (*) [2..] a) - (last a)

import Control.Applicative
import Data.List

main= do
	s<-  read <$> getLine ::IO Int
	n<- sort.map read.words <$> getLine::IO [Int]
	let ans= sum $ zipWith (*) n [2..]
 	if s==1 then print (last n ) else print $ ans - (last n)


You are given a string $$$s$$$ of even length $$$n$$$. String $$$s$$$ is binary, in other words, consists only of 0's and 1's.String $$$s$$$ has exactly $$$\frac{n}{2}$$$ zeroes and $$$\frac{n}{2}$$$ ones ($$$n$$$ is even).In one operation you can reverse any substring of $$$s$$$. A substring of a string is a contiguous subsequence of that string.What is the minimum number of operations you need to make string $$$s$$$ alternating? A string is alternating if $$$s_i \neq s_{i + 1}$$$ for all $$$i$$$. There are two types of alternating strings in general: 01010101... or 10101010...

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$; $$$n$$$ is even) — the length of string $$$s$$$. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$ ($$$s_i \in$$$ {0, 1}). String $$$s$$$ has exactly $$$\frac{n}{2}$$$ zeroes and $$$\frac{n}{2}$$$ ones. It's guaranteed that the total sum of $$$n$$$ over test cases doesn't exceed $$$10^5$$$.

For each test case, print the minimum number of operations to make $$$s$$$ alternating.

NoteIn the first test case, string 10 is already alternating.In the second test case, we can, for example, reverse the last two elements of $$$s$$$ and get: 0110 $$$\rightarrow$$$ 0101.In the third test case, we can, for example, make the following two operations:   11101000 $$$\rightarrow$$$ 10101100;  10101100 $$$\rightarrow$$$ 10101010.

import Control.Arrow
import Data.List

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

process :: [String] -> [Int]
process [] = []
process (_:s:ss) = solve s : process ss

solve :: String -> Int
solve s =
  foldl max 0 . map length . group . sort . filter (uncurry (==)) $
  zip s (tail s)

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine :: IO Int
        s <- getLine
        print $ solve s

solve :: String -> Int
solve s = max (f '0') (f '1')
        where groups = group s
              f = \c -> sum $ map (pred . length) $ filter ((==c) . head) groups

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

solve :: String -> Int
solve s = r
  where g = group s
	f b = filter (\x -> head x == b) g
	r = max (m . f $ '0') (m . f $ '1')
	m = sum . map (\x -> (length x) - 1)

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] . const $ getLine >> getLine >>=  putStrLn . show . solve

import Control.Arrow
import Data.List

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

process :: [String] -> [Int]
process [] = []
process (_:s:ss) = solve s : process ss

solve :: String -> Int
solve = maximum . map (sum . map (subtract 1 . length)) . groupBy f . group
  where
    f xs ys = head xs == head ys

import Control.Arrow
import Data.List

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

process :: [String] -> [Int]
process [] = []
process (_:s:ss) = solve s : process ss

solve :: String -> Int
solve s = foldl max 0 . map length . group . filter (uncurry (==)) $ adj
  where
    adj = zip s (tail s)

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

rmCorr :: String -> String
rmCorr (x:y:[]) = x:y:[]
rmCorr (a:b:c:d:xs) = corr (a:b:c:d:[]) $ xs
  where corr s xs = case s of
		      "0101" -> rmCorr ('0':'1':xs)
		      "1010" -> rmCorr ('1':'0':xs)
		      _ -> a : b : rmCorr (c:d:xs)

solve :: String -> Int
solve = sum . map (\x -> x - 1) . map length . filter (\s -> head s == '1') . group . rmCorr

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] . const $ getLine >> getLine >>=  putStrLn . show . solve


Manao has invented a new mathematical term — a beautiful set of points. He calls a set of points on a plane beautiful if it meets the following conditions:  The coordinates of each point in the set are integers.  For any two points from the set, the distance between them is a non-integer. Consider all points (x, y) which satisfy the inequations: 0 ≤ x ≤ n; 0 ≤ y ≤ m; x + y > 0. Choose their subset of maximum size such that it is also a beautiful set of points.

The single line contains two space-separated integers n and m (1 ≤ n, m ≤ 100).

In the first line print a single integer — the size k of the found beautiful set. In each of the next k lines print a pair of space-separated integers — the x- and y- coordinates, respectively, of a point from the set. If there are several optimal solutions, you may print any of them.

NoteConsider the first sample. The distance between points (0, 1) and (1, 2) equals , between (0, 1) and (2, 0) — , between (1, 2) and (2, 0) — . Thus, these points form a beautiful set. You cannot form a beautiful set with more than three points out of the given points. Note that this is not the only solution.

main :: IO ()
main = do
  n <- fmap (minimum . map read . words) getLine
  print $ n + 1
  putStr $ unlines $ [show i ++ " " ++ show (n - i) | i <- [0 :: Int .. n]]

import Numeric

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

main = interact $ g.minimum.map fastRead .words.head.lines

g x = (show (if x == 0 then 0 else (x+1))) ++ "\n" ++ unlines (f [] x 0)

f ans (-1) y = ans
f ans x y
  | x == 0 && (null ans) = ans
  | otherwise = f ((i ++ " " ++ j):ans) (x-1) (y+1)
  where i = show x
        j = show y

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

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

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

main = do
  [n, m] <- getInts

  let a = min (n+1) (m+1)
  print a

  putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ zip [0..a-1] $ (reverse [0..a-1])

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

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

solve :: Int -> Int -> [(Int, Int)]
solve n m
  | n < m  =  [(i, n - i) | i <- [0 .. n]]
  | otherwise  =  [(i, m - i) | i <- [0 .. m]]

main :: IO ()
main  =  do
    [n, m]  <-  reads
    let ps  =  solve n m
    print $ length ps
    mapM_ print' ps
  where
    print' (a, b)  =  putStrLn $ show a ++ " " ++ show b

main = do
  [x, y] <- fmap (map read . words) getLine
  let n = min x y
  print $ n+1
  putStr $ unlines $ [show i ++ " " ++ show (n-i) | i <- [0..n]]

main=getLine>>=putStr.unlines.map(unwords.map show).f.map read.words
f[n,m]|x<-min n m=[x+1]:[[i,x-i]|i<-[0..x]]

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

main = do
	tmp <- B.getLine;
	let
		n:m:[] = map (fst.fromJust.B.readInt) $ B.words tmp
		solve :: Int -> Int -> String
		solve x y
			| x < 0 || y > m = ""
			| otherwise = show x ++ " " ++ show y ++ "\n" ++ (solve (x-1) (y+1))
	putStr $ show (1+(min n m)) ++ "\n" ++ solve n 0

main = do
  n:m:xs <- fmap (map read . words) getContents
  print (min n m + 1)
  mapM_ (\x -> putStrLn $ (show x) ++ " " ++ (show $ m - x)) [0 .. (min n m)]

import Numeric

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

main = interact $ g.minimum.map fastRead .words.head.lines

g x = (show x) ++ "\n" ++ unlines (f [] x)

f ans (-1) = ans
f ans x
  | x == 0 && (null ans) = ans
  | otherwise = f ((i ++ " " ++ i):ans) (x-1)
  where i = show x

import Numeric

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

main = interact $ g.minimum.map fastRead .words.head.lines

g x = (show (x+1)) ++ "\n" ++ unlines (f [] (x))

f ans (-1) = ans
f ans x
  | x == 0 && (null ans) = ans
  | otherwise = f ((i ++ " " ++ i):ans) (x-1)
  where i = show x

main = do
  [x, y] <- fmap (map read . words) getLine
  let n = min x y
  print $ n+1
  putStr $ unlines $ [show i ++ " " ++ show (x-i) | i <- [0..n]]

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

main = do
	tmp <- B.getLine;
	let
		n:m:[] = map (fst.fromJust.B.readInt) $ B.words tmp
		solve :: Int -> Int -> String
		solve x y
			| x > n || y > m = ""
			| otherwise = show x ++ " " ++ show y ++ "\n" ++ (solve (x+1) (y+1))
	putStr $ show (1+(min n m)) ++ "\n" ++ solve 0 0