module Main where

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

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

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

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

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

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

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

    return ()

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type Z = Int

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

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

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

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

import Control.Monad

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Control.Monad

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

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

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

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

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


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

readInt :: String -> Int
readInt = read

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

module Main where

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

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

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

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

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

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

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

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

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

import Control.Monad

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

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

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

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

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

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

    mapM putStrLn results

import Control.Monad

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

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

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

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

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

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

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

import Control.Monad

(|>) x f = f x

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

import Control.Monad

(|>) x f = f x

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

import Control.Monad

(|>) x f = f x

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


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

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

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

type Output = Res

input :: Scanner TC
input = int

newtype Res = Res [(Int, Int)]

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

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

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

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

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

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

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

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

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

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

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

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

infixl 0 >$>

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type Result = [(Int, Int)]

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

import Text.Read (readEither)

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

type EIO a = ExceptT String IO a

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

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

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

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

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

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

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

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

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

import Control.Monad
import Text.Printf

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

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

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

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

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

import Text.Read (readEither)

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

type EIO a = ExceptT String IO a

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

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

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

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

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

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

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

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

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

import Control.Monad
import Text.Printf

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

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

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

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


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

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

import Data.List
import Control.Monad

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

getLines n = replicateM n getLine

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

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

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

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

import Data.List
import Control.Monad

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

getLines n = replicateM n getLine

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

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

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

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

import Data.List
import Control.Monad

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

getLines n = replicateM n getLine

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

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


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

import Data.Char
import Data.List

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

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

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

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

import Data.List
import Data.Char

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

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

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

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

module Main where

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

normalize = map toLower . filter isAlpha

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

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

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

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

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

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

import Data.Char
import Data.List

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

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

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

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

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

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

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

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

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

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

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

import Data.Char

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


import Control.Arrow

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

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

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

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

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

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

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

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

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

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

import Control.Monad
import Data.List

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

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

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

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

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

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

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


import Data.List

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

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

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

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

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

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

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

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

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

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

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


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

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

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

    r = zip3 t1 t2 t3

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (elemIndex, unfoldr)

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

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

import Control.Applicative
import Data.List

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

main=do

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

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

readInt :: String -> Int
readInt = read

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

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

import Data.List
import Control.Applicative

main :: IO ()
main = interact solve

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

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

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

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

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

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

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

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

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

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


{-# LANGUAGE BangPatterns, ViewPatterns #-}

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

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

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

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

type Point = Vec2

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Debug.Trace

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State
-- }}}

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

data Point = Point Int64 Int64 deriving (Show)

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

data Vector = Vector Int64 Int64

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

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

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

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

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

	m <- readLn
	qs <- replicateM m readLn

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

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

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

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

data Point = Point Int64 Int64 deriving (Show)

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

data Vector = Vector Int64 Int64

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

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

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

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

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

	m <- readLn
	qs <- replicateM m readLn

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

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

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

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

data Point = Point Int Int deriving (Show)

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

data Vector = Vector Int Int

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

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

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

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

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

	m <- readLn
	qs <- replicateM m readLn

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

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

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

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

data Point = Point Int Int deriving (Show)

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

data Vector = Vector Int Int

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

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

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

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

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

	m <- readLn
	qs <- replicateM m readLn

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

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

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

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

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

import Debug.Trace

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State
-- }}}

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

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

main = readInt >>= flip replicateM solve

solve = readIntegers >>= print . pred . sum

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

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

main = readInt >>= flip replicateM solve

solve = readIntegers >>= print . succ . sum

import Control.Monad ( replicateM_ )

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

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


import Data.Char

toint s = (read s) :: Int

doit "" "" = True
doit (aa:s) (bb:t) =
  let a = ord aa in
  let b = ord bb in
  let x = abs (a - b) in
  if x == 0 || x == 2 then
    doit s t
  else
    False

doall [] = ""
doall (_:s:ss) =
  let t = reverse s in
  let r = if doit s t then "YES" else "NO" in
  r ++ "\n" ++ doall ss

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

main = interact solve

main = interact $ unlines . map solve . pairs . tail . lines
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve (_,s) | all d (zip s (reverse s)) = "YES" | otherwise = "NO" where
  d (x,y) = (fromEnum x - fromEnum y) `elem` [-2,0,2]

