import Data.List

findMax :: String -> String -> [[Int]]
findMax a b = scanl' byA (replicate (1 + length b) 0) a
  where byA r c = scanl' byB 0 $ zip3 b r $ tail r
          where byB l (d, ul, u) = let mx = max 0 $ max (u-1) (l-1)
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ map maximum $ findMax a b
  where (_:a:b:_) = lines input

main = interact solve

findMax :: String -> String -> [[Int]]
findMax a b = scanl byA [0 | _ <- [0..length b]] a
  where byA r c = scanl byB 0 $ zip3 b r $ tail r
          where byB l (d, ul, u) = let mx = max 0 $ max (u-1) (l-1)
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ map maximum $ findMax a b
  where (_:a:b:_) = lines input

main = interact solve

findMax :: String -> String -> [[Int]]
findMax a b = scanl byA (replicate (1 + length b) 0) a
  where byA r c = scanl byB 0 $ zip3 b r $ tail r
          where byB l (d, ul, u) = let mx = max 0 $ max (u-1) (l-1)
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ map maximum $ findMax a b
  where (_:a:b:_) = lines input

main = interact solve

import Data.List

findMax :: String -> String -> [[Int]]
findMax a b = scanl' byA [0 | _ <- [0..length b]] a
  where byA r c = scanl' byB 0 $ zip3 b r $ tail r
          where byB l (d, ul, u) = let mx = max 0 $ max (u-1) (l-1)
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ map maximum $ findMax a b
  where (_:a:b:_) = lines input

main = interact solve

makeS :: String -> String -> [[Int]]
makeS a b = scanl byA [0 | _ <- [0..length b]] a
  where byA r c = scanl byB 0 $ zip3 b r $ init r
          where byB l (d, u, ul) = let mx = maximum [0, l-1, u-1]
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ concat $ makeS a b
  where (_:a:b:_) = lines input

main = interact solve

import Data.List

findMax :: String -> String -> [[Int]]
findMax a b = scanl' byA (replicate (1 + length b) 0) a
  where byA r c = scanl' byB 0 $ zip3 b r $ tail r
          where byB l (d, ul, u) = let mx = max 0 $ max (u-10) (l-1)
                                   in if c == d then max mx (ul+2) else mx

solve :: String -> String
solve input = show $ maximum $ map maximum $ findMax a b
  where (_:a:b:_) = lines input

main = interact solve


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

main = putStrLn . show . solve . tail . map (toEnum . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Double] -> Double
solve cs = 360 - maximum (zipWith (-) (ts ++ [360 + t]) (t : ts))
  where
  (t : ts) = sort $ theta cs

theta :: [Double] -> [Double]
theta (x : y : cs) = t : theta cs
  where
  l = sqrt $ x * x + y * y
  t' = acos (x / l) * 180 / pi
  t = if y >= 0 then t' else 360 - t'
theta _ = []

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Array as A

main :: IO ()
main = do
    n <- B.getLine >>= return . fst . fromMaybe (0,B.empty) . B.readInt
    l <- replicateM n (B.getLine >>= return . fromMaybe (0,0). readXY)
    print $ solve n l
    where
        readXY :: B.ByteString -> Maybe (Int,Int)
        readXY str = do
            (x,s1) <- B.readInt str
            (y,s2) <- B.readInt (B.tail s1)
            return (x,y)

solve :: Int -> [(Int,Int)] -> Double
solve n l = 360 - maxDiffAngle
    where
        ary = A.listArray (0,n) (L.sort . L.map angle $ l)
        maxDiffAngle = loop 0 0
        loop i angle | i == n-1  = max (ary A.! 0 - ary A.! (n-1) + 360) angle
                     | otherwise = loop (i+1) (max (ary A.! (i+1) - ary A.! i) angle)

