You are given a rooted tree consisting of $$$n$$$ vertices numbered from $$$1$$$ to $$$n$$$. The root of the tree is the vertex $$$1$$$.You have to color all vertices of the tree into $$$n$$$ colors (also numbered from $$$1$$$ to $$$n$$$) so that there is exactly one vertex for each color. Let $$$c_i$$$ be the color of vertex $$$i$$$, and $$$p_i$$$ be the parent of vertex $$$i$$$ in the rooted tree. The coloring is considered beautiful if there is no vertex $$$k$$$ ($$$k > 1$$$) such that $$$c_k = c_{p_k} - 1$$$, i. e. no vertex such that its color is less than the color of its parent by exactly $$$1$$$.Calculate the number of beautiful colorings, and print it modulo $$$998244353$$$.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 250000$$$) — the number of vertices in the tree. Then $$$n-1$$$ lines follow, the $$$i$$$-th line contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, y_i \le n$$$; $$$x_i \ne y_i$$$) denoting an edge between the vertex $$$x_i$$$ and the vertex $$$y_i$$$. These edges form a tree.

Print one integer — the number of beautiful colorings, taken modulo $$$998244353$$$.

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

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

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

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


Hosssam decided to sneak into Hemose's room while he is sleeping and change his laptop's password. He already knows the password, which is a string $$$s$$$ of length $$$n$$$. He also knows that there are $$$k$$$ special letters of the alphabet: $$$c_1,c_2,\ldots, c_k$$$.Hosssam made a program that can do the following.  The program considers the current password $$$s$$$ of some length $$$m$$$.  Then it finds all positions $$$i$$$ ($$$1\le i<m$$$) such that $$$s_{i+1}$$$ is one of the $$$k$$$ special letters.  Then it deletes all of those positions from the password $$$s$$$ even if $$$s_{i}$$$ is a special character. If there are no positions to delete, then the program displays an error message which has a very loud sound. For example, suppose the string $$$s$$$ is "abcdef" and the special characters are 'b' and 'd'. If he runs the program once, the positions $$$1$$$ and $$$3$$$ will be deleted as they come before special characters, so the password becomes "bdef". If he runs the program again, it deletes position $$$1$$$, and the password becomes "def". If he is wise, he won't run it a third time.Hosssam wants to know how many times he can run the program on Hemose's laptop without waking him up from the sound of the error message. Can you help him?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the initial length of the password. The next line contains a string $$$s$$$ consisting of $$$n$$$ lowercase English letters — the initial password. The next line contains an integer $$$k$$$ ($$$1 \le k \le 26$$$), followed by $$$k$$$ distinct lowercase letters $$$c_1,c_2,\ldots,c_k$$$ — the special letters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print the maximum number of times Hosssam can run the program without displaying the error message, on a new line.

10

9

iloveslim

1 s

7

joobeel

2 o e

7

basiozi

2 s i

6

khater

1 r

7

abobeih

6 a b e h i o

5

zondl

5 a b c e f

6

shoman

2 a h

7

shetwey

2 h y

5

samez

1 m

6

mouraz

1 m

NoteIn the first test case, the program can run $$$5$$$ times as follows: $$$\text{iloveslim} \to \text{ilovslim} \to \text{iloslim} \to \text{ilslim} \to \text{islim} \to \text{slim}$$$In the second test case, the program can run $$$2$$$ times as follows: $$$\text{joobeel} \to \text{oel} \to \text{el}$$$In the third test case, the program can run $$$3$$$ times as follows: $$$\text{basiozi} \to \text{bioi} \to \text{ii} \to \text{i}$$$.In the fourth test case, the program can run $$$5$$$ times as follows: $$$\text{khater} \to \text{khatr} \to \text{khar} \to \text{khr} \to \text{kr} \to \text{r}$$$In the fifth test case, the program can run only once as follows: $$$\text{abobeih} \to \text{h}$$$In the sixth test case, the program cannot run as none of the characters in the password is a special character.

check :: String -> Int -> [Char] -> Int
check [] _ _ = 0
check (x: xs) i s = if x `elem` s
  then max i (check xs 1 s)
  else check xs (i + 1) s

for :: Int -> IO ()
for 0 = pure ()
for i = do
  _ <- readLn :: IO Int
  s <- getLine
  arr <- (map (\(x: xs) -> x)) <$> (tail <$> (words <$> getLine))
  print $ check s 0 arr
  for $ i - 1

main :: IO ()
main = do
  t <- readLn :: IO Int
  for t


Given a string s, determine if it contains any palindrome of length exactly 100 as a subsequence. If it has any, print any one of them. If it doesn't have any, print a palindrome that is a subsequence of s and is as long as possible.

The only line of the input contains one string s of length n (1 ≤ n ≤ 5·104) containing only lowercase English letters.