import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.Char

solve s = let (a,b) = B.splitAt (B.length s`div`2) $ B.filter (`elem`['a'..'z']) s
              t = and $ B.zipWith (\x y -> if x == y || (let e = abs (ord x - ord y) in e == 2 || e == 0) then True else False) a $ B.reverse b
          in B.pack $ if t then "YES" else "NO"

main = B.interact $ B.unlines . map solve . fix (\f a -> if null a then [] else let (b:c:ds) = a in c : f ds )  . tail . B.lines

main = interact $ unlines . map solve . filter ((`elem` ['a' .. 'z']) . head) . lines

solve = (\x -> foldl check "YES" $ zip x $ reverse x) . map fromEnum

check acc (x,y)
    | d == 0 || d == 2 = acc
    | otherwise = "NO"
    where d = abs (x - y)

import Data.List
import Data.Char

g::String->String->String
g [] []="YES"
g (x:xs) (y:ys)
    |x==y=g xs ys
    |otherwise=if abs(ord (x)-ord(y))==2 then g xs ys else "NO"

f ::[String]->[String]
f []=[]
f (x:y:xs)=(g y (reverse y)):f xs

main = do
       e1<-getLine
       es<-getContents
       let xs=lines es
       putStr $ unlines$ f xs

import Data.Foldable (for_)
import Data.Char
import Data.Function

f a b
  | (a+1)`mod`26 == (b-1)`mod`26 = True
  | (a+1)`mod`26 == (b+1)`mod`26 = True
  | (a-1)`mod`26 == (b-1)`mod`26 = True
  | (a-1)`mod`26 == (b+1)`mod`26 = True
  | otherwise = False

printB x = putStrLn $ if x then "YES" else "NO"
main = do
    n <- readLn :: IO Int
    for_ [1..n] $ \_ -> do
        getLine
        s <- getLine
        let (a,b) = splitAt (length s `div` 2) s
        printB $ and $ zipWith (f`on`ord) a $ reverse b

import Data.Foldable (for_)
import Data.Char
import Data.Function

f a b
  | a + 1 == b - 1 = True
  | a + 1 == b + 1 = True
  | a - 1 == b - 1 = True
  | a - 1 == b - 1 = True
  | otherwise = False

printB x = putStrLn $ if x then "YES" else "NO"
main = do
    n <- readLn :: IO Int
    for_ [1..n] $ \_ -> do
        getLine
        s <- getLine
        let (a,b) = splitAt (length s `div` 2) s
        printB $ and $ zipWith (f`on`ord) a $ reverse b

import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.Char

solve s = let (a,b) = B.splitAt (B.length s`div`2) s
              t = and $ B.zipWith (\x y -> if x == y || (let e = abs (ord x - ord y) in e == 2 || e == 0) then True else False) a $ B.reverse b
          in B.pack $ if t then "YES" else "NO"

main = B.interact $ B.unlines . map solve . fix (\f a -> if null a then [] else let (b:c:ds) = a in c : f ds )  . tail . B.lines


module Main where

import           Data.List (dropWhileEnd)

main :: IO ()
main = do
  first <- getLine
  let [n, k] = map read (words first) :: [Int]
  s <- getLine
  let fakeMaxChar = succ 'z'
  let minChar = foldr min fakeMaxChar s
  let fakeMinChar = pred 'a'
  let maxChar = foldr max fakeMinChar s
  if n < k
  then putStrLn $ s ++ replicate (k - n) minChar
  else do
      let bufS = take k s
      let newS = dropWhileEnd ((==) maxChar) bufS
      let newLen = length newS
      let lastChar = newS !! (newLen - 1)
      let filtNewS = filter ((<) lastChar) s
      let minSpecialChar = foldr min fakeMaxChar filtNewS
      putStrLn $ take (newLen - 1) newS ++ [minSpecialChar] ++ replicate (k - newLen) minChar

import Data.Set hiding (map, null)

next :: Char -> Set Char -> Char
next c s = elemAt ((+1) $ findIndex c s) s

