import Control.Applicative
import Control.Monad
import Control.Applicative
import Control.Monad
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.IO
import Data.IORef

solve :: Int -> Int -> UArray Int Char -> UArray Int Char -> IO String
solve n need s1 s2 = do
    str <- newArray (0,n-1) 'a' :: IO (IOUArray Int Char)
    rest1 <- newIORef need
    rest2 <- newIORef need
    forM [0..n-1] $ \i -> do
        r <- readIORef rest1
        when (s1 ! i == s2 ! i) $ do
            if r > 0
                then do
                    writeArray str i (s1 ! i)
                    writeIORef rest1 (r-1)
                    writeIORef rest2 (r-1)
                else writeArray str i $ fromMaybe 'a' $ find (\x -> x /= s1 ! i && x /= s2 ! i) "abc"
    forM [0..n-1] $ \i -> do
        r1 <- readIORef rest1
        r2 <- readIORef rest2
        let x = s1 ! i
        let y = s2 ! i
        when (x /= y) $ do
            if r2 == 0
                then writeArray str i (fromMaybe 'a' $ find (\z -> z /= x && z /= y) "abc")
                else if r1 < r2
                    then do
                        writeArray str i y
                        writeIORef rest2 (r2-1)
                    else do
                        writeArray str i x
                        writeIORef rest1 (r1-1)
    readIORef rest2 >>= \x ->
        if x > 0
            then return "-1"
            else getElems str

main :: IO ()
main = do
    [n,t] <- map read . words <$> getLine
    s1 <- listArray (0,n-1) <$> getLine
    s2 <- listArray (0,n-1) <$> getLine
    putStrLn =<< solve n (n-t) s1 s2

import Data.Maybe (fromMaybe)

solve [n, t, s1, s2] = solve' (read n) (read t) (zip s1 s2)

solve' :: Int -> Int -> [(Char, Char)] -> Maybe String
solve' _ t s12
  | d > 2*t = Nothing
  | d > t = Just $ go (d-t, d-t, 2*t-d, 0) s12
  | otherwise = Just $ go (0, 0, d, t-d) s12
  where d = length . filter (uncurry (/=)) $ s12
        go _ [] = []
        go (a, b, c, d) ((x, y) : zs)
          | a > 0 && x /= y = x : go (a-1, b, c, d) zs
          | b > 0 && x /= y = y : go (a, b-1, c, d) zs
          | c > 0 && x /= y = other x y : go (a, b, c-1, d) zs
          | d > 0 && x == y = next x : go (a, b, c, d-1) zs
          | otherwise = x : go (a, b, c, d) zs

other x y = head . filter (\c -> c /= x && c /= y) $ ['a' .. ]

next 'z' = 'a'
next c = succ c

main = interact $ fromMaybe "-1" . solve . words

import Control.Monad
import System.IO
import Data.Int
import Data.Char
import Data.Maybe
import Data.Ix
import Data.List
import GHC.Exts
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Vector as Vector

readInt = read :: String -> Int
infixl 5 |>
a |> f = f a

infixl 5 ||>
m ||> f = liftM f m

readLines :: Int -> IO [String]
readLines 0 = return []
readLines n = do
	l1 <- getLine
	lns <- readLines (n - 1)
	return $ l1 : lns

toLong :: Int -> Int64
toLong = fromIntegral

other c1 c2 = find (\c -> c /= c1 && c /= c2) ['a' .. 'c'] |> fromMaybe undefined

get_ans [] _ _ _ _ = ""
get_ans (c1 : t1) (c2 : t2) mb ms1 ms2
	| c1 == c2 && mb > 0		= c1 : get_ans t1 t2 (mb - 1) ms1 ms2
	| c1 == c2					= (other c1 c2) : get_ans t1 t2 mb ms1 ms2
	| ms1 > 0 					= c1 : get_ans t1 t2 mb (ms1 - 1) ms2
	| ms2 > 0					= c2 : get_ans t1 t2 mb ms1 (ms2 - 1)
	| otherwise					= other c1 c2 : get_ans t1 t2 mb ms1 ms2

main = do
	n : should_differ : [] <- getLine ||> words ||> map readInt
	s1 <- getLine
	s2 <- getLine

	should_match <- return $ n - should_differ

	matching <- return $ zip s1 s2 |> filter (uncurry (==)) |> length

	should_match_in_both <- return $ find (\m -> m <= should_match && 2 * (should_match - m) <= (n - matching)) [0 .. matching]

	case should_match_in_both of
		Nothing -> putStrLn "-1"
		Just x  -> do
					res <- return $ get_ans s1 s2 x (should_match - x) (should_match - x)
					putStr $ res

--l1は対応するで同じにするもの l2はs2で違うのにする
answer l1 l2 [] [] = []
answer l1 l2 (a1:n1) (a2:n2) | a1 == a2 = if l2 == 0 then a1:(answer l1 l2 n1 n2) else (getDif a1 a2):(answer l1 (l2-1) n1 n2)
                             | otherwise = if l1 == 0 then (getDif a1 a2):(answer l1 l2 n1 n2) else if l1 `rem` 2 == 0 then a1:(answer (l1-1) l2 n1 n2) else a2:(answer (l1-1) l2 n1 n2)
getDif a b | b < a = getDif b a
           | a == b = if a == 'a' then 'b' else pred a
           | succ a == b = if a == 'a' then succ b else pred a
           | otherwise = succ a
main = do
  w0 <- getLine
  let [n,t] = [read n::Int|n<-(words w0)]
  s1 <- getLine
  s2 <- getLine
  let n0=length $ filter (\x ->(fst x)/=(snd x)) $ zip s1 s2
  let n1=n-n0
  let minN = if n0 `rem` 2 == 0 then n0 `div` 2 else (n0 + 1) `div` 2
  if t < minN
  then putStrLn "-1"
  else if t <= n0 then putStrLn $ answer (2*(n0-t)) 0 s1 s2 else putStrLn $ answer 0 (t-n0) s1 s2

import Data.Maybe (fromMaybe)

solve [n, t, s1, s2] = solve' (read n) (read t) (zip s1 s2)

solve' :: Int -> Int -> [(Char, Char)] -> Maybe String
solve' n t s12
  | d >= 2*t = Nothing
  | d > t = Just $ go (d-t, d-t, 2*t-d, 0) s12
  | otherwise = Just $ go (0, 0, d, t-d) s12
  where d = length . filter (uncurry (/=)) $ s12
        go _ [] = []
        go (a, b, c, d) ((x, y) : zs)
          | a > 0 && x /= y = x : go (a-1, b, c, d) zs
          | b > 0 && x /= y = y : go (a, b-1, c, d) zs
          | c > 0 && x /= y = other x y : go (a, b, c-1, d) zs
          | d > 0 && x == y = next x : go (a, b, c, d-1) zs
          | otherwise = x : go (a, b, c, d) zs

other x y = head . filter (\c -> c /= x && c /= y) $ ['a' .. ]

next 'z' = 'a'
next c = succ c

main = interact $ fromMaybe "-1" . solve . words

import Control.Applicative
import Control.Monad
import Control.Applicative
import Control.Monad
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.IO
import Data.IORef

solve :: Int -> Int -> UArray Int Char -> UArray Int Char -> IO String
solve n need s1 s2 = do
    str <- newArray (0,n-1) 'a' :: IO (IOUArray Int Char)
    rest1 <- newIORef need
    rest2 <- newIORef need
    forM [0..n-1] $ \i -> do
        r <- readIORef rest1
        when (s1 ! i == s2 ! i && r > 0) $ do
            writeArray str i (s1 ! i)
            writeIORef rest1 (r-1)
            writeIORef rest2 (r-1)
    forM [0..n-1] $ \i -> do
        r1 <- readIORef rest1
        r2 <- readIORef rest2
        let x = s1 ! i
        let y = s2 ! i
        when (x /= y) $ do
            if r2 == 0
                then writeArray str i (fromMaybe 'a' $ find (\z -> z /= x && z /= y) "abc")
                else if r1 < r2
                    then do
                        writeArray str i y
                        writeIORef rest2 (r2-1)
                    else do
                        writeArray str i x
                        writeIORef rest1 (r1-1)
    readIORef rest2 >>= \x ->
        if x > 0
            then return "-1"
            else getElems str

main :: IO ()
main = do
    [n,t] <- map read . words <$> getLine
    s1 <- listArray (0,n-1) <$> getLine
    s2 <- listArray (0,n-1) <$> getLine
    putStrLn =<< solve n (n-t) s1 s2

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

solve :: Int -> Int -> String -> String -> Int -> Maybe String
solve c1 c2 [] [] need
    | c1 == need && c2 == need = Just []
    | otherwise = Nothing
solve c1 c2 (x:xs) (y:ys) need
    | c1 == need && c2 == need = fmap ((fromMaybe 'a' $ find (\z -> z /= x && z /= y) ['a'..'z']) :) $ solve c1 c2 xs ys need
    | x == y = fmap (x :) $ solve (c1+1) (c2+1) xs ys need
    | c1 == c2 = fmap (x :) $ solve (c1+1) c2 xs ys need
    | c1 > c2 = fmap (y :) $ solve c1 (c2+1) xs ys need

main :: IO ()
main = do
    [n,t] <- map read . words <$> getLine
    s1 <- getLine
    s2 <- getLine
    case solve 0 0 s1 s2 (n-t) of
        Just xs -> putStrLn xs
        Nothing -> print (-1)

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

solve :: Int -> Int -> String -> String -> Int -> Maybe String
solve c1 c2 [] [] need
    | c1 == need && c2 == need = Just []
    | otherwise = Nothing
solve c1 c2 (x:xs) (y:ys) need
    | c2 == need || c1 == need && x == y = fmap ((fromMaybe 'a' $ find (\z -> z /= x && z /= y) ['a'..'z']) :) $ solve c1 c2 xs ys need
    | x == y = fmap (x :) $ solve (c1+1) (c2+1) xs ys need
    | c1 == c2 = fmap (x :) $ solve (c1+1) c2 xs ys need
    | c1 > c2 = fmap (y :) $ solve c1 (c2+1) xs ys need

main :: IO ()
main = do
    [n,t] <- map read . words <$> getLine
    s1 <- getLine
    s2 <- getLine
    case solve 0 0 s1 s2 (n-t) of
        Just xs -> putStrLn xs
        Nothing -> print (-1)