If s contains a palindrome of length exactly 100 as a subsequence, print any palindrome of length 100 which is a subsequence of s. If s doesn't contain any palindromes of length exactly 100, print a palindrome that is a subsequence of s and is as long as possible. If there exists multiple answers, you are allowed to print any of them.

NoteA subsequence of a string is a string that can be derived from it by deleting some characters without changing the order of the remaining characters. A palindrome is a string that reads the same forward or backward.

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

import qualified Data.Array.Unboxed as UA
import Data.Array.Base

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

type Array1 a = UA.UArray Int a
type Array2 a = UA.UArray (Int,Int) a

main = do
    s <- getLine
    putStrLn $ solve s

solve s | b >= 100 = replicate 100 c
        | otherwise = palindrome s
    where
    (b,c) = maximum $ [(count c s,c) | c <- ['a'..'z']]

lenCmp a b = length a `compare`  length b
fstCmp (a,_) (b,_) = compare a b

count c  = foldl' (\ a ch -> if c == ch then a+1 else a) 0

cut s | length s <= 100 = s
      | otherwise = cut s'
      where
      n = length s
      s' = tail $ take (n-1) s

palindrome [a] = [a]
palindrome s = l
    where
    n = length s
    str = UA.listArray (1,n) s
    dp = lcsDP str n
    bt = backtrace str dp
    l1 = maximumBy fstCmp [ (dp UA.! (i,n-i+1),bt (i,n-i+1)) | i <- [1..n] ]
    l2 = maximumBy fstCmp [ (dp UA.! (i,n-i),bt (i,n-i)) | i <- [1..n-1] ]
    l  = if fst l1 > fst l2 && fst l1 <= 50 then
        reverse (tail $ snd l1) ++ [head $ snd l1] ++ (tail $ snd l1)
        else
            let a = take 50 (snd l2) in
                reverse a ++ a

lcsDP :: Array1 Char -> Int -> Array2 Int
lcsDP str n  = runSTUArray $ do
    dp <- newArray ((0,0),(n,n)) 0
    forM_ [1..n] $ \i -> do
        forM_ [1..n] $ \j -> do
            a <- readArray dp (i-1,j-1)
            b <- readArray dp (i,j-1)
            c <- readArray dp (i-1,j)
            let d = if unsafeAt str (i-1) == unsafeAt str (n-j) then
                    max (a+1) (max b c)
                else max b c
            writeArray dp (i,j) d
    return dp

backtrace :: Array1 Char -> Array2 Int -> (Int,Int) -> String
backtrace str dp (i,j) = go (i,j)
    where
    go (i,0) = ""
    go (0,j) = ""
    go (i,j)
        | dp UA.! (i-1,j) == dp UA.! (i,j)       = go (i-1,j)
        | dp UA.! (i,j-1) == dp UA.! (i,j)       = go (i,j-1)
        | otherwise = (unsafeAt str (i-1)):go (i-1,j-1)

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

import qualified Data.Array as A

main = do
    s <- getLine
    putStrLn $ solve s

solve s | b >= 100 = replicate 100 c
        | otherwise = palindrome s
    where
    (b,c) = maximum $ map (\l -> (length l,head l))$ group $ sort s

lenCmp a b = length a `compare`  length b

palindrome s = l
    where
    n = length s
    str = A.listArray (1,n) s
    dp = A.listArray ((0,0),(n,n)) [ f i j | i <- [0..n], j <- [0..n]]
    l1 = maximumBy lenCmp [ backtrace (i,n-i+1) | i <- [1..n] ]
    l2 = maximumBy lenCmp [ backtrace (i,n-i) | i <- [1..n-1] ]
    l  = if length l1 > length l2 then
        reverse (tail l1) ++ [head l1] ++ (tail l1)
        else
            reverse l2 ++ l2
    f i 0 = 0
    f 0 j = 0
    f i j | str A.! i == str A.! (n-j+1) = max a (max b c)
          | otherwise                    = max b c
        where
        a = dp A.! (i-1,j-1) + 1
        b = dp A.! (i,j-1)
        c = dp A.! (i-1,j)
    backtrace (i,0) = ""
    backtrace (0,j) = ""
    backtrace (i,j)
        | dp A.! (i-1,j) == dp A.! (i,j)       = backtrace (i-1,j)
        | dp A.! (i,j-1) == dp A.! (i,j)       = backtrace (i,j-1)
        | otherwise = (str A.! i):backtrace (i-1,j-1)

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

import qualified Data.Array as A
import qualified Data.Array.Unboxed as UA
import Data.Array.Base
import qualified Data.ByteString.Char8 as B

type Array1 a = UA.UArray Int a
type Array2 a = A.Array (Int,Int) a

main = do
    s <- B.getLine
    putStrLn $ solve s