angle :: (Int,Int) -> Double
angle (0,0) = 0
angle (x,y) =
    case (x'>0,y'>0) of
        (True,True)  -> toDegree (asin (y'/d))
        (False,True) -> toDegree (acos (x'/d))
        (True,False) -> toDegree (asin (y'/d)) + 360
        (False,False) -> toDegree (asin (-y'/d)) + 180
    where
        x' = fromIntegral x
        y' = fromIntegral y
        d  = sqrt ( x' * x' + y' * y')

toDegree :: Double -> Double
toDegree x = x * 180 / pi

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

get_points [] = []
get_points (x:y:remain) = (x,y): get_points remain

main = do
	ct <- C.getContents
	let
		(n:p) = map (fst.fromJust.C.readInt) $ C.words ct
	print $ solve $  get_points $ map fromIntegral p

solve :: (RealFloat a) => [(a,a)] -> a
solve p =
	let
		all@(h:t) = sort $ map (uncurry atan2) p
		res = maximum $ zipWith (-) (t ++ [2*pi+h]) all
	in
		360 - 180/pi*res

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  (n:p) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let a@(h:t) = sort $ map (uncurry atan2) $ take n $ pairs $ map fromIntegral p
      b = maximum $ zipWith (-) (t ++ [h + 2 * pi]) a :: Double
  print $ 360 - 180 / pi * b

import qualified Data.ByteString.Char8 as B

main = putStrLn . show . solve . tail . map (toEnum . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Double] -> Double
solve cs = 360 - maximum (zipWith (-) (ts ++ [360 + t]) (t : ts))
  where
  (t : ts) = theta cs

theta :: [Double] -> [Double]
theta (x : y : cs) = t : theta cs
  where
  l = sqrt $ x * x + y * y
  t' = acos (x / l) * 180 / pi
  t = if y >= 0 then t' else 360 - t'
theta _ = []


import Data.List (intercalate)

minimumInstability :: [Float] -> Int
minimumInstability xs = (ceiling d) - (floor d)
    where (s, n) = (sum xs, length xs)
          d = s / (fromIntegral) n

findMs :: [Int] -> ((Int, Int), (Int, Int)) -> Int -> ((Int, Int), (Int, Int))
findMs (x : xs) res@((resmaxn, resmaxv), (resminn, resminv)) k
    | x > resmaxv = findMs xs ((k, x), (resminn, resminv)) (k + 1)
    | x < resminv = findMs xs ((resmaxn, resmaxv), (k, x)) (k + 1)
    | otherwise = findMs xs res (k + 1)
findMs _ res _ = res

move :: [Int] -> Int -> Int -> [Int]
move (x:xs) nmin nmax
    | nmin == 1 && nmax == 1 = x:xs
    | nmin == 1 = (x+1) : (move xs (nmin - 1) (nmax - 1))
    | nmax == 1 = (x-1) : (move xs (nmin - 1) (nmax - 1))
    | nmin < 1 && nmax < 1 = x:xs
    | otherwise = x : (move xs (nmin - 1) (nmax - 1))
move _ _ _ = []

towers :: Int -> Int -> [Int] -> [(Int, Int)]
towers k steps all@(x:xs)
    | k == 0 = [(instability, steps)]
    | minimumInstability (map fromIntegral all) == instability = [(instability, steps)]
    | otherwise = (i, j) : (towers (k-1) (steps + 1) ys)
        where instability = vmax - vmin
              ((nmax, vmax), (nmin, vmin)) = findMs xs ((1,x), (1,x)) 2
              (i, j) = (nmax, nmin)
              ys = move all nmin nmax

output :: [(Int, Int)] -> String
output xs = intercalate "\n" $ map (\(x, y) -> intercalate " " [show x, show y]) (last xs : init xs)

main = do
    [n, k] <- fmap words $ getLine
    getLine >>= putStrLn . output . (towers (read k) 0) . fmap read . words

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

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

getAns :: [Int] -> [[Int]]
getAns (n:k:xs) = let ans = move (zip xs [1..n]) k
				  in ([head $ last ans, length ans - 1]) : (init ans)

getIsb :: [(Int, Int)] -> Int
getIsb xs = (fst $ maximum xs) - (fst $ minimum xs)

move :: [(Int, Int)] -> Int -> [[Int]]
move xs 0 = [[getIsb xs, 0]]
move xs k
	| isb <= 1 = [[isb, 0]]
	| otherwise = let sx = sort xs;
					  (hi, hv) = head sx;
					  (ti, tv) = last sx;
					  nx = (hi + 1, hv ) : ((tail $ init sx) ++ [(ti - 1, tv)]);
					  pans = move nx (k - 1);
				  in [tv, hv] : pans
	where isb = getIsb xs

import Data.Array

import Data.List
import GHC.Exts
import Data.Set hiding (map)

--type tower = Set (Int,Int)

--next :: tower -> (tower,[Int])
next t = Just ([hi-hj,i,j],t3) where
   ((hi,i),t1) = deleteFindMax t
   ((hj,j),t2) = deleteFindMin t1
   t3 = Data.Set.insert (hi-1,i) $ Data.Set.insert (hj+1,j) t2

solve (1:_) = [[0,0]]
solve (_:k:l) = [s!!n!!0,n]:map tail s' where
  s =  unfoldr next $ fromList $ l `zip` [1..]
  s' =  takeWhile ((>1).(!!0)) $ take k s
  n = length s'

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

import Data.Array

import Data.List
import GHC.Exts
import Data.Set hiding (map)

--type tower = Set (Int,Int)

--next :: tower -> (tower,[Int])
next t = Just ([hi-hj,i,j],t3) where
   ((hi,i),t1) = deleteFindMax t
   ((hj,j),t2) = deleteFindMin t1
   t3 = Data.Set.insert (hi-1,i) $ Data.Set.insert (hj+1,j) t2

solve (_:k:l) = [s!!k!!0,k]:map tail (take k s) where s = unfoldr next $ fromList $ l `zip` [1..]

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


{-# LANGUAGE FlexibleInstances, UndecidableInstances, DuplicateRecordFields #-}

module Main where

import Control.Monad
import System.IO

calculate 1 = 0
calculate 2 = 1
calculate 3 = 2
calculate 4 = 2
calculate n
    | (mod n 2) == 1 = 3
    | otherwise = 2

main :: IO()
main = do
    t <- readLn :: IO Int
    forM_ [1..t] $ \t_itr -> do
        nmsTemp <- getLine
        let nms = words nmsTemp
        let n = read (nms !! 0) :: Int
        let result = calculate n
        putStrLn(show result)

import Control.Arrow ((>>>))

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

solve :: Int -> Int
solve n
  | n <= 3 = n - 1
  | even n = 2
  | odd n = 3

{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor ( (<&>) )
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Maybe (fromJust)
import Data.Traversable (forM)
import qualified Control.Monad.State.Strict as S
import qualified Data.IntMap as IM
import Control.Monad (foldM_)
import Data.Int

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

solve :: [Int] -> [Int]
solve = fmap solve'
    where
        solve' n
            | n <= 3    = n - 1
            | even n    = 2
            | otherwise = 3

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    ns <- forM [1 .. t] $ \_ -> B8.getLine <&> readIntB8 <&> fromJust
    let answer = solve ns
    forM_ answer $ printf "%d\n"

import Control.Monad
-- input n is an integer
-- get n to 1 with as few operations as possible
-- allowed operations:
-- 1. subtract n by 1
-- 2. divide n by a proper divisor

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    n <- read <$> getLine
    putStrLn $ show $ solve n

solve :: Int -> Int
solve 1 = 0
solve 2 = 1
solve 3 = 2
solve n =
  if even n
  then 2
  else 3

import Control.Arrow ((>>>))

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

solve :: Int -> Int
solve n
  | n == 1 = 0
  | n == 2 = 1
  | even n = 2
  | odd n = 3

{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor ( (<&>) )
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Maybe (fromJust)
import Data.Traversable (forM)
import qualified Control.Monad.State.Strict as S
import qualified Data.IntMap as IM
import Control.Monad (foldM_)
import Data.Int

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

solve :: [Int] -> [Int]
solve = fmap solve'
    where
        solve' n
            | n <= 3    = n - 1
            | even n    = 2
            | otherwise = 3

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    ns <- forM [1 .. t] $ \_ -> B8.getLine <&> readIntB8 <&> fromJust
    let answer = solve ns
    forM_ ns $ printf "%d\n"

import Control.Monad
-- input n is an integer
-- get n to 1 with as few operations as possible
-- allowed operations:
-- 1. subtract n by 1
-- 2. divide n by a proper divisor

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    n <- read <$> getLine
    putStrLn $ show $ solve n 0

solve :: Int -> Int -> Int
solve 1 counter = counter
solve n counter =
  if ld < n
  then solve (div n (div n ld)) (counter + 1)
  else solve (n - 1) (counter + 1)
  where
    ld = smallestDivisor n

smallestDivisor :: Int -> Int
smallestDivisor n = smallestDivisor' n 2
  where
    smallestDivisor' n 2 =
      if mod n 2 == 0
      then 2
      else smallestDivisor' n 3
    smallestDivisor' n try =
      if mod n try == 0
      then try
      else smallestDivisor' n (try + 2)


{-# LANGUAGE MagicHash, UnboxedTuples #-}
import qualified Data.ByteString as BS
import Control.Arrow

r1 [] = []
r1 (h : t) = (h, t) : map (second (h:)) (r1 t)

bf :: [(Int, String)] -> [(Int, String)]
bf [x] = [x]
bf l = do
  let (a,as) +++ (b, bs) = (a + b, "(" ++ as ++ "+" ++ bs ++ ")")
  let (a,as) +-- (b, bs) = (a - b, "(" ++ as ++ "-" ++ bs ++ ")")
  let (a,as) +** (b, bs) = (a * b, "(" ++ as ++ "*" ++ bs ++ ")")
  (a, l) <- r1 l
  (b, l) <- r1 l
  concat [bf (a +++ b : l), bf (a +-- b : l), bf (a +** b : l)]

s5 = ["5 * 4 = 20", "3 + 2 = 5", "20 + 5 = 25", "25 - 1 = 24"]
s4 = ["1 * 2 = 2", "2 * 3 = 6", "6 * 4 = 24"]
s :: Int -> Maybe [String]
s 0 = Nothing
s 1 = Nothing
s 2 = Nothing
s 3 = Nothing
s 5 = Just s5
s 4 = Just s4
s n = Just $
  concat [[show (n - i*2) ++ " - " ++ show (n - i*2 - 1) ++ " = 1", "1 * 1 = 1"] |i<-[0..(n-4) `div` 2-1]]
  ++ concat [s5|odd n]
  ++ concat [s4|even n]

pp Nothing = ["NO"]
pp (Just ss) = "YES" : ss

main = interact $ unlines . pp . s . read

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

main = interact $ unlines . reverse . getAns . read

getAns :: Int -> [String]
getAns x
	| x < 4 = ["NO"]
	| x == 4 = ["6 * 4 = 24", "2 * 3 = 6", "1 * 2 = 2", "YES"]
	| x == 5 = ["1 * 24 = 24", "4 * 6 = 24", "5 + 1 = 6", "3 - 2 = 1", "YES"]
	| otherwise = ["1 * 24 = 24", show x ++ " - " ++ show (x - 1) ++ " = 1"] ++ getAns (x - 2)

data Instr = Int :+ Int | Int :* Int | Int :- Int

main = do
  n <- fmap read getLine
  case genAns n of
    [] -> putStrLn "NO"
    is -> putStrLn "YES" >> putStrLn is

genAns :: Int -> String
genAns = unlines . map renderInstr . solve

renderInstr :: Instr -> String
renderInstr (x :+ y) = show x ++ " + " ++ show y ++ " = " ++ show (x+y)
renderInstr (x :- y) = show x ++ " - " ++ show y ++ " = " ++ show (x-y)
renderInstr (x :* y) = show x ++ " * " ++ show y ++ " = " ++ show (x*y)

solve :: Int -> [Instr]
solve n | n < 4 = []
        | n == 4 = genFrom4
        | n == 5 = genFrom5
        | even n = evenInstr n
        | odd n = oddInstr n

oddInstr n = genFrom5 ++ subtractConsecPairs [6,8..n] ++
             multiplyAll1s (length [6,8..n]) ++ mul24And1

genFrom5 = [5 :* 4, 20 :+ 2, 22 :+ 3, 25 :- 1]

evenInstr n = genFrom4 ++ subtractConsecPairs [5,7..n] ++
              multiplyAll1s (length [5,7..n]) ++ mul24And1

genFrom4 = [4 :* 3, 12 :* 2, 24 :* 1]
mul24And1 = [24 :* 1]

multiplyAll1s n = replicate (n-1) mul1s
    where
      mul1s = 1 :* 1
subtractConsecPairs l = l >>= \x -> [(x+1) :- x]

import Control.Monad
main = interact $ solve . read
solve n
	| n<4 = "NO"
	| odd n = "YES\n5 * 4 = 20\n3 + 2 = 5\n20 + 5 = 25\n25 - 1 = 24\n" ++ gen 6 n
	| even n = "YES\n1 * 2 = 2\n2 * 3 = 6\n6 * 4 = 24\n\n" ++ gen 5 n
	where gen x y= if x>=y then "" else show (x+1) ++ " - " ++ show x ++ " = 1\n1 * 24 = 24\n" ++ gen (x+2) y

import Data.List

data Opr = Opr Char Integer Integer

applyOpr :: Opr -> Integer
applyOpr (Opr c a b) = case c of
  '+' -> a + b
  '-' -> a - b
  '*' -> a * b

data Answer = No | Yes [Opr]

instance Show Opr where
  show opr@(Opr c a b) = unwords [show a, [c], show b, "=", show $ applyOpr opr]

instance Show Answer where
  show No = "NO"
  show (Yes oprs) = init . unlines $ ["YES"] ++ map show oprs

solve :: Integer -> Answer
solve 1 = No
solve 2 = No
solve 3 = No
solve 4 = Yes [Opr '*' 1 2, Opr '*' 2 3, Opr '*' 6 4]
solve 5 = Yes [Opr '*' 4 5, Opr '+' 2 3, Opr '-' 5 1, Opr '+' 20 4]
solve 6 = Yes [Opr '*' 2 3, Opr '*' 6 4, Opr '+' 1 5, Opr '-' 6 6, Opr '+' 0 24]
-- n > 6
solve n = Yes $ [ Opr '*' 2 3, Opr '*' 6 4, Opr '+' 1 5, Opr '-' 6 6
  ] ++ reverse mid ++ [Opr '*' x 0, Opr '+' 0 24] where
    (x, mid) = foldl' (\(s, oprs) x -> (s + x, (Opr '+' s x):oprs)) (7, []) [8..n]

main = do
  n <- return . read =<< getLine
  print $ solve n

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

solve :: [Int] -> Maybe [String]
solve xs = evalState (go xs) M.empty where
    go [s] = return $ if s == 24 then Just [] else Nothing
    go l   = do
        memo <- get
        case M.lookup l memo of
            Just b -> return b
            Nothing -> do
                b <- msum <$> mapM (\(l,s) -> fmap (fmap (s:)) (go l))  (next l)
                pure b <* modify (M.insert l b)

solve1 :: Int -> Maybe [String]
solve1 n | n <= 7 = solve [1..n] | otherwise = fmap (xs++) $ solve [1..if even n then 6 else 7] where
    xs = concat [[pprint i (i-1) ((-),"-"), pprint 1 6 ((*),"*")] | i <- [n,n-2..8]]

pprint :: Int -> Int -> (Int->Int->Int,String) -> String
pprint v w (op,opcode) = unwords $ [show v, opcode, show w, "=", show (op v w)]

next :: [Int] -> [([Int],String)]
next l = M.toList $ M.fromList $ do
    (i,v) <- zip [1..] l
    (j,w) <- zip [1..] l
    guard $ i /= j
    (op,opcode) <- [((+),"+"),((-),"-"),((*),"*")]
    let s = pprint v w (op,opcode)
    return (insert (op v w) (delete v $ delete w l), s)

main = do
    n <- readLn
    case solve1 n of
        Nothing -> putStrLn "NO"
        Just xs -> putStrLn "YES" >> forM_ xs putStrLn

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = interact $ solve.read

solve :: Int -> String
solve n
  | n <= 3 = "NO"
  | even n = "YES\n" ++ solveEven n
  | otherwise = "YES\n" ++solveOdd n

solveEven n = go n
   where
     go n
       | n > 4 = show n ++ " - " ++ show (n-1) ++ " = 1\n"
               ++ "1 * " ++ show (n-2) ++ " = " ++ show (n-2) ++ "\n"
               ++ go (n-2)
       | n == 4 = unlines [ "1 * 2 = 2"
                          , "3 * 4 = 12"
                          , "2 * 12 = 24"
                          ]

solveOdd n = go n
   where
     go n
       | n > 5 = show n ++ " - " ++ show (n-1) ++ " = 1\n"
               ++ "1 * " ++ show (n-2) ++ " = " ++ show (n-2) ++ "\n"
               ++ go (n-2)
       | n == 5 = unlines [ "5 * 4 = 20"
                          , "2 + 3 = 5"
                          , "5 - 1 = 4"
                          , "20 + 4 = 24"
                          ]

import Control.Monad
main = interact $ solve . read
solve n
	| n<4 = "NO"
	| odd n = "YES\n5 * 4 = 20\n3 + 2 = 5\n20 + 5 = 25\n25 - 1 = 24\n" ++ gen 6 n
	| even n = "YES\n1 * 2 = 2\n2 * 3 = 6\n6 * 4 = 24\n25 - 1 = 24\n" ++ gen 5 n
	where gen x y= if x>=y then "" else show (x+1) ++ " - " ++ show x ++ " = 1\n1 * 24 = 24\n" ++ gen (x+2) y

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

solve :: [Int] -> Maybe [String]
solve xs = evalState (go xs) M.empty where
    go [s] = return $ if s == 24 then Just [] else Nothing
    go l   = do
        memo <- get
        case M.lookup l memo of
            Just b -> return b
            Nothing -> do
                b <- msum <$> mapM (\(l,s) -> fmap (fmap (s:)) (go l))  (next l)
                pure b <* modify (M.insert l b)

solve1 :: Int -> Maybe [String]
solve1 n | n <= 7 = solve [1..n] | otherwise = fmap (xs++) $ solve [1..6] where
    xs = concat [[pprint i (i-1) ((-),"-"), pprint 1 6 ((*),"*")] | i <- [n,n-2..8]]

pprint :: Int -> Int -> (Int->Int->Int,String) -> String
pprint v w (op,opcode) = unwords $ [show v, opcode, show w, "=", show (op v w)]

next :: [Int] -> [([Int],String)]
next l = M.toList $ M.fromList $ do
    (i,v) <- zip [1..] l
    (j,w) <- zip [1..] l
    guard $ i /= j
    (op,opcode) <- [((+),"+"),((-),"-"),((*),"*")]
    let s = pprint v w (op,opcode)
    return (insert (op v w) (delete v $ delete w l), s)

main = do
    n <- readLn
    case solve1 n of
        Nothing -> putStrLn "NO"
        Just xs -> putStrLn "YES" >> forM_ xs putStrLn

{-# LANGUAGE MagicHash, UnboxedTuples #-}
import qualified Data.ByteString as BS
import Control.Arrow

r1 [] = []
r1 (h : t) = (h, t) : map (second (h:)) (r1 t)

bf :: [(Int, String)] -> [(Int, String)]
bf [x] = [x]
bf l = do
  let (a,as) +++ (b, bs) = (a + b, "(" ++ as ++ "+" ++ bs ++ ")")
  let (a,as) +-- (b, bs) = (a - b, "(" ++ as ++ "-" ++ bs ++ ")")
  let (a,as) +** (b, bs) = (a * b, "(" ++ as ++ "*" ++ bs ++ ")")
  (a, l) <- r1 l
  (b, l) <- r1 l
  concat [bf (a +++ b : l), bf (a +-- b : l), bf (a +** b : l)]

s5 = ["5 * 4 = 20", "3 + 2 = 5", "20 + 5 = 25", "25 - 1 = 24"]
s4 = ["1 * 2 = 2", "2 * 3 = 6", "6 * 4 = 24"]
s :: Int -> Maybe [String]
s 0 = Nothing
s 1 = Nothing
s 2 = Nothing
s 3 = Nothing
s 5 = Just s5
s 4 = Just s4
s n = Just $
  concat [[show (n - i*2) ++ " - " ++ show (n - i*2 - 1) ++ " = 1", "1 * 1 = 1"] |i<-[1..(n-4) `div` 2]]
  ++ concat [s5|odd n]
  ++ concat [s4|even n]

pp Nothing = ["NO"]
pp (Just ss) = "YES" : ss

main = interact $ unlines . pp . s . read


import Data.List (sort)

main = do
	(n:as) <- fmap (map read . words) getContents
	let a = sort as
	let b = zipWith (-) (tail a) a
	let g = foldl1 gcd b
	print $ (quot ((a !! (n - 1)) - (a !! 0)) g) - (n - 1)

import Data.List;

main = getContents >>= (print . f . sort . tail . map mread . words)
	where
		mread n = read n
		maxx [] = -2000000001
		maxx (x : xz) = max x (maxx xz)
		minn [] = 2000000001
		minn (x : xz) = min x (minn xz)
		g _ [] = 0
		g b (x : xz) = gcd (x - b) (g x xz)
		f t@(x :xz) = div (maxx t - minn t)  (g x xz) - length xz

module Main where
import Control.Monad
import Control.Applicative
import Data.List

main = do
	n <- read <$> getLine :: IO Int
	a <- sort . map read . words <$> getLine :: IO [Int]
	let b = zipWith (-) (tail a) a
	let g = foldl gcd 0 b
	let h = map (\x -> x `div` g - 1) b
	let ans = sum h
	putStrLn $ show ans
	return ()

import Data.List

main :: IO ()
main = do
    num <- getLine
    temp <- getLine
    let arr = toSub . sorted $ temp
    putStrLn . show $ cal arr (minimum . toGcd $ arr)

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

toSub :: [Int] -> [Int]
toSub [_] = []
toSub (x:rest@(y:ys)) = [y - x] ++ toSub rest

toGcd :: [Int] -> [Int]
toGcd [_] = []
toGcd (x:rest@(y:ys)) = [gcd x y] ++ toGcd rest

cal :: [Int] -> Int -> Int
cal lst dis = sum (map (`div` dis) lst) - length lst

import Data.List

main = interact $ show . f . map read . words . last . lines

f :: [Int] -> Int
f ls = ((maximum ls - minimum ls) `div`
  (foldl1' gcd $ zipWith (-) ls (tail ls))) + 1 - length ls

import Data.List

solve :: Int -> [Int] -> Int
solve a b =
        (div (maxi - mini) g) - (a-1)
    where
        maxi = maximum b
        mini = minimum b
        l = map (\x -> x-mini) b
        g = foldl gcd (head l) l

main :: IO ()
main = do
  a <- readLn :: IO Int
  ln <- getLine
  let b = map read $ words ln
  print $ solve a b

import Data.List

solve :: Int -> [Int] -> Int
solve a b =
        (div (maxi - mini) g) - (a-1)
    where
        maxi = maximum b
        mini = minimum b
        l = map (\x -> x-mini) b
        g = foldr gcd (head l) l

main :: IO ()
main = do
  a <- readLn :: IO Int
  ln <- getLine
  let b = map read $ words ln
  print $ solve a b

module Main where

solve :: Integer -> [Integer] -> Integer
solve n xs = let
        a1 = minimum xs
        x = foldr1 gcd $ map (\x -> x - a1) xs
        an = maximum xs
    in ((an - a1) `div` x) - n + 1

main :: IO ()
main = do
    n' <- getLine
    xs' <- getLine
    let n = read n' :: Integer
    let xs = map read $ words xs' :: [Integer]
    print $ solve n xs

import Data.List

qweqwe :: [Int] -> Int -> Int
qweqwe (_:[]) ans = ans
qweqwe (a:b) (-1) = qweqwe b ((head b) - a)
qweqwe (a:b) ans = qweqwe b (gcd ans ((head b) - a))

main = do
	getLine
	l <- getLine
	let a = map read $ words l :: [Int]
	let b = sort a
	print (div ((last b) - (head b)) (qweqwe b (-1)) - (length b) + 1)

import Data.List (sort)

diff [] = []
diff (x:[]) = []
diff (x:y:xs) = (y-x):(diff (y:xs))

ggcd [x] = x
ggcd (x:xs) = gcd x (ggcd xs)

res [] g = 0
res (d:ds) g = (d `div` g - 1) + (res ds g)

main = do
  (n:xs) <- fmap (map read . words) getContents
  let ds = diff (sort xs :: [Integer])
  let g = ggcd ds
  print (res ds g)
  -- print ks

import Data.List

main :: IO ()
main = do
    num <- getLine
    temp <- getLine
    let arr = toSub . sorted $ temp
    putStrLn . show $ cal arr (minimum arr)

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

toSub :: [Int] -> [Int]
toSub [_] = []
toSub (x:rest@(y:ys)) = [y - x] ++ toSub rest

toGcd :: [Int] -> [Int]
toGcd [_] = []
toGcd (x:rest@(y:ys)) = [gcd x y] ++ toGcd rest

cal :: [Int] -> Int -> Int
cal lst dis = sum (map (`div` dis) lst) - length lst

import Data.List

main :: IO ()
main = do
    num <- getLine
    temp <- getLine
    let arr = toSub . sorted $ temp
    putStrLn . show $ cal arr (minimum arr)

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

toSub :: [Int] -> [Int]
toSub [_] = []
toSub (x:all@(y:ys)) = [y - x] ++ toSub all

cal :: [Int] -> Int -> Int
cal lst dis = sum (map (`div` dis) lst) - length lst

module Main where

solve :: Integer -> [Integer] -> Integer
solve n xs = let
        x = foldr1 gcd xs
        an = maximum xs
        a1 = minimum xs
    in ((an - a1) `div` x) - n + 1

main :: IO ()
main = do
    n' <- getLine
    xs' <- getLine
    let n = read n' :: Integer
    let xs = map read $ words xs' :: [Integer]
    print $ solve n xs

module Main where

solve :: Integer -> [Integer] -> Integer
solve n xs = let
        a1 = minimum xs
        x = foldr1 gcd $ map (+a1) xs
        an = maximum xs
    in ((an - a1) `div` x) - n + 1

main :: IO ()
main = do
    n' <- getLine
    xs' <- getLine
    let n = read n' :: Integer
    let xs = map read $ words xs' :: [Integer]
    print $ solve n xs

import Data.List;

main = getContents >>= (print . f . sort . tail . map mread . words)
	where
		mread n = read n
		maxx [] = -1000000001
		maxx (x : xz) = max x (maxx xz)
		minn [] = 1000000001
		minn (x : xz) = min x (minn xz)
		g _ [] = 0
		g b (x : xz) = gcd (x - b) (g x xz)
		f xz = div (maxx xz - minn xz)  (g 0 xz) - length xz + 1


import Control.Applicative
import Control.Monad
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  (sn:st:sc:_) <- C.words <$> C.getLine
  let n = readInt sn
      t = readInt st
      c = read $ C.unpack sc
  a <- map readInt . C.words <$> C.getLine
  _m <- C.getLine
  p <- map readInt . C.words <$> C.getLine
  let x, y :: UArray Int Double
      a' = [fromIntegral i / fromIntegral t | i <- a]
      x = listArray (0, n) $ scanl (+) 0 a'
      y = listArray (0, n) $ scanl (\i j -> i / c + j) 0 a'
  forM_ p $ \i -> do
    let real = x!i - x!(i-t)
        approx = y!i / c
        err = abs (real - approx) / real
    putStrLn $ unwords $ map show [real, approx, err]

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

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

main = do
	(t, c) <- (\[_, t, c] -> (read t, read c :: Double)) . words <$> getLine
	a <- getInts
	ms <- getInts

	if length ms /= 1
		then putStrLn "botva"
		else putStr ""

	is <- getInts

	let
		output = map (uncurry output') $ select $ zip real approx
			where
				a' = map fromIntegral a
				t' = fromIntegral t

				output' real approx = (real, approx, abs (approx - real) / real)

				real = map (/ t') $ zipWith (-) sums $ replicate t 0 ++ sums
					where
						sums = scanl1 (+) a'

				approx = tail $ scanl (\m a -> (m + a / t') / c) 0.0 a'

				select vs = select' is vs 1
					where
						select' [] _ _ = []
						select' (i:is) (v:vs) j =
							if i == j
								then v : select' is vs (j + 1)
								else select' (i:is) vs (j + 1)

	putStrLn $ unlines $ map (unwords. map show . (\(r, a, e) -> [r, a, e])) output

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

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

main = do
	(t, c) <- (\[_, t, c] -> (read t, read c :: Double)) . words <$> getLine
	a <- getInts
	B.getLine
	is <- getInts

	let
		output = map (uncurry output') $ select $ zip real approx
			where
				a' = map fromIntegral a
				t' = fromIntegral t

				output' real approx = (real, approx, abs (approx - real) / real)

				real = map (/ t') $ zipWith (-) sums $ replicate t 0 ++ sums
					where
						sums = scanl1 (+) a'

				approx = tail $ scanl (\m a -> (m + a / t') / c) 0.0 a'

				select vs = select' is vs 1
					where
						select' [] _ _ = []
						select' (i:is) (v:vs) j =
							if i == j
								then v : select' is vs (j + 1)
								else select' (i:is) vs (j + 1)

	putStrLn $ unlines $ map (unwords. map show . (\(r, a, e) -> [r, a, e])) output

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

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

main = do
	(t, c) <- (\[_, t, c] -> (read t, read c :: Float)) . words <$> getLine
	a <- getInts
	B.getLine
	is <- getInts

	let
		output = map (uncurry output') $ select $ zip real approx
			where
				a' = map fromIntegral a
				t' = fromIntegral t

				output' real approx = (real, approx, abs (approx - real) / real)

				real = map (/ t') $ zipWith (-) sums $ replicate t 0 ++ sums
					where
						sums = scanl1 (+) a'

				approx = tail $ scanl (\m a -> (m + a / t') / c) 0.0 a'

				select vs = select' is vs 1
					where
						select' [] _ _ = []
						select' (i:is) (v:vs) j =
							if i == j
								then v : select' is vs (j + 1)
								else select' (i:is) vs (j + 1)

	putStrLn $ unlines $ map (unwords. map show . (\(r, a, e) -> [r, a, e])) output

import Control.Applicative ((<$>))

main = do
	(n, t, c) <- (\[n, t, c] -> (read n :: Int, read t :: Int, read c :: Float)) . words <$> getLine
	a <- map read . words <$> getLine
	getLine
	is <- map read . words <$> getLine

	let
		real = map (\v -> (fromIntegral v) / (fromIntegral t)) $ zipWith (-) sums $ (replicate t 0) ++ sums
			where
				sums = scanl1 (+) a

		approx = tail $ scanl (\m a -> (m + (fromIntegral a) / (fromIntegral t)) / c) 0.0 a

		select vs = select' is vs 1
			where
				select' [] _ _ = []
				select' (i:is) (v:vs) j =
					if i == j
						then v : select' is vs (j + 1)
						else select' (i:is) vs (j + 1)

		output = map calc $ zip (select real) (select approx)
			where
				calc (real, approx) = (real, approx, abs (approx - real) / real)

	putStrLn $ unlines $ map (\(r, a, e) -> show r ++ " " ++ show a ++ " " ++ show e) output

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe

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

main = do
	(n, t, c) <- (\[n, t, c] -> (read n :: Int, read t :: Int, read c :: Double)) . words <$> getLine
	a <- getInts
	getLine
	is <- getInts

	let
		real = map (\v -> (fromIntegral v) / (fromIntegral t)) $ zipWith (-) sums $ (replicate t 0) ++ sums
			where
				sums = scanl1 (+) a

		approx = tail $ scanl (\m a -> (m + (fromIntegral a) / (fromIntegral t)) / c) 0.0 a

		select vs = select' is vs 1
			where
				select' [] _ _ = []
				select' (i:is) (v:vs) j =
					if i == j
						then v : select' is vs (j + 1)
						else select' (i:is) vs (j + 1)

		output = map calc $ zip (select real) (select approx)
			where
				calc (real, approx) = (real, approx, abs (approx - real) / real)

	putStrLn $ unlines $ map (\(r, a, e) -> show r ++ " " ++ show a ++ " " ++ show e) output

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

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

main = do
	(t, c) <- (\[_, t, c] -> (read t, read c :: Double)) . words <$> getLine
	a <- getInts
	getLine
	is <- getInts

	let
		output = map (uncurry output') $ select $ zip real approx
			where
				a' = map fromIntegral a
				t' = fromIntegral t

				output' real approx = (real, approx, abs (approx - real) / real)

				real = map (/ t') $ zipWith (-) sums $ replicate t 0 ++ sums
					where
						sums = scanl1 (+) a'

				approx = tail $ scanl (\m a -> (m + a / t') / c) 0.0 a'

				select vs = select' is vs 1
					where
						select' [] _ _ = []
						select' (i:is) (v:vs) j =
							if i == j
								then v : select' is vs (j + 1)
								else select' (i:is) vs (j + 1)

	putStrLn $ unlines $ map (unwords. map show . (\(r, a, e) -> [r, a, e])) output

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe

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

main = do
	(n, t, c) <- (\[n, t, c] -> (read n :: Int, read t :: Int, read c :: Double)) . words <$> getLine
	a <- getInts
	getLine
	is <- getInts

	let
		real = map (\v -> v / (fromIntegral t)) $ zipWith (-) sums $ (replicate t 0) ++ sums
			where
				sums = scanl1 (+) $ map (\v -> fromIntegral v :: Double) a

		approx = tail $ scanl (\m a -> (m + (fromIntegral a) / (fromIntegral t)) / c) 0.0 a

		select vs = select' is vs 1
			where
				select' [] _ _ = []
				select' (i:is) (v:vs) j =
					if i == j
						then v : select' is vs (j + 1)
						else select' (i:is) vs (j + 1)

		output = map calc $ zip (select real) (select approx)
			where
				calc (real, approx) = (real, approx, abs (approx - real) / real)

	putStrLn $ unlines $ map (\(r, a, e) -> show r ++ " " ++ show a ++ " " ++ show e) output


{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Control.Monad
import Data.Char
import Data.Bits((.&.))
data Dir = L|R deriving (Eq)
indicator :: Bool -> Int
indicator b = if b then 1 else 0
revd :: Dir -> Dir
revd L = R
revd R = L

solve lns = let maxlength = (maximum.map length) lns
                w n = replicate n ' '
                rec [] _ = [replicate (maxlength+2) '*']
                rec (x:xs) dir = let margin = maxlength - (length x)
                                     leftm = div margin 2 +(indicator (dir==R&&odd margin))
                                     rightm =div margin 2 +(indicator (dir==L&&odd margin))
                                 in
                                   ('*':(w leftm)++x++(w rightm)++"*"):(if odd margin then rec xs (revd dir) else rec xs dir)
                in
                  (replicate (maxlength+2) '*'):(rec lns L)

main = do input <- getContents
          let lns = lines input
          mapM_ putStrLn (solve lns)

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

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

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

solve :: [String] -> [String]
solve ss  =  concat
    [[colontitul],
     map snd $ tail $ scanl solve' (True, "") ss,
     [colontitul]]
  where
    n  =  maximum $ map length ss
    colontitul  =  replicate (n+2) '*'
    solve' (b, _) s
      | s == ""  =  (b, "*" ++ replicate n ' ' ++ "*")
      | length s' < n  =  if b
          then (not b, "*" ++ s' ++ " *")
          else (not b, "* " ++ s' ++ "*")
      | otherwise  =  (b, "*" ++ s' ++ "*")
      where
        m  =  length s
        k  =  (n - m) `div` 2
        s'  =  concat
            [replicate k ' ', s, replicate k ' ']

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

import Control.Monad

main = do
    texts <- fmap lines getContents
    let chars = maximum $ map length texts
    putStrLn $ replicate (chars + 2) '*'
    foldM' texts $ \left s -> do
        let len = length s
            x = replicate ((chars - len) `div` 2) ' '
            y | (chars - len) `mod` 2 == 0 = x
              | otherwise = ' ':x
            (leftSpace, rightSpace)
                | left = (y, x)
                | otherwise = (x, y)
            newLeft | (chars - len) `mod` 2 == 0 = left
                    | otherwise = not left
        putStrLn $ "*" ++ leftSpace ++ s ++ rightSpace ++ "*"
        return newLeft
    putStrLn $ replicate (chars + 2) '*'

foldM' xs f = foldM_ f False xs

module Main (main) where

main = do
    instr <- getContents
    let ls = lines instr
    putStr $ unlines $ solve ls where

        solve ls = stars (reverse (wrap (-1) (zip lens ls) [])) where

            max = maximum lens
            lens = map length ls
            probels = repeat ' '

            wrap _ [] acc = acc
            wrap lr ((len, s):ss) acc = if even razn
                then wrap lr ss ((probs ++ s ++ probs):acc)
                else if lr > 0 then wrap (-lr) ss ((probs ++ " " ++ s ++ probs):acc)
                               else wrap (-lr) ss ((probs ++ s ++ probs ++ " "):acc) where
                razn = max - len
                r2 = div razn 2
                probs = take r2 probels

            stars ss = starn ++ map wrstar ss ++ starn where
                starn = [take (max + 2) $ repeat '*']
                wrstar s = "*" ++ s ++ "*"

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

solve :: [String] -> [String]
solve = do
  ss <- id
  let ws = map length ss
  let wmax = maximum ws
  let ls = snd $ mapAccumL check 0 (map (`subtract` wmax) ws) where
        check acc n | even n    = (acc, n `quot` 2)
                    | otherwise = ((acc + 1) `rem` 2, (n + acc) `quot` 2)
  let hs = return $ replicate (wmax + 2) '*'
  let fs = hs
  let contens = do (w, l, s) <- zip3 ws ls ss
                   return $  "*"
                          ++ replicate l ' '
                          ++ s
                          ++ replicate (wmax - l - w) ' '
                          ++ "*"
  return $ hs ++ contens ++ fs

main = interact $ unlines . solve . lines

main = do
    l <- lines `fmap` getContents
    let placeLength = maximum $ map length l
        center (left, res) s =
            let diff = placeLength - length s
                half = diff `div` 2
                r' = (flip replicate) ' '
                (l, r) = case (left, diff) of
                    _ | even diff -> (left, r' half ++ s ++ r' half)
                      | odd diff && left -> (not left, r' half ++ s ++ r' (half + 1))
                      | otherwise -> (not left, r' (half + 1) ++ s ++ r' half) in
            (l, ('*':r++"*"):res)
        stars = putStrLn $ replicate (placeLength + 2) '*'
    stars
    mapM putStrLn $ reverse $ snd $ foldl center (True, []) l
    stars

import Data.List

main = interact $ (dump . solve . load) where
	load :: String -> [String]
	load = lines

	dump :: [String] -> String
	dump = unlines

	solve :: [String] -> [String]
	solve ls =
		let
			maxLen = foldl1' max $ map length $ ls
			fillLR s left right = '*' : (replicate left ' ') ++ s ++ (replicate right ' ') ++ "*"
			fill s toLeft =
				let
					half = (maxLen - length s) `div` 2
				in
					if half * 2 == maxLen - length s then (fillLR s half half, toLeft)
					else
						if toLeft then (fillLR s half (half + 1), not toLeft)
						else (fillLR s (half + 1) half, not toLeft)

			alter :: Bool -> [String] -> [String] -> [String]
			alter _ [] acc          = reverse acc
			alter tl (x:xs) acc =
				let
					(s, ntl) = fill x tl
				in
					alter ntl xs (s : acc)
		in
			(replicate (maxLen + 2) '*') : (alter True ls []) ++ [(replicate (maxLen + 2) '*')]

ast n = replicate n '*'
spc n = replicate n ' '

f w [] _ = []
f w (l:ls) left =
  let n = (w-length l) `div` 2
  in if (w-length l) `mod` 2 == 0 then
        ("*"++spc n++l++spc n++"*") : f w ls left
     else
        ("*"++spc (n+left)++l++spc (n+1-left)++"*") : f w ls (1-left)

main = do
     contents <- return . lines =<< getContents
     let w = maximum $ map length contents
     mapM_ putStrLn $ [ast (w+2)]++f w contents 0++[ast (w+2)]

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

copy :: Char -> Int -> String
copy _ 0 = ""
copy c n = c:(copy c (n - 1))

printAns :: Int -> Int -> [String] -> IO()
printAns w par (a:b)
    | a == "" = do
        putStrLn ("*" ++ (copy ' ' w) ++ "*")
        printAns w par b
    | mod s 2 == 0  = do
        putStrLn ("*" ++ (copy ' ' (div s 2)) ++ a ++ (copy ' ' (div s 2)) ++ "*")
        printAns w par b
    | otherwise     = do
        putStrLn ("*" ++ (copy ' ' (div s 2 + par)) ++ a ++ (copy ' ' (div s 2 + 1 - par)) ++ "*")
        printAns w (1 - par) b
        where s = w - length a
printAns _ _ _ = do
    putStr ""

main :: IO()
main = do
    input <- getContents
    let list = lines input
    let w = maximum (1 : map length list)
    putStrLn (copy '*' (w + 2))
    printAns w 0 list
    putStrLn (copy '*' (w + 2))

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Control.Monad (foldM_)
import Data.Functor (($>))

main :: IO ()
main = do
    ls <- T.lines <$> TIO.getContents
    let maxLength = maximum $ map T.length ls
    let frameStr = T.replicate (maxLength + 2) "*"
    TIO.putStrLn frameStr
    foldM_ (putFormattedStr maxLength) 0 ls
    TIO.putStrLn frameStr

putFormattedStr :: Int -> Int -> T.Text -> IO Int
putFormattedStr len add line = TIO.putStrLn formattedLine $> rem
  where
    spareLen = len - T.length line
    (left, rem) = (spareLen + add) `quotRem` 2
    right = spareLen - left
    formattedLine = "*" <> T.replicate left " " <> line <> T.replicate right " " <> "*"

g w  = take w $ repeat '*'
sp w = take w $ repeat ' '

out :: Int -> [String] -> Bool -> [String]
out width [] _ = []
out width (s:sx) left | (width - length s) `mod` 2 == 0 =
    let w = (width - length s) `div` 2
    in ( sp w ++ s ++ sp w ):(out width sx left)
                      | True =
    ( sp (c w left) ++ s ++ sp (c w (not left)) ):(out width sx (not left))
        where w = (width - length s) `div` 2
              c w True = w
              c w False = w+1

main = do
    s <- getContents
    let l = lines s
        width = maximum $ map length l
        output = [g width] ++ out width l True ++ [g width]
    mapM_ putStrLn $ map (\a -> "*" ++ a ++ "*") output

import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Char
import Data.List

main =  do
    t <- map (T.filter (\x -> isAlphaNum x || x == ' ')) . T.lines . decodeUtf8 <$> B.getContents
    let (ls, m) = (map T.length t, maximum ls)
        bs = tail $ reverse $ foldl' (\acc@(b:_) x -> if x < m && (x-m)`mod`2/=0 then (not b:acc) else b:acc) [True] ls
        border = T.pack $ replicate (m+2) '*'
    B.putStrLn $ encodeUtf8 $ T.unlines $ (border : zipWith  (\x b -> T.append ( T.cons '*' $ if b then T.center m ' ' x else T.reverse $ T.center m ' ' $ T.reverse x) $ T.pack "*") t bs )  ++ [border]

import Control.Monad

main = do
    texts <- fmap lines getContents
    let chars = maximum $ map length texts
    putStrLn $ replicate (chars + 2) '*'
    forM_ texts $ \s -> do
        let len = length s
            leftSpace = replicate ((chars - len) `div` 2) ' '
            rightSpace | (chars - len) `mod` 2 == 0 = leftSpace
                       | otherwise = ' ':leftSpace
        putStrLn $ "*" ++ leftSpace ++ s ++ rightSpace ++ "*"
    putStrLn $ replicate (chars + 2) '*'

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

-- Seems to be OK?
solve :: [String] -> [String]
solve = do
  ss <- id
  let w = maximum $ map length ss
  return ss

main = interact $ unlines . solve . lines

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

-- Compile Check
-- How come we can't use function monad?

solve :: [String] -> [String]
solve = do
  s <- id
  return s

main = interact $ unlines . solve . lines

main = do
    l <- lines `fmap` getContents
    let placeLength = maximum $ map length l
        center (left, res) s =
            let diff = placeLength - length s
                half = diff `div` 2
                r' = (flip replicate) ' '
                (l, r) = case (left, diff) of
                    _ | even diff -> (left, r' half ++ s ++ r' half)
                      | odd diff && left -> (not left, r' half ++ s ++ r' (half + 1))
                      | otherwise -> (not left, r' half ++ s ++ r' (half + 1)) in
            (l, ('*':r++"*"):res)
        stars = putStrLn $ replicate (placeLength + 2) '*'
    stars
    mapM putStrLn $ reverse $ snd $ foldl center (True, []) l
    stars

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

main :: IO ()
main = do
    ls <- T.lines <$> TIO.getContents
    let maxLength = maximum $ map T.length ls
    let frameStr = T.replicate (maxLength + 2) "*"
    TIO.putStrLn frameStr
    mapM_ (TIO.putStrLn . formatStr maxLength) ls
    TIO.putStrLn frameStr
  where
    center len line = T.replicate left " " <> line <> T.replicate (len - T.length line - left) " " where left = (len - T.length line) `div` 2
    formatStr len line = "*" <> center len line <> "*"

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

main :: IO ()
main = do
    ls <- T.lines <$> TIO.getContents
    let maxLength = maximum $ map T.length ls
    let frameStr = T.replicate (maxLength + 2) "*"
    TIO.putStrLn frameStr
    mapM_ (TIO.putStrLn . formatStr maxLength) ls
    TIO.putStrLn frameStr
  where
    formatStr len instr = "*" <> T.center len ' ' instr <> "*"

import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Data.Text.Encoding

main =  do
    t <- T.lines . decodeUtf8 <$> B.getContents
    let m = foldr (\x acc -> max acc $ T.length x) 0 t
        border = T.pack $ replicate (m+2) '*'
    B.putStrLn $ encodeUtf8 $ T.unlines $ (border : map (\x -> T.append ( T.cons '*' $ T.reverse $ T.center m ' ' $ T.reverse x) $ T.pack "*") t )  ++ [border]

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

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

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

solve :: [String] -> [String]
solve ss  =  concat
    [[colontitul],
     map snd $ tail $ scanl solve' (True, "") ss,
     [colontitul]]
  where
    n  =  maximum $ map length ss
    colontitul  =  replicate (n+2) '*'
    solve' (b, _) s
      | s == ""  =  (b, replicate n ' ')
      | length s' < n  =  if b
          then (not b, "*" ++ s' ++ " *")
          else (not b, "* " ++ s' ++ "*")
      | otherwise  =  (b, "*" ++ s' ++ "*")
      where
        m  =  length s
        k  =  (n - m) `div` 2
        s'  =  concat
            [replicate k ' ', s, replicate k ' ']

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


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

solve :: [Int] -> Int
solve (m:a) = solve' a
    where solve' :: [Int] -> Int
          solve' [] = -1
          solve' (x:y:s) | m > x && y == 0 = max 0 (solve' s)
                         | m > x = max (100 - y) (solve' s)
                         | m == x && y == 0 = max 0 (solve' s)
                         | otherwise = solve' s

main=getContents>>=print.s.map(map read.words).lines
s([_,s]:x)=maximum$ -1:[if y>0 then 100-y else 0|[x,y]<-x,x*100+y<=s*100]

-- Codeforces 463A

main :: IO ()
main = do
    [n, s] <- fmap (map read . words) getLine
    getContents >>= print . solve s . map (map read . words) . lines

solve :: Int -> [[Int]] -> Int
solve s xs = if length enough == 0 then (-1) else 100 - (minimum $ (100:) $ filter (/= 0) $ map (!!1) enough)  where enough = filter (\[a,b] -> a<s || a==s && b==0) xs
                                                                -- prepend 100: to avoid empty list error.

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

solve :: [[Integer]] -> Integer
solve ([_, s] : xys) = maximum $ -1 : [ if y > 0 then 100 - y else 0 | [ x, y ] <- xys, x * 100 + y <= s * 100 ]
solve _ = undefined

parse :: String -> (Int, Int)
parse s = case map read (words s) of [x, y] -> (x, y)
price (x, y) = x * 100 + y
solve ((_,s):xs) = maximum $ (-1) : [if y > 0 then 100 - y else 0 | t@(_, y) <- xs, price t <= s * 100]
main = putStrLn . show . solve . map parse . lines =<< getContents

import Control.Monad
s([_,s]:l)=maximum ((-1):(l>>=(\[d,c]->guard(d*100+c<=s*100)>>[if c==0 then 0 else 100-c])))
main=interact$show.s.map(map read.words).lines

import Control.Applicative
import Data.List

main=do
	[n,s]<-  map read.words  <$> getLine:: IO [Int]
	t<- map (map read). map words . lines <$> getContents :: IO [[Int]]
	let t1 =  map last $ filter (\z-> head z<s || (head z==s && last z==0)) t
	print $ if length t1==0 then (-1)
                                else if length (filter (/=0) t1)==0 then 0
                                                                    else 100-(minimum (filter (/=0) t1))

main = interact $ show . sol . map read . words

sol (_:s:xs) = cal $ ok s xs

cal [] = -1
cal xs = maximum . map ((`mod`100).(100-).snd) $ xs

ok s = filter (\(a, b) -> a < s || (a==s && b==0)) . tp

tp [] = []
tp (f:s:xs) = (f, s):(tp xs)

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . getAns . getIntArray

getAns :: [Int] -> Int
getAns (_:s:xs) = calMax s xs

calMax :: Int -> [Int] -> Int
calMax _ [] = -1
calMax s (x:y:xs) = let nm = if (x * 100 + y <= s * 100) then mod (100 - y) 100 else -1;
					in max nm $ calMax s xs

main = interact $ show . f . map read . tail . words
f (s:[]) = -1
f (s:x:y:z) = max (if s * 100 < x * 100 + y then -1 else mod (s * 100 - x * 100 - y) 100) $ f (s:z)

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

ans n = sort . map ((`mod`100) . (n-)) . filter (<= n) . map cost
	where cost [d,c] = d*100 + c

solve [] = -1
solve l = last l

main = do
		[n,s] <- map read . words <$> getLine
		xy <- replicateM n $ map read . words <$> getLine
		let cent = 100*s
      		print $ solve $ ans cent xy

parse :: String -> (Int, Int)
parse s = case map read (words s) of [x, y] -> (x, y)
price (x, y) = x * 100 + y
maxCents s p@(x, y) = maximum . map (`mod` 100) . takeWhile (> 0) $ map (\x -> s - price p * x) [1..]
solve ((_,s'):xs) = let s = s' * 100 in case filter (\x -> price x <= s) xs of
    [] -> (-1)
    rs -> maximum $ map (maxCents s) rs
main = putStrLn . show . solve . map parse . lines =<< getContents

import Control.Applicative
import Data.List

main=do
	[n,s]<-  map read.words  <$> getLine:: IO [Int]
	t<- map (map read). map words . lines <$> getContents :: IO [[Int]]
	let t1 =  map last $ filter (\z-> head z<s) t
	print $ if length t1==0 then (-1)
                                else if length (filter (/=0) t1)==0 then 0
                                                                    else 100-(minimum (filter (/=0) t1))


{-
instructions go here...
-}

module Main where
import Data.List (group, sort, splitAt)
import Data.Set (Set(..), empty, singleton, toList, insert, unions, member)

solve :: String -> [String]
solve str = sort . toList . nth3_3 . foldr f f0 $ (drop 5 str)
  where f0 = ([True,False,False,False,False], "-----", empty)
        f :: Char -> ([Bool],[Char],Set String) -> ([Bool],[Char],Set String)
        f x0 (oks@[ok1,ok2,ok3,ok4,ok5], xs@[x1,x2,x3,x4,x5], suffixes) =
          let ok02 = ok2 && ok5
                  || ok2 && [x0,x1] /= [x2,x3]
              ok03 = ok3 && ok5
                  || ok3 && [x0,x1,x2] /= [x3,x4,x5]
              suffixes' = unions [ suffixes
                                 , if ok02 then singleton [x0,x1] else empty
                                 , if ok03 then singleton [x0,x1,x2] else empty
                                 ]
          in (enqueue (ok02 || ok03) oks, enqueue x0 xs, suffixes')
        nth3_3 (_,_,x) = x
        enqueue x xs = x : init xs

solve' :: String -> [String]
solve' str = sort . map reverse . toList . fst . suffixes (empty,"",0,empty) $ reverse str
  where suffixes :: (Set String, String, Int, Set Int) -> String -> (Set String, Set Int)
        suffixes (seen,prev,pos,processed) str =
          if pos `member` processed
            then (seen,processed) -- prune search of this branch - this state has already been explored
            else
              let (suffixes2,processed2) = case trySuffix 2 (seen,prev) str of
                                            Nothing ->
                                              (seen,processed)
                                            Just (seen',prev',str') ->
                                              suffixes (seen',prev',pos+2,processed) str'
                  (suffixes3,processed3) = case trySuffix 3 (seen,prev) str of
                                            Nothing ->
                                              (seen,processed2)
                                            Just (seen',prev',str') ->
                                              suffixes (seen',prev',pos+3,processed2) str'
              in (unions [suffixes2, suffixes3], unions [processed2, processed3, singleton pos])
        trySuffix :: Int -> (Set String, String) -> String -> Maybe (Set String, String, String)
        trySuffix n (seen,prev) str
          | str `shorterThan` (5 + n) = Nothing
          | otherwise          = let (suffix,rest) = splitAt n str
                                 in if suffix == prev
                                      then Nothing
                                      else Just (insert suffix seen, suffix, rest)

shorterThan [] n = n > 0
shorterThan xs n = shorterThan (tail xs) (n-1)

main :: IO ()
main = do
  word <- getLine
  let suffixes = solve word
  putStrLn $ show (length suffixes)
  mapM_ putStrLn suffixes

import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S

main = do
    s <- fmap (B.init . B.drop 5) B.getLine
    let all = solve s
    print $ S.size all
    B.putStrLn $ (B.pack "\n") `B.intercalate` S.toAscList all

solve s = all 0 d S.empty
  where d = dp s (B.length s - 4) [(False, True), (True, False), (False, False)]
        all i [] res = res
        all i ((v2,v3):xs) res = all (i + 1) xs res''
            where res'  = if v2 then (cur2 s i) `S.insert` res  else res
                  res'' = if v3 then (cur3 s i) `S.insert` res' else res'

dp s i res
  | i < 0 = drop (negate i - 1) res
  | otherwise = dp s (i - 1) ((v2, v3) : res)
  where v2 = snd (res !! 1) || (fst (res !! 1) && cur2 s i /= cur2 s (i + 2))
        v3 = fst (res !! 2) || (snd (res !! 2) && cur3 s i /= cur3 s (i + 3))

cur2 s a = B.take 2 . B.drop a $ s
cur3 s a = B.take 3 . B.drop a $ s

import qualified Data.IntMap as IM
import Data.Char
import Data.IntMap ((!))
import Data.Ix (Ix, index, range)
import Data.List

main = do
    s <- getContents
    let strings = solve . filter (not.isSpace) $ s
    print $ length strings
    mapM_ putStrLn strings

solve s = map head . group . sort $ strings
  where
    ms = IM.fromList $ zip [0..] (reverse s)
    n = IM.size ms

    f _ (_, m) | n-m <= 5 = False
    f _ (2, 1) = True
    f _ (3, 2) = True
    f _ (_, m) | m <= 2 = False
    f rec (prev, m) = rec (5-prev, m-prev) || (rec (prev, m-prev) && not (eq (m-2*prev) (m-prev)))

    eq a b = and $ zipWith (==) (map (ms!) [a+1..b]) (map (ms!) [b+1 .. 2*b-a])

    isGood = immemo f (2,0) (3,n-1)

    good2 = [i | i <- [1..n-1], isGood (2, i)]
    good3 = [i | i <- [2..n-1], isGood (3, i)]
    strings = [[ms!i, ms!(i-1)] | i <- good2] ++ [[ms!i, ms!(i-1), ms!(i-2)] | i <- good3]

immemo :: (Ix i) => ((i -> a) -> i -> a) -> i -> i -> i -> a
immemo f l r = memo
  where
    ix = index (l,r)
    memo = (IM.!) dp . ix
    dp = IM.fromList [(ix k, f memo k) | k <- range (l,r)]

import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S

main = do
    s <- fmap (B.drop 5) B.getLine
    let all = solve s
    print $ S.size all
    B.putStrLn $ (B.pack "\n") `B.intercalate` S.toAscList all

solve s = all 0 d S.empty
  where d = dp s (B.length s - 4) [(False, True), (True, False), (False, False)]
        all i [] res = res
        all i ((v2,v3):xs) res = all (i + 1) xs res''
            where res'  = if v2 then (cur2 s i) `S.insert` res  else res
                  res'' = if v3 then (cur3 s i) `S.insert` res' else res'

dp s i res
  | i < 0 = drop (negate i - 1) res
  | otherwise = dp s (i - 1) ((v2, v3) : res)
  where v2 = snd (res !! 1) || (fst (res !! 1) && cur2 s i /= cur2 s (i + 2))
        v3 = fst (res !! 2) || (snd (res !! 2) && cur3 s i /= cur3 s (i + 3))

cur2 s a = B.take 2 . B.drop a $ s
cur3 s a = B.take 3 . B.drop a $ s

import Data.List
import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S

main = do
    s <- fmap (B.drop 5) B.getLine
    B.putStrLn s
    let all = solve s
    print $ S.size all
    B.putStrLn $ (B.pack "\n") `B.intercalate` S.toAscList all

solve s = all 0 d S.empty
  where d = dp s (B.length s - 4) [(False, True), (True, False), (False, False)]
        all i [] res = res
        all i ((v2,v3):xs) res = all (i + 1) xs res''
            where res'  = if v2 then (cur2 s i) `S.insert` res  else res
                  res'' = if v3 then (cur3 s i) `S.insert` res' else res'

dp s i res
  | i < 0 = drop (negate i - 1) res
  | otherwise = dp s (i - 1) ((v2, v3) : res)
  where v2 = snd (res !! 1) || (fst (res !! 1) && cur2 s i /= cur2 s (i + 2))
        v3 = fst (res !! 2) || (snd (res !! 2) && cur3 s i /= cur3 s (i + 3))

cur2 s a = B.take 2 . B.drop a $ s
cur3 s a = B.take 3 . B.drop a $ s

import qualified Data.IntMap as IM
import Data.IntMap ((!))
import Data.Ix (Ix, index, range)
import Data.List

main = do
    s <- getContents
    let strings = solve s
    print $ length strings
    mapM_ putStrLn strings

solve s = map head . group . sort $ strings
  where
    ms = IM.fromList $ zip [0..] (reverse s)
    n = IM.size ms

    f _ (_, m) | n-m <= 5 = False
    f _ (2, 1) = True
    f _ (3, 2) = True
    f _ (_, m) | m <= 2 = False
    f rec (prev, m) = rec (5-prev, m-prev) || (rec (prev, m-prev) && not (eq (m-2*prev) (m-prev)))

    eq a b = and $ zipWith (==) (map (ms!) [a+1..b]) (map (ms!) [b+1 .. 2*b-a])

    isGood = immemo f (2,0) (3,n-1)

    good2 = [i | i <- [1..n-1], isGood (2, i)]
    good3 = [i | i <- [2..n-1], isGood (3, i)]
    strings = [[ms!i, ms!(i-1)] | i <- good2] ++ [[ms!i, ms!(i-1), ms!(i-2)] | i <- good3]

immemo :: (Ix i) => ((i -> a) -> i -> a) -> i -> i -> i -> a
immemo f l r = memo
  where
    ix = index (l,r)
    memo = (IM.!) dp . ix
    dp = IM.fromList [(ix k, f memo k) | k <- range (l,r)]


import           Control.Monad
import           Control.Monad.Trans.State
import           Data.IntMap               (IntMap)
import qualified Data.IntMap               as IntMap
import           Data.List
import qualified Data.Map                  as Map

main :: IO()
main = do
  q <- read <$> getLine
  replicateM_ q solve

solve :: IO ()
solve = do
  s <- getLine
  m <- read <$> getLine :: IO Int
  b <- map read . words <$> getLine :: IO [Int]
  --print $ evalState (replicateM 1 $ calculateOrder m b) (0, [], IntMap.empty)
  let iMap = last $ evalState (replicateM 26 $ calculateOrder m b) (0, [], IntMap.empty)
  let wtf = IntMap.toList iMap
  let wtf3 = sortOn fst $ IntMap.toList $ foldr (\ (_, r) -> IntMap.alter alterM r) IntMap.empty wtf
  let wtf2 = reverse $ Map.toList $ foldr (Map.alter alterM) Map.empty s
  let wtf4 = IntMap.fromList $ cf wtf3 wtf2
  let wtf5 = map ((\ r -> wtf4 IntMap.! r). snd) wtf
  putStrLn wtf5
  return ()
  where
    alterM :: Maybe Int -> Maybe Int
    alterM Nothing  = Just 1
    alterM (Just k) = Just $ k+1
    cf :: [(Int, Int)] -> [(Char, Int)] -> [(Int, Char)]
    cf [] _ = []
    cf wtf3@((wf, ws):tf3) ((wtf, wts):f2) | ws <= wts = (wf, wtf) : cf tf3 f2
                                           | otherwise = cf wtf3 f2

calculateOrder :: Int -> [Int] -> State (Int, [Int], IntMap Int) (IntMap Int)
calculateOrder m b = do
  (it, l, iMap) <- get
  let diff = map (\ i -> sum (map (\ e -> abs $ i - e) l)) [1..m]
  let match = filter (\ x -> x /= -1) $ zipWith3 (\ e d i -> if e == d then i else -1) b diff [1..]
  let newM = foldr (\ i -> if i == -1 then id else IntMap.insertWith (flip const) i it) iMap match
  put (it + 1, match `union` l, newM)
  return newM

import Control.Monad
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.List (group)
fullUpdate f b = helper (Map.keys b) b
  where helper [] b = b
        helper (a:t) b = helper t (Map.updateWithKey f a b)

fullInsert keys b val = helper keys b
  where helper [] b = b
        helper (a:t) b = helper t (Map.insert a val b)

deleteAfter key map = Map.filterWithKey (\k _ -> k < key) map

solve (t, b) =
  let
    iter t b new
      | Map.size b == 0 = Map.elems new
      | otherwise   =
        let
          zeros = filter (\(_,b) -> b == 0) (Map.assocs b)
          zeroInd = map fst zeros
          maxT = fst.head $ filter (\(_, i) -> i >= length zeroInd) (Map.toDescList t)
          newB = Map.mapWithKey (\k a -> a - sum (map (\x -> abs (k - x)) zeroInd)) (fullUpdate (\i a -> if elem i (zeroInd) then Nothing else Just a) b)
        in
          iter (deleteAfter maxT t) newB (fullInsert zeroInd new maxT)
  in
    iter t b Map.empty

getCase = do
  t <- Map.fromListWith (+) . (flip zip) (repeat 1) <$> getLine
  n <-getLine
  bStr <- getLine
  let b = Map.fromList $ zip [1..] ((map read) $ words bStr)
  return (t, b)

main = do
  n <- read <$> getLine
  inp <- replicateM n getCase
  mapM_ putStrLn (map solve inp)

import           Control.Monad
import           Control.Monad.Trans.State
import           Data.IntMap               (IntMap)
import qualified Data.IntMap               as IntMap
import           Data.List
import qualified Data.Map                  as Map

main :: IO()
main = do
  q <- read <$> getLine
  replicateM_ q solve

solve :: IO ()
solve = do
  s <- getLine
  m <- read <$> getLine :: IO Int
  b <- map read . words <$> getLine :: IO [Int]
  let iMap = last $ evalState (replicateM 26 $ calculateOrder m b) (0, [], IntMap.empty)
  let wtf = IntMap.toList iMap
  let wtf3 = sortOn fst $ IntMap.toList $ foldr (\ (_, r) -> IntMap.alter alterM r) IntMap.empty wtf
  let wtf2 = reverse $ Map.toList $ foldr (Map.alter alterM) Map.empty s
  let wtf4 = IntMap.fromList $ cf wtf3 wtf2
  let wtf5 = map ((\ r -> wtf4 IntMap.! r). snd) wtf
  putStrLn $ unwords $ map (:[]) wtf5
  return ()
  where
    alterM :: Maybe Int -> Maybe Int
    alterM Nothing  = Just 1
    alterM (Just k) = Just $ k+1
    cf :: [(Int, Int)] -> [(Char, Int)] -> [(Int, Char)]
    cf [] _ = []
    cf wtf3@((wf, ws):tf3) ((wtf, wts):f2) | ws <= wts = (wf, wtf) : cf tf3 f2
                                           | otherwise = cf wtf3 f2

calculateOrder :: Int -> [Int] -> State (Int, [Int], IntMap Int) (IntMap Int)
calculateOrder m b = do
  (it, l, iMap) <- get
  let diff = map (\ i -> sum (map (\ e -> abs $ i - e) l)) [1..m]
  let match = zipWith3 (\ e d i -> if e == d then i else -1) b diff [1..]
  let newM = foldr (\ i -> if i == -1 then id else IntMap.insertWith (flip const) i it) iMap match
  put (it + 1, match, newM)
  return newM


import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    [a,b,c,d] <- (map (read ::String -> Int).words) <$> getLine
    putStrLn $ (unwords.map show) [b,c,c]

import Control.Arrow

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

process :: [[Int]] -> [[Int]]
process [] = []
process ([_,b,c,_]:ps) = [b,c,c] : process ps

module Main where

import Control.Monad
import Data.List

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

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

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b, c, d] <- getIntList
        printList [b, c, c]

main = getLine >>= test.read
test 0 = return ()
test i = do
    (a:b:c:d:_) <- map read . words <$> getLine :: IO [Integer]
    putStrLn $ unwords $ map show [b, c, c]
    test (i - 1)

solve :: [String] -> [String]
solve [a, b, c, d] = [b, c, c]

io :: String -> String
io s = unlines $ map (unwords . solve . words) $ drop 1 (lines s)

main :: IO ()
main = do
  interact io

import Control.Monad (forM_)

-- a <= x <= b <= y <= c <= z <= d
-- x + y > z

solve [a,b,c,d] = show b ++ " " ++ show c ++ " " ++ show c where

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		xs <- fmap (map read.words) getLine :: IO [Int]
		putStrLn (solve xs)

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

process [a,b,c,d] = do
			putStrLn $ intercalate " " $ map show [b,c,c]

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

solve :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer, Integer)
solve _ b c _ = (b, c, c)

parse :: String -> String
parse input = (show x) ++ " " ++ (show y) ++ " " ++ (show z)
  where [a, b, c, d] = map (\r -> read r :: Integer) $ words input
        (x, y, z) = solve a b c d

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


import Data.Array
import Control.Monad (forM_,replicateM)
import Text.Printf

hasStar xs = any (=='*') xs

solve arr =
  let ((rmin,cmin),(rmax,cmax)) = bounds arr
      row r = [ arr ! (r,c) | c <- [cmin..cmax] ]
      col c = [ arr ! (r,c) | r <- [rmin..rmax] ]
      rlo -- first row which has a "*"
          = head [ r | r <- [rmin..rmax], hasStar (row r) ]
      rhi -- last row which has a "*"
          = head [ r | r <- [rmax,rmax-1..rmin], hasStar (row r) ]
      clo -- first column which has a "*"
          = head [ c | c <- [cmin..cmax], hasStar (col c) ]
      chi -- last column which has a "*"
          = head [ c | c <- [cmax,cmax-1..cmin], hasStar (col c) ]
  in (rlo,rhi,clo,chi)

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  lines <- replicateM n getLine
  let arr = listArray ((1,1),(n,m)) (concat lines)
  let (rlo,rhi,clo,chi) = solve arr
  forM_ [rlo..rhi] $ \r -> do
    let s = [ arr ! (r,c) | c <- [clo..chi] ]
    putStrLn s

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad

import Data.IORef
import System.IO.Unsafe

class Read' a where
  read' :: String -> a

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

cut a b = drop a . take (b+1)

main = do n <- cin :: IO Int
          m <- cin :: IO Int
          css <- replicateM n cin :: IO [String]
          let painted x y = css!!y!!x == '*'
              colCheck x = any (painted x) [0..n-1]
              rowCheck y = any (`painted` y) [0..m-1]
              get f xs = head $ filter f xs
              left   = get colCheck [0..]
              right  = get colCheck $ reverse [0..m-1]
              top    = get rowCheck [0..]
              bottom = get rowCheck $ reverse [0..n-1]
          mapM_ putStrLn . map (cut left right) $ cut top bottom css

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad

import Data.IORef
import System.IO.Unsafe

class Read' a where
  read' :: String -> a

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

cut a b = drop a . take b

main = do n <- cin :: IO Int
          m <- cin :: IO Int
          css <- replicateM n cin :: IO [String]
          let f x y = css!!y!!x == '*'
              s = subtract
              left = until (\x -> any (f x) [0..n-1]) (+1) 0
              right = until (\x -> any (f x) [0..n-1]) (s 1) (m-1)
              top = until (\y -> any (`f` y) [0..m-1]) (+1) 0
              bottom = until (\y -> any (`f` y) [0..m-1]) (s 1) (n-1)
              css' = cut top (bottom+1) css
          mapM_ putStrLn $ map (cut left (right+1)) css'

main = do
	a <-getLine
	c <-getContents
	putStrLn $ unlines $ solve (lines c)

cutterH [] = []
cutterH (s:ss) = if not ('*' `elem` s) then cutter ss
	            else s:ss

cutterT [] = []
cutterT (k) = if not ('*' `elem` s) then cutter ss
	            else k
	            where s = last k
	                  ss = init k

cutter s = cutterT $ cutterH s

transpose::[String]->[String]
transpose s | null (head s) = []
transpose s = [map head s] ++ (transpose (map tail s))

solve s = transpose res2
	  where res1 = cutter s
	        res2 = cutter $transpose res1

import List

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

dropNoStart [] = []
dropNoStart (x:xs) | elem '*' x = x:xs
                   | True       = dropNoStart xs

main = do
    s <- getLine
    let n:m:_ = un s
    l <- getLines n
    let l1 = dropNoStart l
        l2 = reverse $ dropNoStart $ reverse l1
        l3 = dropNoStart $ transpose l2
        l4 = reverse $ dropNoStart $ reverse l3
        l5 = transpose l4
    mapM_ putStrLn $ l5

import Array (Array, (!), array, bounds)
import Monad (liftM)

findBounds :: Array (Int, Int) Char -> ((Int, Int), (Int, Int))
findBounds array  =  ((minI, minJ), (maxI, maxJ))
  where
    ((i0, j0), (iN, jN))  =  bounds array
    rows  =  [i | i <- [i0 .. iN], any (== '*') [array ! (i, j) | j <- [j0 .. jN]]]
    cols  =  [j | j <- [j0 .. jN], any (== '*') [array ! (i, j) | i <- [i0 .. iN]]]
    (minI, maxI)  =  (minimum rows, maximum rows)
    (minJ, maxJ)  =  (minimum cols, maximum cols)

main :: IO ()
main  =  do
    [n, m]  <-  liftM (map read . words) getLine
    lines'  <-  liftM (take n . lines) getContents
    let array'  =  array ((1,1), (n,m)) [((i,j), lines' !! (i-1) !! (j-1)) | i <- [1..n], j <- [1..m]]
    let ((minI, minJ), (maxI, maxJ))  =  findBounds array'
    mapM_ (\i -> putStrLn [array' ! (i, j) | j <- [minJ .. maxJ]]) [minI .. maxI]

import List
import Control.Monad
import Control.Applicative

solve = twice (map reverse.cut) . twice (reverse.dropWhile (all (=='.')))
        where twice f = (f.f)
              cut rows | all ((=='.').head) rows = cut $ map tail rows
                       | otherwise = rows

main = do
    [n, _] <- map read . words <$> getLine
    (replicateM n getLine) >>= (mapM_ putStrLn . solve)

import List
import Control.Monad
import Control.Applicative

solve = twice (rev1.cut1) . twice (rev2.cut2)
    where twice f = (f.f)
          rev1 = map reverse
          cut1 rows | all ((=='.').head) rows = cut1 $ map tail rows
                    | otherwise = rows
          rev2 = reverse
          cut2 rows | all (=='.') $ head rows = cut2 $ tail rows
                    | otherwise = rows

main = do
    [n, m] <- map read . words <$> getLine
    rows <- replicateM n getLine
    mapM_ putStrLn $ solve rows

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

dots x = all (=='.') x

main = do
		[n,m]<- map read <$> words <$>getLine ::IO [Int]
		x<-replicateM n getLine::IO [String]
		let y=transpose $ reverse $ dropWhile (dots) $ reverse $ dropWhile (dots) $ transpose $ reverse  $ dropWhile (dots) $ reverse $ dropWhile (dots) x
		mapM_ putStrLn y

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

findLeft x = length. takeWhile (== '.') $ x

main :: IO ()
main = do
	line <- getLine
	let
		[m, n] = map (\x -> read x :: Int). words$ line
	arr' <- getContents
	let
		arr = lines arr'
		tarr = transpose arr
		left =  minimum. map findLeft $ arr
		top  = minimum. map findLeft $ tarr
		right = n - (minimum. map findLeft. map reverse $arr)
		bot =  m -  (minimum. map findLeft. map reverse $ tarr)
--	mapM_ print arr
--	putStrLn ""
--	mapM_ print tarr
--	putStrLn ""
--	putStrLn $ "left  = " ++ show left
--	putStrLn $ "top   = " ++ show top
--	putStrLn $ "right = " ++ show right
--	putStrLn $ "bot   = " ++ show bot
--	putStrLn ""
	mapM_ putStrLn. map (drop left). map (take right). drop top. take bot $ arr

main = do
	a <-getLine
	c <-getContents
	putStrLn $ unlines $ solve (lines c)

cutter [] = []
cutter (s:ss) = if not ('*' `elem` s) then cutter ss
	            else [s]++cutter ss

transpose::[String]->[String]
transpose s | null (head s) = []
transpose s = [map head s] ++ (transpose (map tail s))

solve s = transpose res2
	  where res1 = cutter s
	        res2 = cutter $transpose res1

import List
import Control.Monad
import Control.Applicative

solve rows = (reverseCols.cutCols.reverseCols.cutCols.filter notEmpty) rows
    where reverseCols = map reverse
          cutCols rows | all ((=='.').head) rows = cutCols $ map tail rows
                       | otherwise = rows
          notEmpty = any (=='*')

main = do
    [n, m] <- map read . words <$> getLine
    rows <- replicateM n getLine
    mapM_ putStrLn $ solve rows

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

findLeft x = length. takeWhile (== '.') $ x

main :: IO ()
main = do
	line <- getLine
	let
		[m, n] = map (\x -> read x :: Int). words$ line
	arr' <- getContents
	let
		arr = lines arr'
		tarr = transpose arr
		left =  minimum. map findLeft $ arr
		top  = minimum. map findLeft $ tarr
		right = n - (minimum. map findLeft. map reverse $arr)
		bot =  m -  (minimum. map findLeft. map reverse $ tarr)
--	mapM_ print arr
--	putStrLn ""
--	mapM_ print tarr
--	putStrLn ""
--	putStrLn $ "left  = " ++ show left
--	putStrLn $ "top   = " ++ show top
--	putStrLn $ "right = " ++ show right
--	putStrLn $ "bot   = " ++ show bot
--	putStrLn ""
	mapM_ print. map (drop left). map (take right). drop top. take bot $ arr


canDistribute :: Int -> Int -> Int -> Int -> Bool
canDistribute a b c n =
    let s = a + b + c + n
        third = s `div` 3
    in s `mod` 3 == 0 && third >= (maximum [a, b, c])

solve :: String -> String
solve line =
    let tokens = words line
        a = read (tokens !! 0) :: Int
        b = read (tokens !! 1) :: Int
        c = read (tokens !! 2) :: Int
        n = read (tokens !! 3) :: Int
        valid = canDistribute a b c n
    in if valid then "YES" else "NO"

solveAll :: String -> String
solveAll input =
    let tests = tail . lines $ input
        answers = map solve tests
    in unlines answers

main = interact solveAll

module Main where

import Control.Monad
import Data.List

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b, c, d] <- getIntList
        putStrLn $ solve a b c d

solve :: Int -> Int -> Int -> Int -> String
solve a b c d =
    let r = 3 * maximum [a, b, c] - sum [a, b, c] in
    if and [d >= r, mod (d - r) 3 == 0] then "YES" else "NO"

import Control.Monad

-- A + B + C = 3k = n + a + b + c
solve :: [Integer] -> String
solve xs
    | listSum `mod` 3 /= 0 = "NO"
    | a < 0                = "NO"
    | otherwise            = "YES"
    where listSum = sum xs
          a       = (listSum `div` 3) - maximum (take 3 xs)

main :: IO ()
main = do
    input <- getContents
    putStrLn . unlines . map (solve . map read . words) . tail . lines $ input

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

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

main = interact solve

solve :: String -> String
solve input = joinedansert
  where
      asnumbers :: [Int64]
      asnumbers = map read $ words input
      n:others = asnumbers
      byfour = splitbyfour others
      solved :: [String]
      solved = map solve' byfour
      joinedansert = intercalate "\n" solved

splitbyfour :: [Int64] -> [(Int64, Int64, Int64, Int64)]
splitbyfour [] = []
splitbyfour (a:b:c:d:xs) = (a, b, c, d):(splitbyfour xs)

solve' :: (Int64, Int64, Int64, Int64) -> String
solve' (a, b, c, n) -- = show a
    | required > n = "NO"
    | extra `mod` 3 == 0 = "YES"
    | otherwise = "NO"
     where
        maxNum :: Int64
        maxNum = maximum (a:b:c:[])
        required = (maxNum - a) + (maxNum - b) + (maxNum - c)
        extra = n - required

import Control.Monad
import Data.Int
import Data.Sequence as DSeq
import Data.Foldable

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

get :: Read a => IO a
get = liftM read getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

main :: IO ()
main = do
    t <- get :: IO Int
    replicateM_ t f1

f1 :: IO ()
f1 = do
    a <- get :: IO Int64
    b <- get :: IO Int64
    c <- get :: IO Int64
    n <- get :: IO Int64
    putStrLn $ if f2 a b c n then "YES" else "NO"

f2 :: Int64 -> Int64 -> Int64 -> Int64 -> Bool
f2 a b c n = (mod (a + b + c + n) 3) == 0 && (
    let v = (div (a + b + c + n) 3) in
        v - a >= 0 && v - b >= 0 && v - c >= 0
    )

import Control.Monad
import Data.Int

getToken :: IO String
getToken = do
    x <- getChar
    if x == ' ' || x == '\t' || x == '\n'
        then return [x]
        else liftM2 (:) (return x) getToken

get :: Read a => IO a
get = liftM read getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

main :: IO ()
main = do
    t <- get :: IO Int
    replicateM_ t f1

f1 :: IO ()
f1 = do
    a <- get :: IO Int64
    b <- get :: IO Int64
    c <- get :: IO Int64
    n <- get :: IO Int64
    putStrLn $ if f2 a b c n then "YES" else "NO"

f2 :: Int64 -> Int64 -> Int64 -> Int64 -> Bool
f2 a b c n = (mod (a + b + c + n) 3) == 0 && (
    let v = (div (a + b + c + n) 3) in
        v - a >= 0 && v - b >= 0 && v - c >= 0
    )

import System.IO

readInt :: IO Int
readInt = readLn

castToInt x = read x::Int

main = do
    t <- readInt
    solve t

sum2 test_case = sum test_case `div` 3

solve t = do
    if t == 0 then
        return ()
    else do
        line <- getLine
        let test_case = (map castToInt . take 4 . words) line
        let x = sum2 test_case
        if sum test_case `mod` 3 /= 0 || test_case!!0 > x || test_case!!1 > x || test_case!!2 > x then
            putStrLn "NO"
        else
            putStrLn "YES"
        solve (t-1)

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

process [a,b,c,n] |mod s 3==0 && maximum [a,b,c]<=div s 3 = "YES"
		  |otherwise = "NO"
	where s= a+b+c+n

main = do
		n<- read <$> getLine :: IO Int
		x<- map(map read) <$> map words <$> replicateM n getLine::IO [[Integer]]
		mapM_ putStrLn $ map process x

import Data.List as L

solve' :: Int -> Int -> Int -> Int -> Bool
solve' a b c n = isEnough && (mod remain 3 == 0)
  where toGiveToA = c - a
        toGiveToB = c - b
        isEnough = n >= toGiveToA + toGiveToB
        remain = n - toGiveToA - toGiveToB

solve :: Int -> Int -> Int -> Int -> String
solve a b c n = if solve' a' b' c' n then "YES" else "NO"
  where [a', b', c'] = L.sort [a, b, c]

parse :: String -> String
parse input = solve a b c n
  where [a, b, c, n] = map (\x -> read x :: Int) $ words input

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

canDistribute :: Int -> Int -> Int -> Int -> Bool
canDistribute a b c n =
    let s = a + b + c + n
        third = s `div` 3
    in s `mod` 3 == 0 && third > (maximum [a, b, c])

solve :: String -> String
solve line =
    let tokens = words line
        a = read (tokens !! 0) :: Int
        b = read (tokens !! 1) :: Int
        c = read (tokens !! 2) :: Int
        n = read (tokens !! 3) :: Int
        valid = canDistribute a b c n
    in if valid then "YES" else "NO"

solveAll :: String -> String
solveAll input =
    let tests = tail . lines $ input
        answers = map solve tests
    in unlines answers

main = interact solveAll

import Control.Monad

-- A + B + C = 3k = n + a + b + c
solve :: [Integer] -> String
solve xs
    | 3 * k == listSum && k >= min = "YES"
    | otherwise                        = "NO"
    where listSum = sum xs
          k       = listSum `div` 3
          min     = minimum xs
solve _ = []

main :: IO ()
main = do
    input <- getContents
    putStrLn . unlines . map (solve . map read . words) . tail . lines $ input

import Control.Monad
import Data.Int

getToken :: IO String
getToken = do
    x <- getChar
    if x == ' ' || x == '\t' || x == '\n'
        then return [x]
        else liftM2 (\x y -> x : y) (return x) getToken

get :: Read a => IO a
get = liftM read getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

main :: IO ()
main = do
    n <- get :: IO Int64
    m <- get :: IO Int64
    a <- get :: IO Int64
    putln $ f1 n m a

f1 :: Int64 -> Int64 -> Int64 -> Int64
f1 n m a = ((div (n + a - 1) a) * (div (m + a - 1) a))

import Control.Monad
import Data.Int

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if null s then
                aux s
            else
                return s
        else
            aux $ x : s
    in aux []

get :: Read a => IO a
get = liftM read getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

main :: IO ()
main = do
    t <- get :: IO Int
    replicateM_ t f1

f1 :: IO ()
f1 = do
    a <- get :: IO Int64
    b <- get :: IO Int64
    c <- get :: IO Int64
    n <- get :: IO Int64
    putStrLn $ if f2 a b c n then "YES" else "NO"

f2 :: Int64 -> Int64 -> Int64 -> Int64 -> Bool
f2 a b c n = (mod (a + b + c + n) 3) == 0 && (
    let v = (div (a + b + c + n) 3) in
        v - a >= 0 && v - b >= 0 && v - c >= 0
    )


main = interact $ drop 1 . dropWhile (/= '\n')

module Main where

import Control.Monad
import Data.List

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

main :: IO ()
main = do
    getLine
    interact id

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

main = do
		n<- read <$> getLine ::IO Int
		k<-map read <$> replicateM n getLine ::IO [Int]
		mapM_ print k

process :: Int -> Int
process = id

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    print $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

process :: Int -> Int
process n
    | n == 1 = 1
    | otherwise = 2

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    print $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t