{-# LANGUAGE TypeApplications #-}

module Main where

import           Data.List
import           Data.Char
import           Data.Functor
import           Control.Monad
import           Data.Function
import           Control.Monad.State

data Answer = YES | NO deriving Show

pickUp :: String -> State [Char] Answer
pickUp [      ] = return YES
pickUp (c : cs) = do
  keys <- get
  if        isLower c
  then      put (c : keys) >> pickUp cs
  else if   toLower c `elem` keys
  then      put (delete c keys) >> pickUp cs
  else      return NO

main :: IO ()
main =
  getLine <&> read @Int
  >>=
  flip replicateM getLine
  >>=
  mapM_ (\s -> print $ evalState (pickUp s) [])

import Control.Monad.State (State, evalState, replicateM, state)
import Data.Bifunctor (first)
import Data.Char (isDigit)
import Data.List (elemIndex)

ok :: [Char] -> [Char]
ok s =
  if and [elemIndex p s <= elemIndex q s | (p, q) <- [('r', 'R'), ('g', 'G'), ('b', 'B')]]
    then "YES\n"
    else "No\n"

getInt :: State [Char] Int
getInt = state func
  where
    func s = first (\x -> read x :: Int) $ span isDigit s

getNext :: State [Char] [Char]
getNext = state func
  where
    func s = first ok $ span (/= '\n') (tail s)

mainFunc :: State [Char] [[Char]]
mainFunc = do
  n <- getInt
  replicateM n getNext

-- replicateM n f = loop n
--   where loop c
--     | c <=0 = pure []
--     | otherwise = (:) <$> f <*> (loop (c-1))

main :: IO ()
main = do
  inp <- getContents
  putStr $ concat $ evalState mainFunc inp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

type SP = State P.ByteString
type S = StateT P.ByteString

cmp a b = if a < b then 1 else 0

solve :: SP Builder
solve = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    s <- getNext
    let ok a b = P.elemIndex a s <= P.elemIndex b s
    let good = ok 'r' 'R' && ok 'g' 'G' && ok 'b' 'B'
    pure $ string7 $ if good then "YES\n" else "NO\n"

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 solve inp
  P.putStr $ toLazyByteString outp

import Control.Monad (forM_)
import Data.Map (fromList, (!))

solve :: [Char] -> Bool
solve arr = m ! 'r' < m ! 'R' && m ! 'g' < m ! 'G' && m ! 'b' < m ! 'B'
  where
    m = fromList $ zip arr [1 ..]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        putStrLn $ if solve l then "YES" else "NO"

import Data.Char (toUpper)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = String
type OutType = Bool

isKey :: Char -> Bool
isKey c = c `elem` "rgb"

solve :: InType -> OutType
solve = go (const False)
  where go :: (Char -> Bool) -> InType -> Bool
        go f [] = True
        go f (c : cs) = if isKey c then go (\z -> f z || z == toUpper c) cs
                        else f c && go f cs

receive :: [String] -> InType
receive [s] = s
receive _   = error "invalid input"

main :: IO ()
main = interact $ unlines . map (showb . solve . receive) . chunksOf 1 . tail . lines
  where showb True  = "YES"
        showb False = "NO"

import Control.Monad
import Data.Function
import Data.List
import Data.Maybe

solve :: IO ()
solve = do
    s <- getLine
    putStrLn $ if and (zipWith ((<) `on` fromJust . flip elemIndex s) "rgb" "RGB")
        then "YES" else "NO"

main :: IO ()
main = flip replicateM_ solve =<< readLn

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    s <- getNext
    let  ok p q = P.elemIndex p s <= P.elemIndex q s
    pure $ if  ok 'r' 'R' && ok 'g' 'G' && ok 'b' 'B'
      then  string7 "YES\n"
      else  string7 "NO\n"

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


-- Third test: small-to-large with binomial-coefficient-shenanigans

{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import GHC.Exts
import GHC.Integer.GMP.Internals
import GHC.IO
import GHC.ST

import Data.Bits
import Data.Semigroup

-- The main idea of this solution is to use Integer multiplication to
-- perform the necessary convolutions. Since that doesn't rely on any
-- number theory tricks, it works nicely with any modulus, and not just
-- the classic FFT-friendly prime 998244353 = 1 + 7 * 17 * 2^23.

mainFun :: SP Builder
mainFun = do
  n <- getInt
  inc <- replicateM (2 * n - 2) getInt
  let
    facts :: UArray Int Int
    facts = listArray (0, n) $ scanl' (*!) 1 [1 .. n]
    ifacts :: UArray Int Int
    ifacts = array (0, n) $ take (n + 1)
      $ iterate (\(i, v) -> (i - 1, v *! i)) (n, inv (facts ! n))
    choose :: Int -> Int -> Int
    choose x k = facts ! x *! ifacts ! k *! ifacts ! (x - k)

    nChildren :: UArray Int Int
    nChildren = accumArray (+) (negate 1) (1, n) $ (1, 1) : zip inc (repeat 1)
    nOccs :: UArray Int Int
    nOccs = accumArray (+) 0 (0, n) $ zip (elems nChildren) (repeat 1)

    initSet :: PQ Integer
    initSet = foldl' (\s v -> s `unite` singleton v) Nil $ do
      (ix, k) <- assocs nOccs
      guard $ ix > 0 && k > 0
      let  ways w i = if  i <= k
             then  fromIntegral (w *! choose k i) : ways (w *! ix) (i + 1)
             else  []
      pure $ makeInteger (k + 1) (ways 1 0)

    convolve :: PQ Integer -> [Int]
    convolve s = case  pop s  of
      Just (x, s') -> case  pop s'  of
        Just (y, s'') -> convolve $ push (updateFields remP2 $ x * y) s''
        Nothing -> map fromIntegral $ snd $ toWordList x
      Nothing -> []

    optsBySize = convolve initSet
    weights = zipWith (*!) (reverse $ elems facts) (cycle [1, p-1])
    ans = foldl' (+!) 0 $ zipWith (*!) weights optsBySize
  pure $ putInts [ans]

-------------------------------------------------------------------------------
-- Integer internals manipulation
-------------------------------------------------------------------------------

makeInteger :: Int -> [Word] -> Integer
-- Interprets a list of Words as a little-endian base-(2^128) Integer.
-- Uses internal ByteArray# interface to do it quickly, because sadly
-- 'GHC.Num.Integer.integerFromWordList' doesn't exist yet in 8.10.1.
{-# INLINE [1] makeInteger #-}
{-# ANN makeInteger "HLint: ignore Redundant lambda" #-}
-- 'step' is applied to only two arguments if this fuses
makeInteger (I# n) li = runST $ ST $ \(s0 :: State# s) -> let
  numBytes = iShiftL# n 4#
  (# s1, marr #) = newByteArray# numBytes s0
  s2 = setByteArray# marr 0# numBytes 0# s1
  step :: Word -> (Int# -> State# s -> State# s)
               ->  Int# -> State# s -> State# s
  step (W# val) cont = \off s3
    -> cont (off +# 2#) (writeWord64Array# marr off val s3)
  s4 = foldr step (\_ s -> s) li 0# s2
  (# s5, arr #) = unsafeFreezeByteArray# marr s4
  in  (# s5, importIntegerFromByteArray arr 0## (int2Word# numBytes) 0# #)

integerToMutableByteArray
  :: Integer -> State# RealWorld
  -> (# State# RealWorld, MutableByteArray# RealWorld, Int# #)
integerToMutableByteArray val s0 = let
  numInputBytes = sizeInBaseInteger val 256#
  numFields = iShiftRL# (word2Int# numInputBytes +# 15#) 4#
  bufferSize = iShiftL# numFields 4#
  (# s1, arr #) = newByteArray# bufferSize s0
  s2 = setByteArray# arr (bufferSize -# 16#) 16# 0# s1
  (# s3, _ #) = unIO (exportIntegerToMutableByteArray val arr 0## 0#) s2
  in  (# s3, arr, numFields #)

toWordList :: Integer -> (Int, [Word])
toWordList val = let
  (# n, arr #) = runRW# $ \s0 -> let
    (# s1, marr, numFields #) = integerToMutableByteArray val s0
    (# _, farr #) = unsafeFreezeByteArray# marr s1
    in  (# numFields, farr #)
  stopOff = iShiftL# n 1#
  in  (,) (I# n) $ build $ \cons nil -> let
  go off = if  isTrue# (off <# stopOff)
    then  W# (indexWord64Array# arr off) `cons` go (off +# 2#)
    else  nil
  in  go 0#

updateFields
  :: (Word# -> Word# -> (# Word#, Word# #)) -> Integer -> Integer
-- If the Integer is understood as an array of Word128s, this uses
-- the first argument to update each field. This allows replacing
-- the rather slow 'quotRemWord2#' with something faster...
{-# ANN updateFields "HLint: ignore Redundant lambda" #-}
{-# INLINE updateFields #-} -- It should specialize, given only one arg!
updateFields fun = \x -> runRW# $ \s0 -> let
  (# s1, marr, numFields #) = integerToMutableByteArray x s0
  go off s2 = if  isTrue# (off >=# 0#)
    then  let
    (# s3, hi #) = readWord64Array# marr (off +# 1#) s2
    (# s4, lo #) = readWord64Array# marr off s3
    (# nhi, nlo #) = fun hi lo
    s5 = writeWord64Array# marr (off +# 1#) nhi s4
    s6 = writeWord64Array# marr off nlo s5 -- copy-paste is dangerous...
    in  go (off -# 2#) s6
    else  s2
  s7 = go (iShiftL# (numFields -# 1#) 1#) s1
  (# _s8, arr #) = unsafeFreezeByteArray# marr s7
  numBytes = int2Word# numFields `shiftL#` 4#
  in  importIntegerFromByteArray arr 0## numBytes 0#

-------------------------------------------------------------------------------
-- Modular arithmetic
-------------------------------------------------------------------------------

p :: Int
p = 998244353

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = x + y -! p

(-!) :: Int -> Int -> Int
-- branchless subtraction modulo p
infixl 6 -!
x -! y = let
  raw = x - y
  in  raw + (p .&. shiftR raw 63)

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = let
  I# raw = x * y
  in  I# (word2Int# (remP (int2Word# raw)))

quotP :: Word# -> Word#
quotP v = let
  (# hi, _lo #) = timesWord2# 9920937979283557439## v
    -- the magic number is ceiling(2^(64+29) / p)
    -- The approximation is accurate enough to calculate the exact
    -- quotient with one multiply and one shift for all valid Word#
  in  shiftRL# hi 29#

remP :: Word# -> Word#
remP v = let
  I# p# = p
  in  v `minusWord#` timesWord# (quotP v) (int2Word# p#)

remP2 :: Word# -> Word# -> (# Word#, Word# #)
remP2 hi lo = let
  -- This implementation cheats a bit in order to be a tiny bit
  -- faster. It assumes the high word should be at most 26_401_116_612,
  -- and gives a result in [0..2p-2] instead of [0..p-1].
  I# p# = p
  (# redHi, _ #)
    = int2Word# p# `timesWord2#` timesWord# 17223561541331522433## hi
  in  (# 0##, redHi `plusWord#` remP lo #)

newtype ModP = ModP { unModP :: Int }
instance Semigroup ModP where
  ModP x <> ModP y = ModP (x *! y)
  stimes = stimesMonoid
instance Monoid ModP where
  mempty = ModP 1

inv :: Int -> Int
inv = unModP . stimes (p - 2) . ModP

-------------------------------------------------------------------------------
-- Persistent priority queue
-------------------------------------------------------------------------------

data PQ a = Nil | PQ a !Int !(PQ a) !(PQ a)

size :: PQ a -> Int
size Nil = 0
size (PQ _ sz _ _) = sz

singleton :: a -> PQ a
singleton v = PQ v 1 Nil Nil

push :: Ord a => a -> PQ a -> PQ a
push v q = case  q  of
  Nil -> PQ v 1 Nil Nil
  PQ qv sz ql qr
    | qv < v     -> pq qv (push  v ql) qr
    | otherwise  -> pq  v (push qv ql) qr

pop :: Ord a => PQ a -> Maybe (a, PQ a)
pop Nil = Nothing
pop (PQ v _ s1 s2) = Just (v, unite s1 s2)

pq :: a -> PQ a -> PQ a -> PQ a
pq v o1 o2 = if  size o1 <= size o2
  then  PQ v (size o1 + size o2 + 1) o1 o2
  else  PQ v (size o2 + size o1 + 1) o2 o1

unite :: Ord a => PQ a -> PQ a -> PQ a
unite Nil y = y
unite x Nil = x
unite x@(PQ xv xsz xl xr) y@(PQ yv ysz yl yr) = if  xv <= yv
  then  if  size xr < ysz
        then  pq xv (unite xl xr) y
        else  pq xv (unite xl y) xr
  else  unite y x

-------------------------------------------------------------------------------
-- My normal library/template
-------------------------------------------------------------------------------

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

{-# LANGUAGE MagicHash, UnboxedTuples #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import GHC.Exts
import GHC.Integer.GMP.Internals
import GHC.IO

-- The main idea of this solution is to use Integer multiplication to
-- perform the necessary convolutions. Since that doesn't rely on any
-- number theory tricks, it works nicely with any modulus, and not just
-- the classic FFT-friendly prime 998244353 = 1 + 7 * 17 * 2^23.

makeInteger :: Int -> [Word] -> Integer
-- Interprets a list of Words as a little-endian base-(2^128) Integer.
-- GHC starting at 9.0.1 ships with ghc-bignum, which provides
-- a clean way to do this using GHC.Num.Integer.integerFromWordList,
-- but with 8.10.1 the only O(n) way to get it done is to root around
-- in the Integer internals like some kind of monster.

-- There's also a simple O(n * log n) divide and conquer approach
-- using bitshifts. It's certainly also fast enough, but I wanted
-- the experience of writing this code anyway.
makeInteger (I# n) li = unsafePerformIO $ IO $ \s0 -> let
  numBytes = uncheckedIShiftL# n 4#
  (# s1, arr #) = newByteArray# numBytes s0
  go :: Int# -> [Word] -> State# RealWorld -> State# RealWorld
  go _ [] s = s
  go offset (W# v : vs) s2 = let
    s3 = writeWord64Array# arr offset v s2
    s4 = writeInt64Array#  arr (offset +# 1#) 0# s3
    in  go (offset +# 2#) vs s4
  (# s5, ans #) = unsafeFreezeByteArray# arr (go 0# li s1)
  numLimbs = uncheckedIShiftL# n 1#
  in  (# s5, bigNatToInteger (byteArrayToBigNat# ans numLimbs) #)

integerToMutableByteArray
  :: Integer -> State# RealWorld
  -> (# State# RealWorld, MutableByteArray# RealWorld, Int# #)
integerToMutableByteArray val s0 = let
  numInputBytes = sizeInBaseInteger val 256#
  numFields = 1# +# word2Int# (uncheckedShiftRL# numInputBytes 4#)
  bufferSize = uncheckedIShiftL# numFields 4#
  (# s1, arr #) = newByteArray# bufferSize s0
  -- zero out the last field (uninitialized memory isn't ok)
  lastFieldPos = numFields *# 2# -# 2#
  s2 = writeInt64Array# arr  lastFieldPos        0# s1
  s3 = writeInt64Array# arr (lastFieldPos +# 1#) 0# s2

  (# s4, _ #)
    = unIO (exportIntegerToMutableByteArray val arr (int2Word# 0#) 0#) s3
  in  (# s4, arr, lastFieldPos #)

reduceFields :: Word -> Integer -> Integer
-- If the Integer is understood as an array of Word128s, this reduces
-- all of them modulo the first argument.
-- (Upper words should be smaller than this first argument.)
reduceFields (W# modThis) val = unsafePerformIO $ IO $ \s0 -> let
  (# s1, arr, lastFieldPos #) = integerToMutableByteArray val s0
  go :: Int# -> State# RealWorld -> State# RealWorld
  go offset s2 = if  isTrue# (offset <# 0#)
    then  s2
    else  let
    (# s3, lower #) = readWord64Array# arr  offset        s2
    (# s4, upper #) = readWord64Array# arr (offset +# 1#) s3
    (# _q, r #) = quotRemWord2# upper lower modThis
    s5 = writeWord64Array# arr  offset        r  s4
    s6 = writeInt64Array#  arr (offset +# 1#) 0# s5
    in  go (offset -# 2#) s6
  (# s7, ans #) = unsafeFreezeByteArray# arr (go lastFieldPos s1)
  numLimbs = 2# +# lastFieldPos
  in  (# s7, bigNatToInteger (byteArrayToBigNat# ans numLimbs) #)

toWordList :: Integer -> [Word]
toWordList val = unsafePerformIO $ IO $ \s0 -> let
  (# s1, arrMut, lastFieldPos #) = integerToMutableByteArray val s0
  (# s2, arr #) = unsafeFreezeByteArray# arrMut s1
  go :: Int# -> [Word]
  go offset = if  isTrue# (offset ># lastFieldPos)
    then  []
    else  W# (indexWord64Array# arr offset) : go (offset +# 2#)
  in  (# s2, go 0# #)

p :: Int
p = 998244353

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
x +! y = cv $ x + y

(*!) :: Int -> Int -> Int
x *! y = x * y `rem` p

combine :: [Integer] -> Integer
combine []  = 0
combine [n] = n
combine ns = combine (combine2 ns)

combine2 :: [Integer] -> [Integer]
combine2 (x : y : zs) = reduceFields 998244353 (x * y) : combine2 zs
combine2 li = li

mainFun :: SP Builder
mainFun = do
  ~[n] <- getInts 1
  incs <- getInts $ 2 * (n - 1)
  let
    nChildren :: UArray Int Int
    nChildren = accumArray (+) (0-1) (1, n) $ (1, 1) : zip incs (repeat 1)
    toConvolve = [makeInteger 2 [1, fromIntegral x] | x <- elems nChildren]
    --toConvolve = replicate 250000 $ makeInteger 2 [1, 1]
    waysLi = map fromIntegral $ toWordList $ combine toConvolve
    facts = scanl' (*!) 1 [1..n]
    weights = zipWith (*!) (reverse facts) (cycle [1, p-1])
    ans = foldl' (+!) 0 $ zipWith (*!) waysLi weights
  pure $ putInts [ans]

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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 $ P.words inp
  P.putStr $ toLazyByteString outp

-- Second test: basic top-to-bottom with binomial-coefficient-shenanigans

{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import GHC.Exts
import GHC.Integer.GMP.Internals
import GHC.IO
import GHC.ST

import Data.Bits
import Data.Semigroup

-- The main idea of this solution is to use Integer multiplication to
-- perform the necessary convolutions. Since that doesn't rely on any
-- number theory tricks, it works nicely with any modulus, and not just
-- the classic FFT-friendly prime 998244353 = 1 + 7 * 17 * 2^23.

mainFun :: SP Builder
mainFun = do
  n <- getInt
  inc <- replicateM (2 * n - 2) getInt
  let
    facts :: UArray Int Int
    facts = listArray (0, n) $ scanl' (*!) 1 [1 .. n]
    ifacts :: UArray Int Int
    ifacts = array (0, n) $ take (n + 1)
      $ iterate (\(i, v) -> (i - 1, v *! i)) (n, inv (facts ! n))
    choose :: Int -> Int -> Int
    choose x k = facts ! x *! ifacts ! k *! ifacts ! (x - k)

    nChildren :: UArray Int Int
    nChildren = accumArray (+) (negate 1) (1, n) $ (1, 1) : zip inc (repeat 1)
    nOccs :: UArray Int Int
    nOccs = accumArray (+) 0 (0, n) $ zip (elems nChildren) (repeat 1)

    step :: Integer -> Int -> Integer
    step v ix = case  nOccs ! ix  of
      0 -> v
      k -> let
        ways w i = if  i <= k
          then  fromIntegral (w *! choose k i) : ways (w *! ix) (i + 1)
          else  []
        in  updateFields remP2 $ v * makeInteger (k + 1) (ways 1 0)

    optsBySize = snd $ toWordList $ foldl' step 1 [n, n - 1 .. 1]
    weights = zipWith (*!) (reverse $ elems facts) (cycle [1, p-1])
    ans = foldl' (+!) 0 $ zipWith (*!) weights $ map fromIntegral optsBySize
  pure $ putInts [ans]

-------------------------------------------------------------------------------
-- Integer internals manipulation
-------------------------------------------------------------------------------

makeInteger :: Int -> [Word] -> Integer
-- Interprets a list of Words as a little-endian base-(2^128) Integer.
-- Uses internal ByteArray# interface to do it quickly, because sadly
-- 'GHC.Num.Integer.integerFromWordList' doesn't exist yet in 8.10.1.
{-# INLINE [1] makeInteger #-}
{-# ANN makeInteger "HLint: ignore Redundant lambda" #-}
-- 'step' is applied to only two arguments if this fuses
makeInteger (I# n) li = runST $ ST $ \(s0 :: State# s) -> let
  numBytes = iShiftL# n 4#
  (# s1, marr #) = newByteArray# numBytes s0
  s2 = setByteArray# marr 0# numBytes 0# s1
  step :: Word -> (Int# -> State# s -> State# s)
               ->  Int# -> State# s -> State# s
  step (W# val) cont = \off s3
    -> cont (off +# 2#) (writeWord64Array# marr off val s3)
  s4 = foldr step (\_ s -> s) li 0# s2
  (# s5, arr #) = unsafeFreezeByteArray# marr s4
  in  (# s5, importIntegerFromByteArray arr 0## (int2Word# numBytes) 0# #)

integerToMutableByteArray
  :: Integer -> State# RealWorld
  -> (# State# RealWorld, MutableByteArray# RealWorld, Int# #)
integerToMutableByteArray val s0 = let
  numInputBytes = sizeInBaseInteger val 256#
  numFields = iShiftRL# (word2Int# numInputBytes +# 15#) 4#
  bufferSize = iShiftL# numFields 4#
  (# s1, arr #) = newByteArray# bufferSize s0
  s2 = setByteArray# arr (bufferSize -# 16#) 16# 0# s1
  (# s3, _ #) = unIO (exportIntegerToMutableByteArray val arr 0## 0#) s2
  in  (# s3, arr, numFields #)

toWordList :: Integer -> (Int, [Word])
toWordList val = let
  (# n, arr #) = runRW# $ \s0 -> let
    (# s1, marr, numFields #) = integerToMutableByteArray val s0
    (# _, farr #) = unsafeFreezeByteArray# marr s1
    in  (# numFields, farr #)
  stopOff = iShiftL# n 1#
  in  (,) (I# n) $ build $ \cons nil -> let
  go off = if  isTrue# (off <# stopOff)
    then  W# (indexWord64Array# arr off) `cons` go (off +# 2#)
    else  nil
  in  go 0#

updateFields
  :: (Word# -> Word# -> (# Word#, Word# #)) -> Integer -> Integer
-- If the Integer is understood as an array of Word128s, this uses
-- the first argument to update each field. This allows replacing
-- the rather slow 'quotRemWord2#' with something faster...
{-# ANN updateFields "HLint: ignore Redundant lambda" #-}
{-# INLINE updateFields #-} -- It should specialize, given only one arg!
updateFields fun = \x -> runRW# $ \s0 -> let
  (# s1, marr, numFields #) = integerToMutableByteArray x s0
  go off s2 = if  isTrue# (off >=# 0#)
    then  let
    (# s3, hi #) = readWord64Array# marr (off +# 1#) s2
    (# s4, lo #) = readWord64Array# marr off s3
    (# nhi, nlo #) = fun hi lo
    s5 = writeWord64Array# marr (off +# 1#) nhi s4
    s6 = writeWord64Array# marr off nlo s5 -- copy-paste is dangerous...
    in  go (off -# 2#) s6
    else  s2
  s7 = go (iShiftL# (numFields -# 1#) 1#) s1
  (# _s8, arr #) = unsafeFreezeByteArray# marr s7
  numBytes = int2Word# numFields `shiftL#` 4#
  in  importIntegerFromByteArray arr 0## numBytes 0#

-------------------------------------------------------------------------------
-- Modular arithmetic
-------------------------------------------------------------------------------

p :: Int
p = 998244353

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = x + y -! p

(-!) :: Int -> Int -> Int
-- branchless subtraction modulo p
infixl 6 -!
x -! y = let
  raw = x - y
  in  raw + (p .&. shiftR raw 63)

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = let
  I# raw = x * y
  in  I# (word2Int# (remP (int2Word# raw)))

quotP :: Word# -> Word#
quotP v = let
  (# hi, _lo #) = timesWord2# 9920937979283557439## v
    -- the magic number is ceiling(2^(64+29) / p)
    -- The approximation is accurate enough to calculate the exact
    -- quotient with one multiply and one shift for all valid Word#
  in  shiftRL# hi 29#

remP :: Word# -> Word#
remP v = let
  I# p# = p
  in  v `minusWord#` timesWord# (quotP v) (int2Word# p#)

remP2 :: Word# -> Word# -> (# Word#, Word# #)
remP2 hi lo = let
  -- This implementation cheats a bit in order to be a tiny bit
  -- faster. It assumes the high word should be at most 26_401_116_612,
  -- and gives a result in [0..2p-2] instead of [0..p-1].
  I# p# = p
  (# redHi, _ #)
    = int2Word# p# `timesWord2#` timesWord# 17223561541331522433## hi
  in  (# 0##, redHi `plusWord#` remP lo #)

newtype ModP = ModP { unModP :: Int }
instance Semigroup ModP where
  ModP x <> ModP y = ModP (x *! y)
  stimes = stimesMonoid
instance Monoid ModP where
  mempty = ModP 1

inv :: Int -> Int
inv = unModP . stimes (p - 2) . ModP

-------------------------------------------------------------------------------
-- My normal library/template
-------------------------------------------------------------------------------

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

-- First test: Minimal changes to the combining algorithm,
-- but much faster modular arithmetic.

{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import GHC.Exts
import GHC.Integer.GMP.Internals
import GHC.IO
import GHC.ST

import Data.Bits
import Data.Semigroup

-- The main idea of this solution is to use Integer multiplication to
-- perform the necessary convolutions. Since that doesn't rely on any
-- number theory tricks, it works nicely with any modulus, and not just
-- the classic FFT-friendly prime 998244353 = 1 + 7 * 17 * 2^23.

mainFun :: SP Builder
mainFun = do
  n <- getInt
  incs <- replicateM (2 * (n - 1)) getInt
  let
    nChildren :: UArray Int Int
    nChildren = accumArray (+) (0-1) (1, n) $ (1, 1) : zip incs (repeat 1)
    toConvolve = [makeInteger 2 [1, fromIntegral x] | x <- elems nChildren]
    --toConvolve = replicate 250000 $ makeInteger 2 [1, 1]
    waysLi = map fromIntegral $ snd $ toWordList $ combine toConvolve
    facts = scanl' (*!) 1 [1..n]
    weights = zipWith (*!) (reverse facts) (cycle [1, p-1])
    ans = foldl' (+!) 0 $ zipWith (*!) waysLi weights
  pure $ putInts [ans]

combine :: [Integer] -> Integer
combine []  = 0
combine [n] = n
combine ns = combine (combine2 ns)

combine2 :: [Integer] -> [Integer]
combine2 (x : y : zs) = updateFields remP2 (x * y) : combine2 zs
combine2 li = li

-------------------------------------------------------------------------------
-- Integer internals manipulation
-------------------------------------------------------------------------------

makeInteger :: Int -> [Word] -> Integer
-- Interprets a list of Words as a little-endian base-(2^128) Integer.
-- Uses internal ByteArray# interface to do it quickly, because sadly
-- 'GHC.Num.Integer.integerFromWordList' doesn't exist yet in 8.10.1.
{-# INLINE [1] makeInteger #-}
{-# ANN makeInteger "HLint: ignore Redundant lambda" #-}
-- 'step' is applied to only two arguments if this fuses
makeInteger (I# n) li = runST $ ST $ \(s0 :: State# s) -> let
  numBytes = iShiftL# n 4#
  (# s1, marr #) = newByteArray# numBytes s0
  s2 = setByteArray# marr 0# numBytes 0# s1
  step :: Word -> (Int# -> State# s -> State# s)
               ->  Int# -> State# s -> State# s
  step (W# val) cont = \off s3
    -> cont (off +# 2#) (writeWord64Array# marr off val s3)
  s4 = foldr step (\_ s -> s) li 0# s2
  (# s5, arr #) = unsafeFreezeByteArray# marr s4
  in  (# s5, importIntegerFromByteArray arr 0## (int2Word# numBytes) 0# #)

integerToMutableByteArray
  :: Integer -> State# RealWorld
  -> (# State# RealWorld, MutableByteArray# RealWorld, Int# #)
integerToMutableByteArray val s0 = let
  numInputBytes = sizeInBaseInteger val 256#
  numFields = iShiftRL# (word2Int# numInputBytes +# 15#) 4#
  bufferSize = iShiftL# numFields 4#
  (# s1, arr #) = newByteArray# bufferSize s0
  s2 = setByteArray# arr (bufferSize -# 16#) 16# 0# s1
  (# s3, _ #) = unIO (exportIntegerToMutableByteArray val arr 0## 0#) s2
  in  (# s3, arr, numFields #)

toWordList :: Integer -> (Int, [Word])
toWordList val = let
  (# n, arr #) = runRW# $ \s0 -> let
    (# s1, marr, numFields #) = integerToMutableByteArray val s0
    (# _, farr #) = unsafeFreezeByteArray# marr s1
    in  (# numFields, farr #)
  stopOff = iShiftL# n 1#
  in  (,) (I# n) $ build $ \cons nil -> let
  go off = if  isTrue# (off <# stopOff)
    then  W# (indexWord64Array# arr off) `cons` go (off +# 2#)
    else  nil
  in  go 0#

updateFields
  :: (Word# -> Word# -> (# Word#, Word# #)) -> Integer -> Integer
-- If the Integer is understood as an array of Word128s, this uses
-- the first argument to update each field. This allows replacing
-- the rather slow 'quotRemWord2#' with something faster...
{-# ANN updateFields "HLint: ignore Redundant lambda" #-}
{-# INLINE updateFields #-} -- It should specialize, given only one arg!
updateFields fun = \x -> runRW# $ \s0 -> let
  (# s1, marr, numFields #) = integerToMutableByteArray x s0
  go off s2 = if  isTrue# (off >=# 0#)
    then  let
    (# s3, hi #) = readWord64Array# marr (off +# 1#) s2
    (# s4, lo #) = readWord64Array# marr off s3
    (# nhi, nlo #) = fun hi lo
    s5 = writeWord64Array# marr (off +# 1#) nhi s4
    s6 = writeWord64Array# marr off nlo s5 -- copy-paste is dangerous...
    in  go (off -# 2#) s6
    else  s2
  s7 = go (iShiftL# (numFields -# 1#) 1#) s1
  (# _s8, arr #) = unsafeFreezeByteArray# marr s7
  numBytes = int2Word# numFields `shiftL#` 4#
  in  importIntegerFromByteArray arr 0## numBytes 0#

-------------------------------------------------------------------------------
-- Modular arithmetic
-------------------------------------------------------------------------------

p :: Int
p = 998244353

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = x + y -! p

(-!) :: Int -> Int -> Int
-- branchless subtraction modulo p
infixl 6 -!
x -! y = let
  raw = x - y
  in  raw + (p .&. shiftR raw 63)

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = let
  I# raw = x * y
  in  I# (word2Int# (remP (int2Word# raw)))

quotP :: Word# -> Word#
quotP v = let
  (# hi, _lo #) = timesWord2# 9920937979283557439## v
    -- the magic number is ceiling(2^(64+29) / p)
    -- The approximation is accurate enough to calculate the exact
    -- quotient with one multiply and one shift for all valid Word#
  in  shiftRL# hi 29#

remP :: Word# -> Word#
remP v = let
  I# p# = p
  in  v `minusWord#` timesWord# (quotP v) (int2Word# p#)

remP2 :: Word# -> Word# -> (# Word#, Word# #)
remP2 hi lo = let
  -- This implementation cheats a bit in order to be a tiny bit
  -- faster. It assumes the high word should be at most 26_401_116_612,
  -- and gives a result in [0..2p-2] instead of [0..p-1].
  I# p# = p
  (# redHi, _ #)
    = int2Word# p# `timesWord2#` timesWord# 17223561541331522433## hi
  in  (# 0##, redHi `plusWord#` remP lo #)

newtype ModP = ModP { unModP :: Int }
instance Semigroup ModP where
  ModP x <> ModP y = ModP (x *! y)
  stimes = stimesMonoid
instance Monoid ModP where
  mempty = ModP 1

inv :: Int -> Int
inv = unModP . stimes (p - 2) . ModP

-------------------------------------------------------------------------------
-- My normal library/template
-------------------------------------------------------------------------------

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

-- First test: Minimal changes to the combining algorithm,
-- but much faster modular arithmetic.

{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import GHC.Exts
import GHC.Integer.GMP.Internals
import GHC.IO
import GHC.ST

import Data.Bits
import Data.Semigroup

-- The main idea of this solution is to use Integer multiplication to
-- perform the necessary convolutions. Since that doesn't rely on any
-- number theory tricks, it works nicely with any modulus, and not just
-- the classic FFT-friendly prime 998244353 = 1 + 7 * 17 * 2^23.

mainFun :: SP Builder
mainFun = do
  n <- getInt
  incs <- replicateM (2 * (n - 1)) getInt
  let
    nChildren :: UArray Int Int
    nChildren = accumArray (+) (0-1) (1, n) $ (1, 1) : zip incs (repeat 1)
    toConvolve = [makeInteger 2 [1, fromIntegral x] | x <- elems nChildren]
    --toConvolve = replicate 250000 $ makeInteger 2 [1, 1]
    waysLi = map fromIntegral $ snd $ toWordList $ combine toConvolve
    facts = scanl' (*!) 1 [1..n]
    weights = zipWith (*!) (reverse facts) (cycle [1, p-1])
    ans = foldl' (+!) 0 $ zipWith (*!) waysLi weights
  pure $ putInts [ans]

combine :: [Integer] -> Integer
combine []  = 0
combine [n] = n
combine ns = combine (combine2 ns)

combine2 :: [Integer] -> [Integer]
combine2 (x : y : zs) = updateFields remP2 (x * y) : combine2 zs
combine2 li = li

-------------------------------------------------------------------------------
-- Integer internals manipulation
-------------------------------------------------------------------------------

makeInteger :: Int -> [Word] -> Integer
-- Interprets a list of Words as a little-endian base-(2^128) Integer.
-- Uses internal ByteArray# interface to do it quickly, because sadly
-- 'GHC.Num.Integer.integerFromWordList' doesn't exist yet in 8.10.1.
{-# INLINE [1] makeInteger #-}
{-# ANN makeInteger "HLint: ignore Redundant lambda" #-}
-- 'step' is applied to only two arguments if this fuses
makeInteger (I# n) li = runST $ ST $ \(s0 :: State# s) -> let
  numBytes = iShiftL# n 4#
  (# s1, marr #) = newByteArray# numBytes s0
  s2 = setByteArray# marr 0# numBytes 0# s1
  step :: Word -> (Int# -> State# s -> State# s)
               ->  Int# -> State# s -> State# s
  step (W# val) cont = \off s3
    -> cont (off +# 2#) (writeWord64Array# marr off val s3)
  s4 = foldr step (\_ s -> s) li 0# s2
  (# s5, arr #) = unsafeFreezeByteArray# marr s4
  in  (# s5, importIntegerFromByteArray arr 0## (int2Word# numBytes) 0# #)

integerToMutableByteArray
  :: Integer -> State# RealWorld
  -> (# State# RealWorld, MutableByteArray# RealWorld, Int# #)
integerToMutableByteArray val s0 = let
  numInputBytes = sizeInBaseInteger val 256#
  numFields = iShiftRL# (word2Int# numInputBytes +# 15#) 4#
  bufferSize = iShiftL# numFields 4#
  (# s1, arr #) = newByteArray# bufferSize s0
  s2 = setByteArray# arr (bufferSize -# 16#) 16# 0# s1
  (# s3, _ #) = unIO (exportIntegerToMutableByteArray val arr 0## 0#) s2
  in  (# s3, arr, numFields #)

toWordList :: Integer -> (Int, [Word])
toWordList val = let
  (# n, arr #) = runRW# $ \s0 -> let
    (# s1, marr, numFields #) = integerToMutableByteArray val s0
    (# _, farr #) = unsafeFreezeByteArray# marr s1
    in  (# numFields, farr #)
  stopOff = iShiftL# n 1#
  in  (,) (I# n) $ build $ \cons nil -> let
  go off = if  isTrue# (off <# stopOff)
    then  W# (indexWord64Array# arr off) `cons` go (off +# 2#)
    else  nil
  in  go 0#

updateFields
  :: (Word# -> Word# -> (# Word#, Word# #)) -> Integer -> Integer
-- If the Integer is understood as an array of Word128s, this uses
-- the first argument to update each field. This allows replacing
-- the rather slow 'quotRemWord2#' with something faster...
{-# ANN updateFields "HLint: ignore Redundant lambda" #-}
{-# INLINE updateFields #-} -- It should specialize, given only one arg!
updateFields fun = \x -> runRW# $ \s0 -> let
  (# s1, marr, numFields #) = integerToMutableByteArray x s0
  go off s2 = if  isTrue# (off >=# 0#)
    then  let
    (# s3, hi #) = readWord64Array# marr (off +# 1#) s2
    (# s4, lo #) = readWord64Array# marr off s3
    (# nhi, nlo #) = fun hi lo
    s5 = writeWord64Array# marr (off +# 1#) nhi s4
    s6 = writeWord64Array# marr (off +# 1#) nlo s5
    in  go (off -# 2#) s6
    else  s2
  s7 = go (iShiftL# (numFields -# 1#) 1#) s1
  (# _s8, arr #) = unsafeFreezeByteArray# marr s7
  numBytes = int2Word# numFields `shiftL#` 4#
  in  importIntegerFromByteArray arr 0## numBytes 0#

-------------------------------------------------------------------------------
-- Modular arithmetic
-------------------------------------------------------------------------------

p :: Int
p = 998244353

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = x + y -! p

(-!) :: Int -> Int -> Int
-- branchless subtraction modulo p
infixl 6 -!
x -! y = let
  raw = x - y
  in  raw + (p .&. shiftR raw 63)

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = let
  I# raw = x * y
  in  I# (word2Int# (remP (int2Word# raw)))

quotP :: Word# -> Word#
quotP v = let
  (# hi, _lo #) = timesWord2# 9920937979283557439## v
    -- the magic number is ceiling(2^(64+29) / p)
    -- The approximation is accurate enough to calculate the exact
    -- quotient with one multiply and one shift for all valid Word#
  in  shiftRL# hi 29#

remP :: Word# -> Word#
remP v = let
  I# p# = p
  in  v `minusWord#` timesWord# (quotP v) (int2Word# p#)

remP2 :: Word# -> Word# -> (# Word#, Word# #)
remP2 hi lo = let
  -- This implementation cheats a bit in order to be a tiny bit
  -- faster. It assumes the high word should be at most 26_401_116_612,
  -- and gives a result in [0..2p-2] instead of [0..p-1].
  I# p# = p
  (# redHi, _ #)
    = int2Word# p# `timesWord2#` timesWord# 17223561541331522433## hi
  in  (# 0##, redHi `plusWord#` remP lo #)

newtype ModP = ModP { unModP :: Int }
instance Semigroup ModP where
  ModP x <> ModP y = ModP (x *! y)
  stimes = stimesMonoid
instance Monoid ModP where
  mempty = ModP 1

inv :: Int -> Int
inv = unModP . stimes (p - 2) . ModP

-------------------------------------------------------------------------------
-- My normal library/template
-------------------------------------------------------------------------------

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


{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Lazy.Char8 as B (ByteString, interact, lines, words, readInt, pack)

-- data Entry = Entry { photos :: !Int, x :: !Int , y :: !Int , time :: !Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
-- solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
solve = (\(a, _, _, _) -> a) . findMax . flip foldl' [(0, 1, 1, 0)] \hist (!tr, !xr, !yr) ->
  let
    -- go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    go (!photos, !x, !y, !time) a = if abs (x - xr) + abs (y - yr) > tr - time then a else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    -- if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist
    if newPhotos == minBound then hist else (newPhotos + 1, xr, yr, tr) `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# OPTIONS_GHC -funbox-strict-fields -fspecialise-aggressively #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments, StrictData #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Char8 as B (ByteString, interact, lines, words, readInt, pack)

data Entry = Entry { photos :: Int, x :: Int, y :: Int, time :: Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Data.Maybe (fromJust)

dist !x !y !z !t !l = abs (x - z) + abs (y - t) > l

data Entry = Entry {
  photos :: !Int
, coordX :: !Int
, coordY :: !Int
, time :: !Int
} deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . fromJust . Set.lookupMax . List.foldl' go [Entry 0 1 1 0]
  where
    go hist (!tr, !xr, !yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        brr (Entry n x y t) a = if dist x y xr yr (tr - t) then a else n

main :: IO ()
main = do
  a <- fmap (fmap read . words) . tail . lines <$> getContents
  print $ solve $ fmap (\[!x, !y, !z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Lazy.Char8 as B (ByteString, interact, lines, words, readInt, pack)

-- data Entry = Entry { photos :: !Int, x :: !Int , y :: !Int , time :: !Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
-- solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
solve = (\(a, _, _, _) -> a) . findMax . flip foldl' [(0, 1, 1, 0)] \hist (!tr, !xr, !yr) ->
  let
    -- go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    go (photos, x, y, time) a = if abs (x - xr) + abs (y - yr) > tr - time then a else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    -- if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist
    if newPhotos == minBound then hist else (newPhotos + 1, xr, yr, tr) `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Prelude

-- data Entry = Entry {
--   photos :: !Int
-- , coordX :: !Int
-- , coordY :: !Int
-- , time :: !Int
-- } deriving (Eq, Ord)

fst4 (a, _, _, _) = a

solve :: [(Int, Int, Int)] -> Int
-- solve = photos . Set.findMax . List.foldl' go [Entry 0 1 1 0]
solve = fst4 . Set.findMax . List.foldl' go [(0, 1, 1, 0)]
  where
    -- go hist (!tr, !xr, !yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
    go hist (!tr, !xr, !yr) = if r == minBound then hist else (r + 1, xr, yr, tr) `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        -- brr (Entry n x y t) a = if abs (x - xr) + abs (y - yr) > tr - t then a else n
        brr (n, x, y, t) a = if abs (x - xr) + abs (y - yr) > tr - t then a else n

main :: IO ()
main = interact $ show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap read . words) . tail . lines

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns, MagicHash, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Data.Maybe (fromJust)

dist x y z t l = abs (x - z) + abs (y - t) > l

data Entry = Entry {
  photos :: Int
, coordX :: Int
, coordY :: Int
, time :: Int
} deriving (Eq, Ord)

data Tup = Tup Int Int Int

solve :: [Tup] -> Int
solve l = photos $ fromJust $ Set.lookupMax $ List.foldl' go [Entry 0 1 1 0] l
  where
    go hist (Tup tr xr yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
      where
        r = mx (toDescList hist) minBound
        mx (Entry n x y t : xs) m
          | dist x y xr yr (tr - t) = mx xs m
          | otherwise = n
        mx [] n = n

main :: IO ()
main = do
  a <- fmap (fmap read . words) . tail . lines <$> getContents
  print $ solve $ fmap (\[x, y, z] -> Tup x y z) a

{-# OPTIONS_GHC -O2 -with-rtsopts=-A64m #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl go [Entry 1 1 0 0 0]
  where
    go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
          [] -> hist
          a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    mx ((!bst, !x) : xs) !n
      | n > bst = max x n
      | otherwise = mx xs (max x n)
    mx [] !n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl' go [Entry 1 1 0 0 0]
  where
    go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
          [] -> hist
          a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    mx ((!bst, !x) : xs) !n
      | n >= bst = max x n
      | otherwise = mx xs (max x n)
    mx [] !n = n

main = do
  -- [r, n] <- map read . words <$> getLine
  -- a <- replicateM n $ map read . words <$> getLine
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Lazy.Char8 as B (ByteString, interact, lines, words, readInt, pack)

data Entry = Entry { photos :: !Int, x :: !Int , y :: !Int , time :: !Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} a = if abs (x - xr) + abs (y - yr) > tr - time then a else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments, StrictData #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Lazy.Char8 as B (ByteString, interact, lines, words, readInt, pack)
import Prelude

data Entry = Entry { photos :: Int, x :: Int, y :: Int, time :: Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns, MagicHash #-}

import Data.List
import Control.Monad

dist x y z t l = abs (x - z) + abs (y - t) > l

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

data Tup = Tup Int Int Int

solve :: [Tup] -> Int
solve l = best $ head $ foldl' go [Entry 1 1 0 0 0] l
  where
    go hist@(Entry _ _ _ best _ : _) (Tup tr xr yr) = if r == minBound then hist else Entry xr yr tr (max best (r + 1)) (r + 1) : hist
      where
        r = mx hist minBound
        mx (Entry x y t bst n : xs) m
          | dist x y xr yr (tr - t) = mx xs m
          | n >= bst = max n m
          | otherwise = mx xs (max n m)
        mx [] !n = n

main :: IO ()
main = do
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> Tup x y z) a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist :: Num a => (a, a) -> (a, a) -> a
dist (!x, !y) (!z, !t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
-- solve = foldl' max . map photos . foldl' go [Entry 1 1 0 0 0]
solve = best . head . foldl' go [Entry 1 1 0 0 0]
  where
    -- go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
    go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case filter (\(Entry x y t _ _) -> dist (x, y) (xr, yr) <= tr - t) hist of
      [] -> hist
      a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    -- mx ((!bst, !x) : xs) !n
    mx (Entry _ _ _ !bst !x : xs) !n
      | n >= bst = max x n
      | otherwise = mx xs (max x n)
    mx [] !n = n

main = do
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Prelude
import Data.Maybe (fromJust)
import Data.Bits

data Entry = Entry {
  photos :: !Int
, coordX :: !Int
, coordY :: !Int
, time :: !Int
} deriving (Eq, Ord)

dist :: Int -> Int -> Int -> Int -> Int -> Bool
dist !x !y !z !t !l = abs (x - z) + abs (y - t) > l

solve :: [(Int, Int, Int)] -> Int
solve = photos . fromJust . Set.lookupMax . List.foldl' go [Entry 0 1 1 0]
  where
    go hist (!tr, !xr, !yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        brr (Entry n x y t) a = if dist x y xr yr (tr - t) then a else n

main :: IO ()
main = do
  a <- getContents
  print $ solve $ fmap ((\[x,y,z] -> (x, y, z)) . fmap read . words) . tail . lines $ a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Data.Maybe (fromJust)

dist x y z t l = abs (x - z) + abs (y - t) > l

data Entry = Entry {
  photos :: Int
, coordX :: Int
, coordY :: Int
, time :: Int
} deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . fromJust . Set.lookupMax . List.foldl' go [Entry 0 1 1 0]
  where
    go hist (tr, xr, yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        brr (Entry n x y t) a = if dist x y xr yr (tr - t) then a else n

main :: IO ()
main = do
  a <- fmap (fmap read . words) . tail . lines <$> getContents
  print $ solve $ fmap (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Prelude

-- data Entry = Entry {
--   photos :: !Int
-- , coordX :: !Int
-- , coordY :: !Int
-- , time :: !Int
-- } deriving (Eq, Ord)

fst4 (a, _, _, _) = a

solve :: [(Int, Int, Int)] -> Int
-- solve = photos . Set.findMax . List.foldl' go [Entry 0 1 1 0]
solve = fst4 . Set.findMax . List.foldl' go [(0, 1, 1, 0)]
  where
    -- go hist (!tr, !xr, !yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
    go hist (!tr, !xr, !yr) = if r == minBound then hist else (r + 1, xr, yr, tr) `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        -- brr (Entry n x y t) a = if abs (x - xr) + abs (y - yr) > tr - t then a else n
        brr (!n, !x, !y, !t) a = if abs (x - xr) + abs (y - yr) > tr - t then a else n

main :: IO ()
main = interact $ show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap read . words) . tail . lines

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments, StrictData #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Char8 as B (ByteString, interact, lines, words, readInt, pack)

data Entry = Entry { photos :: Int, x :: Int, y :: Int, time :: Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist :: Num a => (a, a) -> (a, a) -> a
dist (!x, !y) (!z, !t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = best . head . foldl' go [Entry 1 1 0 0 0]
  where
    -- go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case filter (\(Entry x y t _ _) -> dist (x, y) (xr, yr) <= tr - t) hist of
    --   [] -> hist
    --   a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    go hist@(Entry _ _ _ !best _ : _) (!tr, !xr, !yr) = if r == minBound then hist else Entry xr yr tr (max best $ r + 1) (r + 1) : hist
      where
        r = mx hist minBound
        mx (Entry x y t !bst !n : xs) !m
          | dist (x, y) (xr, yr) > tr - t = mx xs m
          | n >= bst = max n m
          | otherwise = mx xs (max n m)
        mx [] !n = n
    -- mx (Entry _ _ _ !bst !x : xs) !n
    --   | n >= bst = max x n
    --   | otherwise = mx xs (max x n)
    -- mx [] !n = n

main :: IO ()
main = do
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)

data Entry = Entry { photos :: !Int, x :: !Int , y :: !Int , time :: !Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} a = if abs (x - xr) + abs (y - yr) > tr - time then a else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = interact $ show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap read . words) . tail . lines

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict #-}

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

minf = -3483345

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl go [Entry 1 1 0 0 0]
  where
    go hist@(Entry{best}:_) (tr, xr, yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
          [] -> hist
          a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    mx ((bst, x) : xs) n
      | n > bst = max x n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl' go [Entry 1 1 0 0 0]
  where
    go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
          [] -> hist
          a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    mx ((!bst, !x) : xs) !n
      | n >= bst = max x n
      | otherwise = mx xs (max x n)
    mx [] !n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -O2 -fomit-yields -fdicts-strict -fexpose-all-unfoldings -flate-dmd-anal -fspec-constr-keen -fregs-graph -fspec-constr-count=200 -fspec-constr-threshold=700 -funfolding-creation-threshold=800 -funfolding-use-threshold=800 -funbox-strict-fields -fspecialise-aggressively #-}
{-# LANGUAGE BangPatterns, OverloadedLists, RecordWildCards, BlockArguments, StrictData #-}

import Data.Foldable (foldl')
import Data.Set (insert, toDescList, findMax)
import Data.ByteString.Char8 as B (ByteString, interact, lines, words, readInt, pack)

data Entry = Entry { photos :: Int, x :: Int, y :: Int, time :: Int } deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . findMax . flip foldl' [Entry 0 1 1 0] \hist (!tr, !xr, !yr) ->
  let
    go Entry{..} oth = if abs (x - xr) + abs (y - yr) > tr - time then oth else photos
    newPhotos = foldr go minBound $ toDescList hist
  in
    if newPhotos == minBound then hist else Entry (newPhotos + 1) xr yr tr `insert` hist

main :: IO ()
main = B.interact $ pack . show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap int . B.words) . tail . B.lines

int :: ByteString -> Int
int s = let Just (a, _) = readInt s in a

{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

minf = -3483345

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl go [Entry 1 1 0 0 0]
  where
    go hist@(Entry{best}:_) (tr, xr, yr) = case mapMaybe (\(Entry x y t best p) -> if dist (x, y) (xr, yr) <= tr - t then Just (best, p) else Nothing) hist of
          [] -> hist
          a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    mx ((bst, x) : xs) n
      | n > bst = max x n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Data.Maybe
import Control.Monad

dist :: Num a => (a, a) -> (a, a) -> a
dist (!x, !y) (!z, !t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

-- solve :: [(Int, Int, Int)] -> Int
solve :: [[Int]] -> Int
solve = best . head . foldl' go [Entry 1 1 0 0 0]
  where
    go hist@(Entry _ _ _ !best _ : _) [!tr, !xr, !yr] = if r == minBound then hist else Entry xr yr tr (max best $ r + 1) (r + 1) : hist
      where
        r = mx hist minBound
        mx (Entry x y t !bst !n : xs) !m
          | dist (x, y) (xr, yr) > tr - t = mx xs m
          | n >= bst = max n m
          | otherwise = mx xs (max n m)
        mx [] !n = n

main :: IO ()
main = do
  a <- map (map read . words) . tail . lines <$> getContents
  -- print $ solve $ map (\[x, y, z] -> (x, y, z)) a
  print $ solve a

{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

minf = -3483345

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map photos . foldl go [Entry 1 1 0 0 0]
  where
    go hist@(Entry{best}:_) (tr, xr, yr) = Entry xr yr tr (max best nm) nm : hist
      where
        nm = case mapMaybe (\Entry{..} -> if dist (coordX, coordY) (xr, yr) < tr - time then Just (best, photos) else Nothing) hist of
          [] -> 0
          a -> mx a (-1) + 1
    mx ((bst, x) : xs) n
      | n > bst = max x n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Control.Monad
import Prelude
import Data.Maybe (fromJust)

dist x y z t l = abs (x - z) + abs (y - t) > l

data Entry = Entry {
  photos :: Int
, coordX :: Int
, coordY :: Int
, time :: Int
} deriving (Eq, Ord)

solve :: [(Int, Int, Int)] -> Int
solve = photos . fromJust . Set.lookupMax . List.foldl' go [Entry 0 1 1 0]
  where
    go hist (tr, xr, yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
      where
        r = Set.foldr brr minBound hist
        brr (Entry n x y t) a = if dist x y xr yr (tr - t) then a else n

main :: IO ()
main = do
  a <- fmap (fmap read . words) . tail . lines <$> getContents
  print $ solve $ fmap (\[x, y, z] -> (x, y, z)) a

{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, OverloadedLists #-}

import Data.List as List
import Data.Set as Set
import Prelude

-- data Entry = Entry {
--   photos :: !Int
-- , coordX :: !Int
-- , coordY :: !Int
-- , time :: !Int
-- } deriving (Eq, Ord)

fst4 (a, _, _, _) = a

solve :: [(Int, Int, Int)] -> Int
-- solve = photos . Set.findMax . List.foldl' go [Entry 0 1 1 0]
solve = fst4 . Set.findMax . List.foldl' go [(0, 1, 1, 0)]
  where
    -- go hist (!tr, !xr, !yr) = if r == minBound then hist else Entry (r + 1) xr yr tr `Set.insert` hist
    go hist (!tr, !xr, !yr) = if r == minBound then hist else (r + 1, xr, yr, tr) `Set.insert` hist
      where
        r = List.foldr brr minBound $ toDescList hist
        -- brr (Entry n x y t) a = if abs (x - xr) + abs (y - yr) < tr - t then a else n
        brr (n, x, y, t) a = if abs (x - xr) + abs (y - yr) < tr - t then a else n

main :: IO ()
main = interact $ show . solve . fmap ((\[x,y,z] -> (x,y,z)) . fmap read . words) . tail . lines

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Control.Monad

dist :: Num a => (a, a) -> (a, a) -> a
dist (!x, !y) (!z, !t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = best . head . foldl' go [Entry 1 1 0 0 0]
  where
    -- go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case filter (\(Entry x y t _ _) -> dist (x, y) (xr, yr) <= tr - t) hist of
    --   [] -> hist
    --   a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    go hist@(Entry _ _ _ !best _ : _) (!tr, !xr, !yr) = if r == minBound then hist else Entry xr yr tr (max best r) r : hist
      where
        r = mx hist minBound
        mx (Entry x y t !bst !n : xs) !m
          | dist (x, y) (xr, yr) <= tr - t = mx xs m
          | n >= bst = max n m
          | otherwise = mx xs (max n m)
        mx [] !n = n
    -- mx (Entry _ _ _ !bst !x : xs) !n
    --   | n >= bst = max x n
    --   | otherwise = mx xs (max x n)
    -- mx [] !n = n

main :: IO ()
main = do
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map frt . foldl go [((1, 1), 0, 0, 0)]
  where
    go hist@((_, _, best, _):_) (tr, xr, yr) = ((xr, yr), tr, max best nm, nm) : hist
      where
        nm = case mapMaybe (\(p, t, bst, n) -> if dist p (xr, yr) < tr - t then Just (bst, n) else Nothing) hist of
          [] -> minBound
          a -> mx a minBound + 1
    mx ((bst, x) : xs) n
      | n > bst = n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map frt . foldl go [((1, 1), 0, 0, 0)]
  where
    go hist@((_, _, best, _):_) (tr, xr, yr) = ((xr, yr), tr, max best nm, nm) : hist
      where
        nm = case mapMaybe (\(p, t, bst, n) -> if dist p (xr, yr) < tr - t then Just (bst, n) else Nothing) hist of
          [] -> 0
          a -> mx a (-1) + 1
    mx ((bst, x) : xs) n
      | n >= bst = n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map frt . foldl go [((1, 1), 0, 0, 0)]
  where
    go hist@((_, _, best, _):_) (tr, xr, yr) = ((xr, yr), tr, max best nm, nm) : hist
      where
        nm = case mapMaybe (\(p, t, bst, n) -> if dist p (xr, yr) <= tr - t then Just (bst, n) else Nothing) hist of
          [] -> 0
          a -> mx a (-1) + 1
    mx ((bst, x) : xs) n
      | n > bst = n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map frt . foldl go [((1, 1), 0, 0, 0)]
  where
    go hist@((_, _, best, _):_) (tr, xr, yr) = ((xr, yr), tr, max best nm, nm) : hist
      where
        nm = case mapMaybe (\(p, t, bst, n) -> if dist p (xr, yr) < tr - t then Just (bst, n) else Nothing) hist of
          [] -> 0
          a -> mx a (-1) + 1
    mx ((bst, x) : xs) n
      | n > bst = n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

thd :: (a, b, c) -> c
thd (_, _, c) = c

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map thd . foldl go [((1, 1), 0, 0)]
  where
    go hist (tr, xr, yr) = if nm == 0 then hist else ((xr, yr), tr, nm) : hist
      where
        nm = case mapMaybe (\(p, t, n) -> if dist p (xr, yr) < tr - t then Just n else Nothing) hist of
          [] -> 0
          a -> maximum a + 1

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

import Data.List
import Data.Maybe
import Control.Monad

frt :: (a, b, c, d) -> d
frt (_, _, _, d) = d

dist (x, y) (z, t) = abs (x - z) + abs (y - t)

solve :: [(Int, Int, Int)] -> Int
solve = maximum . map frt . foldl go [((1, 1), 0, 0, 0)]
  where
    go hist@((_, _, best, _):_) (tr, xr, yr) = ((xr, yr), tr, best, nm) : hist
      where
        nm = case mapMaybe (\(p, t, bst, n) -> if dist p (xr, yr) < tr - t then Just (bst, n) else Nothing) hist of
          [] -> 0
          a -> mx a (-1) + 1
    mx ((bst, x) : xs) n
      | n >= bst = n
      | otherwise = mx xs (max x n)
    mx [] n = n

main = do
  [r, n] <- map read . words <$> getLine
  a <- replicateM n $ map read . words <$> getLine
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a

{-# LANGUAGE NamedFieldPuns, RecordWildCards, Strict, BangPatterns #-}

import Data.List
import Control.Monad

dist :: Num a => (a, a) -> (a, a) -> a
dist (!x, !y) (!z, !t) = abs (x - z) + abs (y - t)

data Entry = Entry {
  coordX :: Int
, coordY :: Int
, time :: Int
, best :: Int
, photos :: Int
}

solve :: [(Int, Int, Int)] -> Int
solve = best . head . foldl' go [Entry 1 1 0 0 0]
  where
    -- go hist@(Entry _ _ _ !best _:_) (!tr, !xr, !yr) = case filter (\(Entry x y t _ _) -> dist (x, y) (xr, yr) <= tr - t) hist of
    --   [] -> hist
    --   a -> Entry xr yr tr (max best $ mx a (-1) + 1) (mx a (-1) + 1) : hist
    go hist@(Entry _ _ _ !best _ : _) (!tr, !xr, !yr) = if r == minBound then hist else Entry xr yr tr (max best r) r : hist
      where
        r = mx hist minBound
        mx (Entry x y t !bst !n : xs) !m
          | dist (x, y) (xr, yr) > tr - t = mx xs m
          | n >= bst = max n m
          | otherwise = mx xs (max n m)
        mx [] !n = n
    -- mx (Entry _ _ _ !bst !x : xs) !n
    --   | n >= bst = max x n
    --   | otherwise = mx xs (max x n)
    -- mx [] !n = n

main :: IO ()
main = do
  a <- map (map read . words) . tail . lines <$> getContents
  print $ solve $ map (\[x, y, z] -> (x, y, z)) a


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

process s ls t =  map (process1 1 ls) t
	where process1 le ri m| s!mi ==m = mi
			      | s!mi >m && s!(mi-1)<m = mi
			      | s!mi >m = process1 le (mi-1) m
			      | otherwise = process1 (mi+1) ri m
		where mi = div (le +ri) 2
main=do
	getLine
	s<-map (fst. fromJust.C.readInt) . C.words <$>C.getLine:: IO [Int]
	let ls = length s
	let s1 =  listArray (0,ls)  $ scanl (+) 0 s
	getLine
	t<-map (fst. fromJust.C.readInt) . C.words <$>C.getLine:: IO [Int]
	mapM_ print $   process s1 ls t

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.ByteString.Builder

main :: IO ()
main = do
        [[n], as,_,qs ]  <- getIntLoLBs
        BS.putStrLn $ printMatrixBS $ matrixIntToBs $ solve n as qs

readMatrixBS :: BS.ByteString -> [[BS.ByteString]]
readMatrixBS = fmap BS.words . BS.lines

matrixToNumBs :: (Num a) => [[BS.ByteString]] ->[[a]]
matrixToNumBs = fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger

solve :: Int -> [Int] -> [Int] -> [[Int]]
solve n as qs =
    let sums = scanl (+) 1 as
        zipped = sums `zip` [1 ..]
        tree = fst $ buildT zipped n
        find v = findLabel v tree 0
        answers = map find qs
     in map return answers

data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show)

buildT :: [a] -> Int -> (Tree a, [a])
buildT xs 0 = (Nil, xs)
buildT xs n = (Node val leftSon rightSon, rightRems)
    where leftCount = n `div` 2
          (leftSon, leftRems) = buildT xs leftCount
          val = head leftRems
          (rightSon, rightRems) = buildT (tail leftRems) (n - leftCount - 1)

findLabel :: (Ord value) => value -> Tree (value, label) -> label -> label
findLabel _ Nil prevGuess = prevGuess
findLabel v' (Node (v,label) left right)  prevGuess
    | v' > v = findLabel v' right  label
    | v' < v = findLabel v' left  prevGuess
    | otherwise = label

getIntLoLBs :: IO [[Int]]
getIntLoLBs = do
               c <- BS.getContents
               return . matrixToNumBs . readMatrixBS $ c

matrixIntToBs :: (Integral a) => [[a]] -> [[BS.ByteString]]
matrixIntToBs = fmap.fmap $ (toLazyByteString . integerDec . toInteger)

printMatrixBS :: [[BS.ByteString]] -> BS.ByteString
printMatrixBS = BS.unlines . fmap BS.unwords

module Main (main)
    where

import Data.Maybe (mapMaybe)
import Data.Array (Ix, Array, listArray, bounds, (!))
import Control.Monad (mapM_)

type Bucket = (Int,Int)

pile :: (Integral i, Ix i) => Int -> Array i (Int,Bucket) -> Maybe Int
pile i a = search a i 0 $ snd $ bounds a
    where search xs needle lo hi
            | hi <= lo   = Nothing
            | needle < a = search xs needle lo mid
            | needle > b = search xs needle (mid + 1) hi
            | otherwise  = Just p
                where mid = lo + (hi - lo) `div` 2
                      (p,(a,b)) = xs!mid

buckets :: [Int] -> [Bucket]
buckets xs = zipWith (\a b -> (a + 1, b)) s $ tail s
    where s = 0:scanl1 (+) xs

main :: IO ()
main = do
    a <- getLine >> getLine
    q <- getLine >> getLine
    let [as,qs] = map (map read . words) [a,q]
    let bs = listArray (0, length as) $ zip [1..] $ buckets as
    mapM_ print $ mapMaybe (flip pile bs) qs

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

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

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

main = do
  getLine
  cs <- getInts

  let
    s = sum cs
    is = listArray (1, s) $ concat $ zipWith (\c i -> replicate c i) cs [1..] :: UArray Int Int

  getLine
  qs <- getInts

  putStrLn $ unlines $ map show $ map (is!) qs

import Control.Monad
import Text.Printf
import Data.List
import Data.Array

bisearch :: Array Int Int -> (Int, Int) -> Int -> Int
bisearch a (lb, rb) q
   | rb-lb == 1= rb
   | me >= q   = bisearch a (lb, md) q
   | otherwise = bisearch a (md, rb) q
   where md = (lb+rb) `div` 2
         me = a ! md

solve = bisearch

main = do
   n <- getLine >>= return . (read :: String -> Int)
   a <- getLine >>= return . listArray (0,100010) .  scanl (+) 0 . map (read :: String -> Int) . words
   m <- getLine >>= return . (read :: String -> Int)
   q <- getLine >>= return . map (read :: String -> Int) . words
   forM_ (q >>= return . solve a (0, n)) print

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine>>= \n-> (solve.(\[a,b,c]->[[read n], a,c]) =<< forM [1 ..3] ( \i -> map (fst.fromJust.C.readInteger).C.words <$> C.getLine))
solve [n,xs,ys] =let m = slv1 xs; tr=slv2 1 (head n) m in forM_ ys $ \i -> print $ slv3 i tr
slv1 xs = let s= scanl (+) 0 xs in Map.fromList $ zip [1..] $ zip s (tail s)
slv2 x1 x2 m = unfoldTree f (x1,x2)
  where
  f (b1,b2)=let z=((b2-b1) `div`2)+b1 in if b1==b2 then ((b1,m Map.!b1),[]) else if z==b1 then ((z,m Map.!z),[(b2,b2)]) else ((z,m Map.!z), [(b1, z-1),(z+1,b2)] )
slv3 n (Node (z,(x,y)) []) = z
slv3 n (Node (z,(x,y)) fs) | n> x && n<=y =z
                           | n==x         =z-1
                           | n==y+1       =z+1
                           | n<x          = slv3 n (head fs)
                           | n>y+1        = slv3 n (last fs)

import Control.Applicative
import Data.Array

solve :: [Int] -> [Int] -> [Int]
solve as ms =
    binSearch 0 (length as) <$> ms
    where as' = listArray (0, length as) $ scanl (+) 0 as
          binSearch :: Int -> Int -> Int -> Int
          binSearch l r v
               | l == r = r
               | v <= d = binSearch l m v
               | d < v = binSearch (m + 1) r v
               where m = l + (div (r-l) 2)
                     d = as' ! m

main = do
    getLine
    as <- fmap read.words <$> getLine
    getLine
    ms <- fmap read.words <$> getLine
    let q = solve as ms
    mapM_ print q

import Control.Applicative
import Data.List
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import qualified Data.IntMap.Strict as M

main = do
  C.getLine
  s<- scanl1 (+) <$> map (fst.fromJust.C.readInt) <$> C.words <$> C.getLine ::IO [Int]
  let s1 = M.fromList $ zip s [1..]
  C.getLine
  t<- map (fst.fromJust.C.readInt) <$> C.words <$> C.getLine ::IO [Int]
  mapM_ print $  map (\z->snd $ fromJust $ M.lookupGE z s1) t

import qualified Data.Array as A

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

solve :: [[Int]] -> [Int]
solve [[n], as, _, qs] = map (binsearch (A.listArray (0, n) (scanl (+) 0 as))) qs
solve _ = undefined

binsearch :: A.Array Int Int -> Int -> Int
binsearch xs x = go (A.bounds xs)
  where go (a, b) | a + 1 == b = b
                  | x <= xs A.! c = go (a, c)
                  | otherwise = go (c, b)
          where c = (a + b) `div` 2

import Data.Array
main = do
  n <- readLn
  as <- fmap (listArray (0,n) . scanl (+) 0 . map read . words) getLine
  let bsearch l r i | r - l <= 1 = r
                    | as!m < i = bsearch m r i
                    | otherwise = bsearch l m i
        where m = div (l + r + 1) 2
  getLine
  sequence . map (print . bsearch 0 n . read) . words =<< getLine

{-# 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, runSTArray)
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, range, 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 #-}

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  _m<-getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Int]
solve n xs qs = map query qs
   where
     arr :: UArray Int Int
     !arr = listArray(0,n)$scanl1(+)$0:xs
     query q = lowerBound (\i->unsafeAt arr i>=q) 0 n

import Control.Monad
import Text.Printf
import Data.List
import Data.Array

bisearch :: Array Int Int -> (Int, Int) -> Int -> Int
bisearch a (lb, rb) q
   | rb-lb == 1= rb
   | q < me    = bisearch a (lb, md) q
   | otherwise = bisearch a (md, rb) q
   where md = (lb+rb) `div` 2
         me = a ! md

solve = bisearch

main = do
   n <- getLine >>= return . (read :: String -> Int)
   a <- getLine >>= return . listArray (0,100010) .  scanl (+) 0 . map (read :: String -> Int) . words
   m <- getLine >>= return . (read :: String -> Int)
   q <- getLine >>= return . map (read :: String -> Int) . words
   forM_ (q >>= return . solve a (0, n)) print

{-# 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, runSTArray)
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, range, 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 #-}

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = assert (low>=0 && p high) $ go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2
{-# INLINE lowerBound #-}

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  _m<-getLine
  qs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xs qs

solve :: Int -> [Int] -> [Int] -> [Int]
solve n xs qs = map (succ.query.pred) qs
   where
     arr :: UArray Int Int
     !arr = listArray(0,n-1)$scanl1(+)xs
     query q = lowerBound (\i->unsafeAt arr i>=q) 0 (n-1)


main = fmap (map read . words) getLine >>= \[_,a,b] -> getLine >>= print . solve a b

solve a b = solve_ (swap a b) . map oddEven . countDot
    where swap a b = if a > b then (a,b) else (b,a)

solve_ (0,0) _ = 0
solve_ (a,b) [] = 0
solve_ (a,b) ((x,y):xs)
    | a - a' > b - b' = a' + b' + solve_ (a - a', b - b') xs
    | otherwise       = a' + b' + solve_ (b - b', a - a') xs
    where a' = min a x
          b' = min b y

oddEven x
   | even x = (x `div` 2, x `div` 2)
   | otherwise = (x `div` 2 + 1, x `div` 2)

countDot = count . break (=='*')
    where count (a,[]) = [length a]
          count (a,(_:bs)) = length a : countDot bs

main = fmap (map read . words) getLine >>= \[_,a,b] -> getLine >>= print . run a b

run a b = solve (swap_ a b) . map f . free
    where
    f x = let mid = x `div` 2 in  let t = if even x then mid else mid + 1 in (t, mid)
    swap_ a b = if a > b then (a,b) else (b,a)
    solve a1 b1 = case (a1, b1) of
        ((0,0), _) -> 0
        ((a,b), []) -> 0
        ((a,b), ((x,y):xs)) ->
            let a_ = min a x
                b_ = min b y in
                a_ + b_ + solve (swap_ (a - a_) (b - b_)) xs
    free = count . break (=='*')
        where count (a1, b1) = case (a1, b1) of
                    (a,[]) -> [length a]
                    (a,(_:bs)) -> length a : free bs

main = getContents >>= print . solve . parse . words . map toblank
    where parse (_:a:b:xs) = (read a, read b, map length xs)
          toblank c = if c == '*' then ' ' else c

solve (a,b,xs) = solve_ (swap a b) $ map oddEven xs
    where swap a b = if a > b then (a,b) else (b,a)
          oddEven x = let a = x `div` 2 in (x - a, a)

solve_ (0,0) _ = 0
solve_ (a,b) [] = 0
solve_ (a,b) ((x,y):xs)
    | a - a' > b - b' = a' + b' + solve_ (a - a', b - b') xs
    | otherwise       = a' + b' + solve_ (b - b', a - a') xs
    where a' = min a x
          b' = min b y