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


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
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.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.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 (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 (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 $ "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


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
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.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 (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


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 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
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 - (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]

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


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 s =
  foldl max 0 . map length . group . sort . filter (uncurry (==)) $
  zip s (tail s)

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


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 :: 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])

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


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

readInt :: C.ByteString -> Int
readInt bs = case C.readInt bs of
  Nothing -> error "Not an integer"
  Just (x, _) -> x

update :: Maybe Int -> Maybe Int
update Nothing = Just 1
update (Just i) = Just (i+1)

count :: [Int] -> M.IntMap Int
count lst =
  foldr (M.alter update) M.empty lst

calc :: Int -> [(Int,Int)] -> Int64
calc n pairs =
  let themes = count $ map fst pairs
      dif = count $ map snd pairs
      m = fromIntegral n :: Int64
      total = (m*(m-1)*(m-2)) `div` 6
      delta = foldl (\acc (x,y) ->
                       let size1 = fromIntegral $ M.findWithDefault 0 x themes :: Int64
                           size2 = fromIntegral $ M.findWithDefault 0 y dif :: Int64
                       in
                         acc + (size1-1)*(size2-1)
                       ) 0 pairs
  in
    total-delta

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let n = readInt line
    pairs <- mapM (\_ -> do
                       line <- C.getLine
                       let [x,y] = map readInt $ C.words line
                       return (x,y)
                   ) [1..n]
    print $ calc n pairs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as DM
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Either as DE

data Input = Input {n0 :: Integer, pairs :: [(Integer,Integer)]} deriving Show
data Output = Output Integer deriving Show

countElems :: (Ord a) => [a] -> DM.Map a Int
countElems = DM.fromListWith (+) . flip zip (repeat 1)

solve :: Input -> Output
solve (Input n ps) = Output ans where
  m1 = countElems $ fst <$> ps
  m2 = countElems $ snd <$> ps
  sureLookup x m = fromIntegral $ subtract 1 $ fromMaybe 0 $ DM.lookup x m
  badCount (x,y) = sureLookup x m1 * sureLookup y m2
  badCounts = sum $ map badCount ps
  allCount = n*(n-1)*(n-2)`div`6
  ans = allCount - badCounts

input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM (fromIntegral n) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

pairingCount :: S.Set Int -> S.Set Int -> Integer
pairingCount xs ys = sum $ S.map (fromIntegral.choose2.funct) xs where
  choose2 n = fromIntegral $ n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ map (\[x,y]->pairingCount x y + pairingCount y x) $ subsetsOfSize 2 sets
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

pairingCount :: S.Set Int -> S.Set Int -> Integer
pairingCount xs ys = sum $ S.map (fromIntegral.choose2.funct) xs where
  choose2 n = fromIntegral $ n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ map (\[x,y]->pairingCount x y) $ subsetsOfSize 2 sets
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

applicate ::  [Int] -> S.Set Int -> Integer
applicate xs ys = sum [fromIntegral (choose2 $ funct x)  | x <- xs] where
  choose2 n = n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ filter (not.null.tail) lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ (applicate <$> lists <*> sets)
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

applicate ::  [Int] -> S.Set Int -> Integer
applicate xs ys = sum [fromIntegral (choose2 $ funct x)  | x <- xs] where
  choose2 n = n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ filter (not.null.tail) lists
  distinctSndOnly = sum $ (applicate <$> lists <*> sets)
  ans = distinctFst + distinctSndOnly

input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs


{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
main :: IO ()
main = interact $ unlines . map solve . format . map read . tail . words

format :: [Int] -> [[Int]]
format allTest = format_aux allTest []
    where
        format_aux []         res = res
        format_aux (n:m:rest) res = let (arr, remain) = splitAt n rest in
            format_aux remain (res ++ [[n, m] ++ arr])

solve :: [Int] -> [Char]
solve [] = []
solve (n:m:arr) = let st = take m ['B', 'B'..] in
    solve_aux arr st where
        solve_aux []     cur_st = cur_st
        solve_aux (x:xs) cur_st = let (smal, big) = judge (x-1) (m-x) in
            if (cur_st !! smal == 'B') then solve_aux xs (change smal cur_st)
                else solve_aux xs (change big cur_st)

judge :: Int -> Int -> (Int, Int)
judge x y = if (x < y) then (x, y) else (y, x)

change :: Int -> [Char] -> [Char]
change pos st = let (xs,_:ys) = splitAt pos st in
    xs ++ 'A':ys

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,m] <- ri
        as     <- ri
        return (m, as)
    mapM_ (putStrLn.solve) tcs

solve (m, as) = op
  where
    ps = L.sort . map (toBoth m) $ as
    i2c = Map.fromList . (`zip` repeat 'B') $ cinds
    op = Map.elems . foldl doOp i2c $ ps
    cinds = [1..m] :: [Int]

doOp i2c (i,j) = Map.adjust (const 'A') k i2c
  where
    (!) = (Map.!)
    k | (i2c!i) == 'B'  = i
      | otherwise       = j

toBoth m x = (min a b, max a b)
  where
    (a,b) = (x, m+1-x)


{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
-- for io performance comparison from @Amguls' code --
removeFactor :: Integer -> Integer -> Integer
removeFactor m i =
        if m `mod` i == 0
        then removeFactor (m `quot` i) i
        else m

totient' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)
totient' o m i r
        | i > m || i * i > o = (m,r)
        | otherwise =
                totient' o (removeFactor m i) (i+1) $
                        if m `mod` i == 0
                        then (r `quot` i) * (i-1)
                        else r

totient :: Integer -> Integer
totient m =
        let (m2, m3) = totient' m m 2 m
        in if m2 > 1
           then (m3 `quot` m2) * (m2 - 1)
           else m3

compute :: Integer -> Integer -> String
compute a m =
        show $ totient $ m `div` gcd a m

solve :: Int -> SIO ()
solve 0 = return ()
solve t = do
        (a,m) <- liftM2 (,) get get
        putln $ compute a m
        solve (t-1)

main_ = do
        t <- get
        solve t

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

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

removeFactor :: Integer -> Integer -> Integer
removeFactor m i =
        if m `mod` i == 0
        then removeFactor (m `quot` i) i
        else m

totient' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)
totient' o m i r
        | i > m || i * i > o = (m,r)
        | otherwise =
                totient' o (removeFactor m i) (i+1) $
                        if m `mod` i == 0
                        then (r `quot` i) * (i-1)
                        else r

totient :: Integer -> Integer
totient m =
        let (m2, m3) = totient' m m 2 m
        in if m2 > 1
           then (m3 `quot` m2) * (m2 - 1)
           else m3

compute :: Integer -> Integer -> String
compute a m =
        show $ totient $ m `div` gcd a m

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        [a,m] <- readInts
        putStrLn $ compute a m
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
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 DSeq.|> 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
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (a, m) <- liftM2 (,) get get
    putln $ f2 a m

f2 :: Int64 -> Int64 -> Int64
f2 a m =    let d = gcd a m in
            let (ap, mp) = (div a d, div m d) in
            phi mp

phi :: Int64 -> Int64
phi e = foldl (\s x -> (div s x) * (x - 1)) e $ plist e

plist :: Int64 -> [Int64]
plist n = plisth n 2 $ sqrt $ fromIntegral n

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

divrec :: Int64 -> Int64 -> Int64
divrec n x =    if mod n x == 0 then
                    divrec (div n x) x
                else
                    n