translate :: Int -> Set Char -> String -> String
translate k letterSet = snd . trans k
  where (maxL,minL)   = (findMax letterSet, findMin letterSet)
        trans 0 _     = (False,[])
        trans k (c:cs)
          | done      = (True,c:res)
          | c /= maxL = (True,(next c letterSet):res)
          | otherwise = (False,minL:res)
         where (done,res) = trans (k-1) cs

construct :: Int -> Int -> String -> String
construct n k s
  | k > n     = s ++ replicate (k-n) (elemAt 0 letterSet)
  | otherwise = translate k letterSet s
 where letterSet = fromList s

main :: IO ()
main = do
  params <- getLine
  let (n,k) = (\(x:y:[]) -> (x,y)) . map read . words $ params
  s <- getLine
  putStrLn $ construct n k s

{-# LANGUAGE ViewPatterns #-}
import qualified Data.Set as S
import Data.Maybe
import Data.List
main = interact exec
exec = (\[n, k, xs] -> f (read n) (read k) xs) . words

f :: Int -> Int -> String -> String
f n k xs
  | k > n = take k $ xs ++ repeat (S.findMin s)
  | otherwise = take k $ (\(reverse -> f) -> init f ++ [next (last f)] ++ repeat (S.findMin s)) $ dropWhile (== S.findMax s) $ reverse $ take k xs
  where
  s = S.fromList xs
  next = fromJust . flip S.lookupGT s

{-
3 2
yzy
-}

{-# LANGUAGE ViewPatterns #-}
import qualified Data.Set as S
import Data.Maybe
import Data.List
main = interact exec
exec = (\[n, k, xs] -> f (read n) (read k) xs) . words

f :: Int -> Int -> String -> String
f n k xs
  | k > n = take k $ xs ++ repeat (S.findMin s)
  | otherwise = take k $ (\(reverse -> f) -> init f ++ [next (last f)] ++ repeat (S.findMin s)) $ dropWhile (== S.findMax s) $ reverse xs
  where
  s = S.fromList xs
  next = fromJust . flip S.lookupGT s

module Main where

main :: IO ()
main = do
  first <- getLine
  let [n, k] = map read (words first) :: [Int]
  s <- getLine
  let minChar = foldr min 'z' s
  putStrLn $ replicate k minChar

module Main where

import           Data.List (dropWhileEnd)

main :: IO ()
main = do
  first <- getLine
  let [n, k] = map read (words first) :: [Int]
  s <- getLine
  let fakeMaxChar = succ 'z'
  let minChar = foldr min fakeMaxChar s
  let fakeMinChar = pred 'a'
  let maxChar = foldr max fakeMinChar s
  if n < k
  then putStrLn $ s ++ replicate (k - n) minChar
  else do
      let bufS = take k s
      let newS = dropWhileEnd ((==) maxChar) s
      let newLen = length newS
      let lastChar = newS !! (newLen - 1)
      let filtNewS = filter ((<) lastChar) s
      let minSpecialChar = foldr min fakeMaxChar filtNewS
      putStrLn $ take (newLen - 1) newS ++ [minSpecialChar] ++ replicate (k - newLen) minChar

import Data.Set hiding (map, null)

next :: Char -> Set Char -> Char
next c s = elemAt ((+1) $ findIndex c s) s

translate :: Int -> Set Char -> String -> String
translate k letterSet = trans k
  where (maxL,minL) = (findMax letterSet, findMin letterSet)
        mapFrom c = if c == maxL then minL else next c letterSet
        trans 0 _                        = []
        trans k (c:cs)
          | null res || head res == minL = (mapFrom c):res
          | otherwise                    = c:res
         where res = trans (k-1) cs

construct :: Int -> Int -> String -> String
construct n k s
  | k > n     = s ++ replicate (k-n) (elemAt 0 letterSet)
  | otherwise = translate k letterSet s
 where letterSet = fromList s

main :: IO ()
main = do
  params <- getLine
  let (n,k) = (\(x:y:[]) -> (x,y)) . map read . words $ params
  s <- getLine
  putStrLn $ construct n k s


module Main where

main = do
  _ <- getLine
  ns <- map read . words <$> getLine
  let maxN = maximum ns
      grow = map (maxN-) ns
  print $ sum grow

import Data.List
import Data.Ord
import Data.Char
fi = fromIntegral

solve x = sum $ map (\y->mx-y) x where
	mx = maximum x

main=interact$show.solve.map (\x->read x::Int).words.head.tail.lines

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>= \ n -> (solve.concat =<< forM [1 .. 1] ( \i -> map (fst.fromJust.C.readInt).C.words <$> C.getLine))
solve xs = let m =maximum xs in print $ sum $ map (\a->m-a) xs

main=interact$(show::Integer->String).f.map read.words
f (a:b)=maximum b*a-sum b

solve xs = sum $ map (\x -> m - x) xs
    where m = maximum xs

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

import Control.Monad

main = readInput >>= putStrLn . show . calc

readInput :: IO (Int, [Int])
readInput = liftM2 toTuple getLine getLine
  where toTuple a b = (read a, map read $ words b)

calc :: (Int, [Int]) -> Int
calc (1, _) = 0
calc (n, ws) = (n - 1) * m - (t - m)
  where mt = foldr (\w (m, t) -> (max m w, t + w)) (0, 0) ws
        m = fst mt
        t = snd mt

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    arr <- (map readB8Int . B8.words) <$> B8.getLine
    let mx = maximum arr
        answer = sum . map (mx -) $ arr
    printf "%d\n" answer

import Control.Applicative
import Data.List

main=do
    n<-getLine
    q<- map read <$>  words   <$> getLine ::IO [Int]
    let lq = length q
    let mq = maximum q
    print $ mq*lq - sum q

main = interact $ show . solve . map read . tail . words
solve xs = sum $ map (maximum xs -) xs

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  _ <- readLine
  citizens <- readLine
  B.putStrLn . B.pack . show $
    let richest = maximum citizens
    in sum $ map (richest -) citizens

import Control.Applicative

main = do
  (n:as) <- map read . words <$> getContents
  print $ solve n as

solve n as = (n * maximum as) - sum as

main = do
    n_ <- readLn::IO Int
    as_ <- return . map (read::String->Integer) . words =<< getLine
    let
	mx = maximum as_
	give::[Integer]->Integer
	give [] = 0
	give (a:as) = (mx-a)+give as
    print $ give as_

module Main where
    import Data.List
    main :: IO ()
    main = do
        _ <- getLine
        l <- getLine
        let a = map (\x -> read x :: Integer) $ words l
            res = sum $ map (\x -> m - x) $ sort a where m = maximum a
        print res

main = interact $ show . solve . map read . tail . words
solve s = (length s) * (maximum s) - sum s

goldCoins xs = sum $ [m - x | x <- xs ] where m = maximum xs

main =
    do
        line1 <- getLine
        line2 <- getLine
        let coins = map read . words $ line2
        putStrLn . show $ goldCoins coins

import Data.List.Split (splitOn)

main = do
 _ <- getLine
 raw <- getLine
 let szamok = map read $ splitOn " " raw
 let ln = maximum szamok
 print $ sum $ map (ln-) szamok

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

main = do

	n<- read <$>  getLine:: IO Int
	a<- map read <$> words <$> getLine ::IO [Int]
 	let m = maximum a
	let s = sum a
	print $ m*n-s

--ghc 7.10

minToEqual :: (Ord a, Num a) => [a] -> a
minToEqual a = sum $ map (\x -> amax-x) a
    where amax = maximum a

main = do
    nStr <- getLine
    aStr <- getLine
    let a = map read . words $ aStr :: [Int]
    print $ minToEqual a

main :: IO ()
main = do
  n <- getLine
  cost <- fmap (map read.words) getLine :: IO [Int]
  let min_v = maximum cost
  print (sum (map (\x-> min_v - x) cost))

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

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

main = do
	n <- readInt
	a <- readInts
	print $ maximum a * n - sum a

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

main = B.getLine >> (map $ maybe undefined fst . B.readInt) . B.words <$> B.getLine >>= (\xs -> let m = maximum xs in print . sum . map ((-) m) $ xs)

conv lst oo
  | (null lst) = reverse oo
  | otherwise = conv (tail lst) (((read (head lst))::Int) : oo)

main = do
  ff <- getLine
  gg <- getLine

  let n = (read ff)::Int
      uu = conv (words gg) []

      ans = ((length uu) * (maximum uu) - (sum uu))

  putStrLn (show ans)

module Main where

toInt s = read s :: Int

solve n mas = helper (maximum (map toInt (words mas))) (map toInt (words mas))

helper m = foldr (\x s -> if x >= m then s else s + (m - x)) 0

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

import Data.Maybe
main = interact $ show . solve
solve = sum . mapMaybe (flip lookup ss . head) . tail . lines
ss = [('T',4),('C',6),('O',8),('D',12),('I',20)]


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

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

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> map output >>> C.unlines

data TC = TC {n :: Int, k :: Int, ps :: [Int]}

type Output = Int

input :: Scanner TC
input = do
  n <- int
  k <- int
  ps <- (n - 1) >< int
  return TC {..}

solve :: TC -> Output
solve TC {..} = search 0 n
  where
    tree :: Array Int [Int]
    tree = accumArray (flip (:)) [] (1, n) $ zip ps [2 ..]

    -- (l, r]
    search :: Int -> Int -> Int
    search l r
      | l + 1 == r = r
      | check m = search l m
      | otherwise = search m r
        where
          m = (l + r + 1) `div` 2

    check :: Int -> Bool
    check h = snd (dfs h 1) <= k

    -- returns (dep, #ops)
    dfs :: Int -> Int -> (Int, Int)
    dfs hmax u
      | u == 1 = (0, ops)
      | otherwise = (1 + maximum (0 : filter (< hmax) ds), ops + count hmax ds)
      where
        (ds, ops) = tree ! u >$> map (dfs hmax) >>> unzip >>> second sum

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

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

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

-- Helpers
(>$>) = flip ($)

infixl 0 >$>

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans.State
import Data.Array
import Data.Array.ST
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import qualified Data.ByteString.Lazy.Char8 as P
import Data.List
import Data.Maybe
import qualified Data.Ord
import Debug.Trace
import System.IO

mainFun :: SP Builder
mainFun = do
  casnum <- getInt
  res <- forM [1 .. casnum] $ \_ -> do
    n <- getInt
    m <- getInt
    p <- replicateM (n -1) getInt
    let g = genGraph n (zip p [2 ..])
    let d = calcDepth g
    let d' = sortOn (Data.Ord.Down . snd) d
    let p' = listArray (2, n) p
    let min_h = binSearch (validHeight g m p' d') 1 (n -1)
    pure [min_h]
  pure $ mconcat $ map putInts res

validHeight :: Array Int [Int] -> Int -> Array Int Int -> [(Int, Int)] -> Int -> Bool
validHeight g m p d h = runST $ do
  let n = rangeSize $ bounds g
  visited <- newArray (1, n) False -- :: ST s (STArray s Int Bool)
  let goUp x 0 = x
      --   goUp 1 h = if h > 0 then 0 else 1
      goUp x h = goUp (p ! x) (h -1)

  let visDown :: STArray s Int Bool -> Int -> ST s Int
      visDown vis x = do
        vx <- readArray vis x
        if vx
          then pure 0
          else do
            writeArray vis x True
            mapM_ (visDown vis) (g ! x)
            pure 1

  cuts <- forM d $ \(x, d) -> do
    vx <- readArray visited x
    if not vx && d > h
      then
        let anc = goUp x (h -1)
         in visDown visited anc
      else pure 0
  pure $ sum cuts <= m

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch v l r =
  if l == r
    then l
    else
      let m = div (l + r) 2
       in if v m
            then binSearch v l m
            else binSearch v (m + 1) r

calcDepth :: Array Int [Int] -> [(Int, Int)]
calcDepth g = go 0 1
  where
    go d x =
      let cs = (g ! x)
       in (x, d) : foldl' (++) [] ( map (go (d + 1)) cs)

genGraph :: Int -> [(Int, Int)] -> Array Int [Int]
genGraph n es = runSTArray $ do
  arr <- newArray (1, n) [] :: ST s (STArray s Int [Int])
  forM_ es $ \(a, b) -> do
    lst <- readArray arr a
    writeArray arr a (b : lst)
  return arr

type SP = State P.ByteString

type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs =
  let sepPrim =
        (,) ' '
          Prim.>$< Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
   in case vs of
        [] -> char7 '\n'
        x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

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