solve s | b >= 100 = replicate 100 c
        | otherwise = palindrome s
    where
    (b,c) = maximum [ (count s c,c) | c <- ['a'..'z']]

count s c = B.foldl (\a ch -> if c == ch then a+1 else a) 0 s

lenCmp a b = length a `compare`  length b
fstCmp (a,_) (b,_) = compare a b

cut s | length s <= 100 = s
      | otherwise = cut s'
      where
      n = length s
      s' = tail $ take (n-1) s

palindrome s | B.length s <= 1 = B.unpack s
             | otherwise= cut l
    where
    n = B.length s
    str = s
    dp = lcsDP str n
    bt = backtrace str dp
    l1 = maximumBy fstCmp [ (dp A.! (i,n-i+1),bt (i,n-i+1)) | i <- [1..n]]
    l2 = maximumBy fstCmp [ (dp A.! (i,n-i)  ,bt (i,n-i))  | i <- [1..n-1]]
    l  = if fst l1 > fst l2 && fst l1 <= 50 then
        reverse (tail $ snd l1) ++ [head $ snd l1] ++ (tail $ snd l1)
        else
            reverse (snd l2) ++ (snd l2)

lcsDP :: B.ByteString -> Int -> Array2 Int
lcsDP str n  = dp
    where
    dp = A.listArray ((0,0),(n,n)) [ f i j | i <- [0..n], j <- [0..n]]
    f i 0 = 0
    f 0 j = 0
    f i j | B.index str (i-1) == B.index str (n-j) = max a (max b c)
          | otherwise                    = max b c
        where
        a = dp A.! (i-1,j-1) + 1
        b = dp A.! (i,j-1)
        c = dp A.! (i-1,j)

backtrace :: B.ByteString -> Array2 Int -> (Int,Int) -> String
backtrace str dp (i,j) = go (i,j)
    where
    go (i,0) = ""
    go (0,j) = ""
    go (i,j)
        | dp A.! (i-1,j) == dp A.! (i,j)       = go (i-1,j)
        | dp A.! (i,j-1) == dp A.! (i,j)       = go (i,j-1)
        | otherwise = (B.index str (i-1)):go (i-1,j-1)

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

import qualified Data.Array as A

main = do
    s <- getLine
    putStrLn $ solve s

solve s | b >= 100 = replicate 100 c
        | otherwise = palindrome s
    where
    (b,c) = maximum $ map (\l -> (length l,head l))$ group $ sort s

lenCmp a b = length a `compare`  length b

cut s | length s <= 100 = s
      | otherwise = cut s'
      where
      n = length s
      s' = tail $ take (n-1) s

palindrome [a] = [a]
palindrome s = cut l
    where
    n = length s
    str = A.listArray (1,n) s
    dp = A.listArray ((0,0),(n,n)) [ f i j | i <- [0..n], j <- [0..n]]
    l1 = maximumBy lenCmp [ backtrace (i,n-i+1) | i <- [1..n] ]
    l2 = maximumBy lenCmp [ backtrace (i,n-i) | i <- [1..n-1] ]
    l  = if length l1 > length l2 then
        reverse (tail l1) ++ [head l1] ++ (tail l1)
        else
            reverse l2 ++ l2
    f i 0 = 0
    f 0 j = 0
    f i j | str A.! i == str A.! (n-j+1) = max a (max b c)
          | otherwise                    = max b c
        where
        a = dp A.! (i-1,j-1) + 1
        b = dp A.! (i,j-1)
        c = dp A.! (i-1,j)
    backtrace (i,0) = ""
    backtrace (0,j) = ""
    backtrace (i,j)
        | dp A.! (i-1,j) == dp A.! (i,j)       = backtrace (i-1,j)
        | dp A.! (i,j-1) == dp A.! (i,j)       = backtrace (i,j-1)
        | otherwise = (str A.! i):backtrace (i-1,j-1)


You are a paparazzi working in Manhattan.Manhattan has $$$r$$$ south-to-north streets, denoted by numbers $$$1, 2,\ldots, r$$$ in order from west to east, and $$$r$$$ west-to-east streets, denoted by numbers $$$1,2,\ldots,r$$$ in order from south to north. Each of the $$$r$$$ south-to-north streets intersects each of the $$$r$$$ west-to-east streets; the intersection between the $$$x$$$-th south-to-north street and the $$$y$$$-th west-to-east street is denoted by $$$(x, y)$$$. In order to move from the intersection $$$(x,y)$$$ to the intersection $$$(x', y')$$$ you need $$$|x-x'|+|y-y'|$$$ minutes.You know about the presence of $$$n$$$ celebrities in the city and you want to take photos of as many of them as possible. More precisely, for each $$$i=1,\dots, n$$$, you know that the $$$i$$$-th celebrity will be at the intersection $$$(x_i, y_i)$$$ in exactly $$$t_i$$$ minutes from now (and he will stay there for a very short time, so you may take a photo of him only if at the $$$t_i$$$-th minute from now you are at the intersection $$$(x_i, y_i)$$$). You are very good at your job, so you are able to take photos instantaneously. You know that $$$t_i < t_{i+1}$$$ for any $$$i=1,2,\ldots, n-1$$$.Currently you are at your office, which is located at the intersection $$$(1, 1)$$$. If you plan your working day optimally, what is the maximum number of celebrities you can take a photo of?

The first line of the input contains two positive integers $$$r, n$$$ ($$$1\le r\le 500$$$, $$$1\le n\le 100,000$$$) – the number of south-to-north/west-to-east streets and the number of celebrities. Then $$$n$$$ lines follow, each describing the appearance of a celebrity. The $$$i$$$-th of these lines contains $$$3$$$ positive integers $$$t_i, x_i, y_i$$$ ($$$1\le t_i\le 1,000,000$$$, $$$1\le x_i, y_i\le r$$$)  — denoting that the $$$i$$$-th celebrity will appear at the intersection $$$(x_i, y_i)$$$ in $$$t_i$$$ minutes from now. It is guaranteed that $$$t_i<t_{i+1}$$$ for any $$$i=1,2,\ldots, n-1$$$.

Print a single integer, the maximum number of celebrities you can take a photo of.

NoteExplanation of the first testcase: There is only one celebrity in the city, and he will be at intersection $$$(6,8)$$$ exactly $$$11$$$ minutes after the beginning of the working day. Since you are initially at $$$(1,1)$$$ and you need $$$|1-6|+|1-8|=5+7=12$$$ minutes to reach $$$(6,8)$$$ you cannot take a photo of the celebrity. Thus you cannot get any photo and the answer is $$$0$$$.Explanation of the second testcase: One way to take $$$4$$$ photos (which is the maximum possible) is to take photos of celebrities with indexes $$$3, 5, 7, 9$$$ (see the image for a visualization of the strategy):   To move from the office at $$$(1,1)$$$ to the intersection $$$(5,5)$$$ you need $$$|1-5|+|1-5|=4+4=8$$$ minutes, so you arrive at minute $$$8$$$ and you are just in time to take a photo of celebrity $$$3$$$.  Then, just after you have taken a photo of celebrity $$$3$$$, you move toward the intersection $$$(4,4)$$$. You need $$$|5-4|+|5-4|=1+1=2$$$ minutes to go there, so you arrive at minute $$$8+2=10$$$ and you wait until minute $$$12$$$, when celebrity $$$5$$$ appears.  Then, just after you have taken a photo of celebrity $$$5$$$, you go to the intersection $$$(6,6)$$$. You need $$$|4-6|+|4-6|=2+2=4$$$ minutes to go there, so you arrive at minute $$$12+4=16$$$ and you wait until minute $$$17$$$, when celebrity $$$7$$$ appears.  Then, just after you have taken a photo of celebrity $$$7$$$, you go to the intersection $$$(5,4)$$$. You need $$$|6-5|+|6-4|=1+2=3$$$ minutes to go there, so you arrive at minute $$$17+3=20$$$ and you wait until minute $$$21$$$ to take a photo of celebrity $$$9$$$.   Explanation of the third testcase: The only way to take $$$1$$$ photo (which is the maximum possible) is to take a photo of the celebrity with index $$$1$$$ (since $$$|2-1|+|1-1|=1$$$, you can be at intersection $$$(2,1)$$$ after exactly one minute, hence you are just in time to take a photo of celebrity $$$1$$$).Explanation of the fourth testcase: One way to take $$$3$$$ photos (which is the maximum possible) is to take photos of celebrities with indexes $$$3, 8, 10$$$:   To move from the office at $$$(1,1)$$$ to the intersection $$$(101,145)$$$ you need $$$|1-101|+|1-145|=100+144=244$$$ minutes, so you can manage to be there when the celebrity $$$3$$$ appears (at minute $$$341$$$).  Then, just after you have taken a photo of celebrity $$$3$$$, you move toward the intersection $$$(149,379)$$$. You need $$$|101-149|+|145-379|=282$$$ minutes to go there, so you arrive at minute $$$341+282=623$$$ and you wait until minute $$$682$$$, when celebrity $$$8$$$ appears.  Then, just after you have taken a photo of celebrity $$$8$$$, you go to the intersection $$$(157,386)$$$. You need $$$|149-157|+|379-386|=8+7=15$$$ minutes to go there, so you arrive at minute $$$682+15=697$$$ and you wait until minute $$$855$$$ to take a photo of celebrity $$$10$$$.

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

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

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

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