module Main where

import Data.List
import Data.Maybe
import Data.Function
import Control.Arrow

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: [(Char,Int)], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = [(c, 1)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = [], l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node | null $ content node = [l,r] >>= \f -> pnt $ f node
         | otherwise           = content node >>= \(c,n) -> replicate n c

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq cnt $ solve s' t'
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | null $ content node           = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = map ((head *** sum) . unzip)
            $ groupBy ((==) `on` fst)
            $ m (k==0) reverse id
            $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = [],
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=cnt'', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid   = div (l_end+r_end) 2
        cnt'  = mask cnt l_end r_end
        cnt'' = map (second $ \(l,r)->r-l+1) cnt'

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe
import Data.Function
import Control.Arrow

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

data Tree = Nil | Node { content :: [(Char,Int)], l, r :: Tree, rng :: (Int, Int) }

makeTree [c] rng = Node { content = [(c, 1)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = [], l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node | null $ content node = [l,r] >>= \f -> pnt $ f node
         | otherwise           = content node >>= \(c,n) -> replicate n c

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (snd $ snd $ last cnt) $ solve s' t'
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | null $ content node           = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = map ((head *** sum) . unzip)
            $ groupBy ((==) `on` fst)
            $ (if k==0 then reverse else id)
            $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt l_end r_end
  | otherwise                     = node {
      content = [],
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=cnt'', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid   = div (l_end+r_end) 2
        cnt'  = mask cnt l_end r_end
        cnt'' = map (second $ \(l,r)->r-l+1) cnt'

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (second $ max l_end *** min r_end) cnt, l<=r]

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (length cnt) (solve s' t')
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | content node == Nothing       = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = fromJust $ content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=Just cnt', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid = div (l_end+r_end) 2
        cnt' = mask cnt l_end r_end

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (length cnt) (solve s' t')
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t []
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)}) res
  | q_r < l_end || r_end < q_l    = res
  | content node == Nothing       = extract q_l q_r (l node) (extract q_l q_r (r node) res)
  | q_l <= l_end && r_end <= q_r  = (fromJust $ content node) ++ res
  | otherwise                     = extract q_l q_r (l node) (extract q_l q_r (r node) res)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=Just cnt', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid = div (l_end+r_end) 2
        cnt' = mask cnt l_end r_end

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | content node == Nothing       = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = fromJust $ content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=Just cnt', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid = div (l_end+r_end) 2
        cnt' = mask cnt l_end r_end

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq cnt $ solve s' t'
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | content node == Nothing       = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = fromJust $ content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=Just cnt', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid = div (l_end+r_end) 2
        cnt' = mask cnt l_end r_end

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (length cnt) (solve s' t')
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | content node == Nothing       = extract q_l q_r (l node) ++ extract q_l q_r (r node)
  | q_l <= l_end && r_end <= q_r  = fromJust $ content node
  | otherwise                     = extract q_l q_r (l node) ++ extract q_l q_r (r node)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=Just cnt', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid = div (l_end+r_end) 2
        cnt' = mask cnt l_end r_end

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (mask' (l_end, r_end)) cnt, l<=r]
  where mask' (l, r) (c, (l_end, r_end)) = (c, (max l_end l, min r_end r))

module Main where

import Data.List
import Data.Maybe
import Data.Function
import Control.Arrow

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  solve lines (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: [(Char,Int)], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = [(c, 1)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = [], l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node | null $ content node = [l,r] >>= \f -> pnt $ f node
         | otherwise           = content node >>= \(c,n) -> replicate n c

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq cnt $ solve s' t'
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)})
  | q_r < l_end || r_end < q_l    = []
  | null $ content node           = [l,r] >>= \f -> extract q_l q_r (f node)
  | q_l <= l_end && r_end <= q_r  = content node
  | otherwise                     = [l,r] >>= \f -> extract q_l q_r (f node)

integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = map ((head *** sum) . unzip)
            $ groupBy ((==) `on` fst)
            $ m (k==0) reverse id
            $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = genNode cnt' l_end r_end
  | otherwise                     = node {
      content = [],
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = mask cnt l_end r_end

genNode cnt l_end r_end
  = Node { content=cnt'', rng=(l_end,r_end), l=genNode cnt' l_end mid, r=genNode cnt' (mid+1) r_end }
  where mid   = div (l_end+r_end) 2
        cnt'  = mask cnt l_end r_end
        cnt'' = map (second $ \(l,r)->r-l+1) cnt'

mask cnt l_end r_end = [c | c@(_,(l,r)) <- map (second $ max l_end *** min r_end) cnt, l<=r]

module Main where

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (drop 40000 lines) (makeTree s (1,n))

data Tree = Nil | Node [Int] Tree Tree (Int, Int) deriving Show

makeTree [c] r = Node [if c'==c then 1 else 0 | c' <- ['a'..'z']] Nil Nil r

makeTree s r@(l_end, r_end)
  = Node (zipWith (+) left_l right_l) left right r
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left@(Node left_l _ _ _) = makeTree left_s (l_end, mid)
	right@(Node right_l _ _ _) = makeTree right_s (mid + 1, r_end)

pnt Nil
  = ""

pnt (Node cnt l r (l_end, r_end))
  | l_end == r_end
  = [c | (1,c) <- zip cnt ['a'..'z']]
  | otherwise
  = pnt l ++ pnt r

solve :: [String] -> Tree -> IO ()
solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = extract i j t
	t' = replace i j k cnt t

extract l r (Node cnt l_ch r_ch (l_end, r_end))
  | l <= l_end && r_end <= r
  = cnt
  | r < l_end || r_end < l
  = [0,0..]
  | otherwise
  = zipWith (+) (extract l r l_ch) (extract l r r_ch)

replace l r k cnt node@(Node _ _ _ (l_end, r_end))
  | r < l_end || r_end < l
  = node
  | l == l_end && r == r_end
  = sp cnt k (l_end, r_end)
  | otherwise
  = replace' l r k cnt node

replace' l r k cnt node@(Node _ l_ch r_ch (l_end, r_end))
  | mid < l
  = makeNode l_ch (replace l r k cnt r_ch) (l_end, r_end)
  | r <= mid
  = makeNode (replace l r k cnt l_ch) r_ch (l_end, r_end)
  | otherwise
  = makeNode (replace l mid k l_cnt l_ch) (replace (mid+1) r k r_cnt r_ch) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        (l_cnt, r_cnt) = sp'' k cnt (mid - l + 1)

makeNode l@(Node l_cnt _ _ _) r@(Node r_cnt _ _ _) rng
  = Node (zipWith (+) l_cnt r_cnt) l r rng

sp cnt k (l_end, r_end)
  = Node cnt (sp l_cnt k (l_end, mid)) (sp r_cnt k (mid+1, r_end)) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        l_len = mid - l_end + 1
	(l_cnt, r_cnt) = sp'' k cnt l_len

sp' [] _ = ([],[])
sp' (cnt:cnt') l_len
  | cnt <= l_len
  = (cnt:l, 0:r)
  | otherwise
  = (l_len:l,cnt-l_len:r)
  where l_len' = max (l_len - cnt) 0
        (l, r) = sp' cnt' l_len'

sp'' 1 cnt l_len = sp' cnt l_len
sp'' 0 cnt l_len = (l, r)
  where l_len' = sum cnt - l_len
        (r, l) = sp' cnt l_len'

module Main where

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (take 25000 lines) (makeTree s (1,n))

data Tree = Nil | Node [Int] Tree Tree (Int, Int) deriving Show

makeTree [c] r = Node [if c'==c then 1 else 0 | c' <- ['a'..'z']] Nil Nil r

makeTree s r@(l_end, r_end)
  = Node (zipWith (+) left_l right_l) left right r
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left@(Node left_l _ _ _) = makeTree left_s (l_end, mid)
	right@(Node right_l _ _ _) = makeTree right_s (mid + 1, r_end)

pnt Nil
  = ""

pnt (Node cnt l r (l_end, r_end))
  | l_end == r_end
  = [c | (1,c) <- zip cnt ['a'..'z']]
  | otherwise
  = pnt l ++ pnt r

solve :: [String] -> Tree -> IO ()
solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = extract i j t
	t' = replace i j k cnt t

extract l r (Node cnt l_ch r_ch (l_end, r_end))
  | l <= l_end && r_end <= r
  = cnt
  | r < l_end || r_end < l
  = [0,0..]
  | otherwise
  = zipWith (+) (extract l r l_ch) (extract l r r_ch)

replace l r k cnt node@(Node _ _ _ (l_end, r_end))
  | r < l_end || r_end < l
  = node
  | l == l_end && r == r_end
  = sp cnt k (l_end, r_end)
  | otherwise
  = replace' l r k cnt node

replace' l r k cnt node@(Node _ l_ch r_ch (l_end, r_end))
  | mid < l
  = makeNode l_ch (replace l r k cnt r_ch) (l_end, r_end)
  | r <= mid
  = makeNode (replace l r k cnt l_ch) r_ch (l_end, r_end)
  | otherwise
  = makeNode (replace l mid k l_cnt l_ch) (replace (mid+1) r k r_cnt r_ch) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        (l_cnt, r_cnt) = sp'' k cnt (mid - l + 1)

makeNode l@(Node l_cnt _ _ _) r@(Node r_cnt _ _ _) rng
  = Node (zipWith (+) l_cnt r_cnt) l r rng

sp cnt k (l_end, r_end)
  = Node cnt (sp l_cnt k (l_end, mid)) (sp r_cnt k (mid+1, r_end)) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        l_len = mid - l_end + 1
	(l_cnt, r_cnt) = sp'' k cnt l_len

sp' [] _ = ([],[])
sp' (cnt:cnt') l_len
  | cnt <= l_len
  = (cnt:l, 0:r)
  | otherwise
  = (l_len:l,cnt-l_len:r)
  where l_len' = max (l_len - cnt) 0
        (l, r) = sp' cnt' l_len'

sp'' 1 cnt l_len = sp' cnt l_len
sp'' 0 cnt l_len = (l, r)
  where l_len' = sum cnt - l_len
        (r, l) = sp' cnt l_len'

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (take 1000 lines) (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (length cnt) (solve s' t')
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t []
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)}) res
  | q_r < l_end || r_end < q_l    = res
  | content node == Nothing       = extract q_l q_r (l node) (extract q_l q_r (r node) res)
  | q_l <= l_end && r_end <= q_r  = (fromJust $ content node) ++ res
  | otherwise                     = extract q_l q_r (l node) (extract q_l q_r (r node) res)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = node {
      content = Just cnt',
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = [c | Just c <- map (mask (l_end, r_end)) cnt]

mask (l, r) item@(c, (l_end, r_end))
  | r < l_end || r_end < l = Nothing
  | otherwise              = Just (c, (max l_end l, min r_end r))

module Main where

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (take 5000 lines) (makeTree s (1,n))

data Tree = Nil | Node [Int] Tree Tree (Int, Int) deriving Show

makeTree [c] r = Node [if c'==c then 1 else 0 | c' <- ['a'..'z']] Nil Nil r

makeTree s r@(l_end, r_end)
  = Node (zipWith (+) left_l right_l) left right r
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left@(Node left_l _ _ _) = makeTree left_s (l_end, mid)
	right@(Node right_l _ _ _) = makeTree right_s (mid + 1, r_end)

pnt Nil
  = ""

pnt (Node cnt l r (l_end, r_end))
  | l_end == r_end
  = [c | (1,c) <- zip cnt ['a'..'z']]
  | otherwise
  = pnt l ++ pnt r

solve :: [String] -> Tree -> IO ()
solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = extract i j t
	t' = replace i j k cnt t

extract l r (Node cnt l_ch r_ch (l_end, r_end))
  | l <= l_end && r_end <= r
  = cnt
  | r < l_end || r_end < l
  = [0,0..]
  | otherwise
  = zipWith (+) (extract l r l_ch) (extract l r r_ch)

replace l r k cnt node@(Node _ _ _ (l_end, r_end))
  | r < l_end || r_end < l
  = node
  | l == l_end && r == r_end
  = sp cnt k (l_end, r_end)
  | otherwise
  = replace' l r k cnt node

replace' l r k cnt node@(Node _ l_ch r_ch (l_end, r_end))
  | mid < l
  = makeNode l_ch (replace l r k cnt r_ch) (l_end, r_end)
  | r <= mid
  = makeNode (replace l r k cnt l_ch) r_ch (l_end, r_end)
  | otherwise
  = makeNode (replace l mid k l_cnt l_ch) (replace (mid+1) r k r_cnt r_ch) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        (l_cnt, r_cnt) = sp'' k cnt (mid - l + 1)

makeNode l@(Node l_cnt _ _ _) r@(Node r_cnt _ _ _) rng
  = Node (zipWith (+) l_cnt r_cnt) l r rng

sp cnt k (l_end, r_end)
  = Node cnt (sp l_cnt k (l_end, mid)) (sp r_cnt k (mid+1, r_end)) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        l_len = mid - l_end + 1
	(l_cnt, r_cnt) = sp'' k cnt l_len

sp' [] _ = ([],[])
sp' (cnt:cnt') l_len
  | cnt <= l_len
  = (cnt:l, 0:r)
  | otherwise
  = (l_len:l,cnt-l_len:r)
  where l_len' = max (l_len - cnt) 0
        (l, r) = sp' cnt' l_len'

sp'' 1 cnt l_len = sp' cnt l_len
sp'' 0 cnt l_len = (l, r)
  where l_len' = sum cnt - l_len
        (r, l) = sp' cnt l_len'

module Main where

import Data.List
import Data.Maybe

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve [last lines] (makeTree s (1,n))

m True  x _ = x
m False _ y = y

data Tree = Nil | Node { content :: Maybe [(Char,(Int,Int))], l, r :: Tree, rng :: (Int, Int) }
  deriving Show

makeTree [c] rng = Node { content = Just [(c, rng)], l = Nil, r = Nil, rng = rng }

makeTree s rng@(l_end, r_end)
  = Node { content = Nothing, l = left, r = right, rng = rng }
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left = makeTree left_s (l_end, mid)
        right = makeTree right_s (mid + 1, r_end)

pnt node@(Node{content = Nothing})  = pnt (l node) ++ pnt (r node)
pnt node@(Node{content = Just cnt}) = concat $ map (\(c,(l,r))->replicate (r-l+1) c) cnt

solve [] t = putStrLn $ pnt t
solve (s:s') t = seq (length cnt) (solve s' t')
  where [i,j,k] = map read $ words s
        cnt = integrate i j k $ extract i j t []
        t' = replace i j cnt t

extract q_l q_r node@(Node{rng=(l_end,r_end)}) res
  | q_r < l_end || r_end < q_l    = res
  | content node == Nothing       = extract q_l q_r (l node) (extract q_l q_r (r node) res)
  | q_l <= l_end && r_end <= q_r  = (fromJust $ content node) ++ res
  | otherwise                     = extract q_l q_r (l node) (extract q_l q_r (r node) res)

integrate :: Int -> Int -> Int -> [(Char,(Int,Int))] -> [(Char,(Int,Int))]
integrate l_end r_end k ls
  = integrate' ls' l_end
  where ls' = init
            $ foldr (\(c,n) ((c',n'):etc)->m (c==c') ((c,n+n'):etc) ((c,n):(c',n'):etc)) [('?',0)]
            $ m (k==0) reverse id
            $ map (\(c,(l_end,r_end))->(c,r_end-l_end + 1)) $ sort ls

integrate' [] _ = []
integrate' ((c,n):etc) l_end = (c,(l_end,l_end+n-1)) : integrate' etc (l_end+n)

replace q_l q_r cnt node@(Node{rng=(l_end, r_end)})
  | q_r < l_end || r_end < q_l    = node
  | q_l <= l_end && r_end <= q_r  = node {
      content = Just cnt',
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  | otherwise                     = node {
      content = Nothing,
      l       = replace q_l q_r cnt' (l node),
      r       = replace q_l q_r cnt' (r node)
    }
  where cnt' = [c | Just c <- map (mask (l_end, r_end)) cnt]

mask (l, r) item@(c, (l_end, r_end))
  | r < l_end || r_end < l = Nothing
  | otherwise              = Just (c, (max l_end l, min r_end r))

module Main where

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (take 10 lines) (makeTree s (1,n))

data Tree = Nil | Node [Int] Tree Tree (Int, Int) deriving Show

makeTree [c] r = Node [if c'==c then 1 else 0 | c' <- ['a'..'z']] Nil Nil r

makeTree s r@(l_end, r_end)
  = Node (zipWith (+) left_l right_l) left right r
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left@(Node left_l _ _ _) = makeTree left_s (l_end, mid)
	right@(Node right_l _ _ _) = makeTree right_s (mid + 1, r_end)

pnt Nil
  = ""

pnt (Node cnt l r (l_end, r_end))
  | l_end == r_end
  = [c | (1,c) <- zip cnt ['a'..'z']]
  | otherwise
  = pnt l ++ pnt r

solve :: [String] -> Tree -> IO ()
solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = extract i j t
	t' = replace i j k cnt t

extract l r (Node cnt l_ch r_ch (l_end, r_end))
  | l <= l_end && r_end <= r
  = cnt
  | r < l_end || r_end < l
  = [0,0..]
  | otherwise
  = zipWith (+) (extract l r l_ch) (extract l r r_ch)

replace l r k cnt node@(Node _ _ _ (l_end, r_end))
  | r < l_end || r_end < l
  = node
  | l == l_end && r == r_end
  = sp cnt k (l_end, r_end)
  | otherwise
  = replace' l r k cnt node

replace' l r k cnt node@(Node _ l_ch r_ch (l_end, r_end))
  | mid < l
  = makeNode l_ch (replace l r k cnt r_ch) (l_end, r_end)
  | r <= mid
  = makeNode (replace l r k cnt l_ch) r_ch (l_end, r_end)
  | otherwise
  = makeNode (replace l mid k l_cnt l_ch) (replace (mid+1) r k r_cnt r_ch) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        (l_cnt, r_cnt) = sp'' k cnt (mid - l + 1)

makeNode l@(Node l_cnt _ _ _) r@(Node r_cnt _ _ _) rng
  = Node (zipWith (+) l_cnt r_cnt) l r rng

sp cnt k (l_end, r_end)
  = Node cnt (sp l_cnt k (l_end, mid)) (sp r_cnt k (mid+1, r_end)) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        l_len = mid - l_end + 1
	(l_cnt, r_cnt) = sp'' k cnt l_len

sp' [] _ = ([],[])
sp' (cnt:cnt') l_len
  | cnt <= l_len
  = (cnt:l, 0:r)
  | otherwise
  = (l_len:l,cnt-l_len:r)
  where l_len' = max (l_len - cnt) 0
        (l, r) = sp' cnt' l_len'

sp'' 1 cnt l_len = sp' cnt l_len
sp'' 0 cnt l_len = (l, r)
  where l_len' = sum cnt - l_len
        (r, l) = sp' cnt l_len'

module Main where

main = do
  line1 <- getLine
  let [n, q] = map read $ words line1
  s <- getLine
  lines <- sequence [getLine | _ <- [1..q]]
  if n < 1000 then solve lines (makeTree s (1,n))
              else solve (take 1000 lines) (makeTree s (1,n))

data Tree = Nil | Node [Int] Tree Tree (Int, Int) deriving Show

makeTree [c] r = Node [if c'==c then 1 else 0 | c' <- ['a'..'z']] Nil Nil r

makeTree s r@(l_end, r_end)
  = Node (zipWith (+) left_l right_l) left right r
  where mid = (l_end + r_end) `div` 2
        (left_s, right_s) = splitAt (mid - l_end + 1) s
        left@(Node left_l _ _ _) = makeTree left_s (l_end, mid)
	right@(Node right_l _ _ _) = makeTree right_s (mid + 1, r_end)

pnt Nil
  = ""

pnt (Node cnt l r (l_end, r_end))
  | l_end == r_end
  = [c | (1,c) <- zip cnt ['a'..'z']]
  | otherwise
  = pnt l ++ pnt r

solve :: [String] -> Tree -> IO ()
solve [] t = putStrLn $ pnt t
solve (s:s') t = solve s' t'
  where [i,j,k] = map read $ words s
        cnt = extract i j t
	t' = replace i j k cnt t

extract l r (Node cnt l_ch r_ch (l_end, r_end))
  | l <= l_end && r_end <= r
  = cnt
  | r < l_end || r_end < l
  = [0,0..]
  | otherwise
  = zipWith (+) (extract l r l_ch) (extract l r r_ch)

replace l r k cnt node@(Node _ _ _ (l_end, r_end))
  | r < l_end || r_end < l
  = node
  | l == l_end && r == r_end
  = sp cnt k (l_end, r_end)
  | otherwise
  = replace' l r k cnt node

replace' l r k cnt node@(Node _ l_ch r_ch (l_end, r_end))
  | mid < l
  = makeNode l_ch (replace l r k cnt r_ch) (l_end, r_end)
  | r <= mid
  = makeNode (replace l r k cnt l_ch) r_ch (l_end, r_end)
  | otherwise
  = makeNode (replace l mid k l_cnt l_ch) (replace (mid+1) r k r_cnt r_ch) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        (l_cnt, r_cnt) = sp'' k cnt (mid - l + 1)

makeNode l@(Node l_cnt _ _ _) r@(Node r_cnt _ _ _) rng
  = Node (zipWith (+) l_cnt r_cnt) l r rng

sp cnt k (l_end, r_end)
  = Node cnt (sp l_cnt k (l_end, mid)) (sp r_cnt k (mid+1, r_end)) (l_end, r_end)
  where mid = (l_end + r_end) `div` 2
        l_len = mid - l_end + 1
	(l_cnt, r_cnt) = sp'' k cnt l_len

sp' [] _ = ([],[])
sp' (cnt:cnt') l_len
  | cnt <= l_len
  = (cnt:l, 0:r)
  | otherwise
  = (l_len:l,cnt-l_len:r)
  where l_len' = max (l_len - cnt) 0
        (l, r) = sp' cnt' l_len'

sp'' 1 cnt l_len = sp' cnt l_len
sp'' 0 cnt l_len = (l, r)
  where l_len' = sum cnt - l_len
        (r, l) = sp' cnt l_len'


import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: ByteString -> Int
solve line = foldl loop 0 $ zip tok len
    where
    tok = C.groupBy (\_ i -> i == '0') line :: [ByteString]
    len = scanl (+) 0 $ map C.length tok :: [Int]

    loop :: Int -> (ByteString, Int) -> Int
    loop acc (a, k) = case k `compare` C.length a of
        GT -> 1 + acc
        LT -> 1
        EQ -> if C.take k line < a then 1 else 1 + acc

main = B.getLine >>= print . solve . C.init

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-}

import Data.Char
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Array.IArray
import Debug.Trace
import Data.List (maximumBy)
import Data.Ord (comparing)
import Control.Monad (forM_)
import Text.Printf (printf)

debug :: Show a => String -> a -> a
debug label a = trace msg a
  where msg = "=== " ++ label ++ ": " ++ show a

debug2 :: Show a => String -> a -> b -> b
debug2 label a b = debug label a `seq` b

-- compare two substrings of a bytestring
cmpbs :: ByteString -> (Int,Int) -> (Int,Int) -> Ordering
-- cmpbs bs (alo,ahi) (blo,bhi) | debug2 "cmpbs" ((alo,ahi),(blo,bhi)) False = undefined
cmpbs bs (alo,ahi) (blo,bhi) =
  case (ahi-alo) `compare` (bhi-blo) of
    GT -> GT
    LT -> LT
    EQ -> cmpbs' bs alo ahi blo

-- compare two substrings of equal length
cmpbs' :: ByteString -> Int -> Int -> Int -> Ordering
cmpbs' bs ai ahi bi | ai > ahi = EQ
cmpbs' bs ai ahi bi =
  case (bs `BS.index` ai) `compare` (bs `BS.index` bi) of
    GT -> GT
    LT -> LT
    EQ -> cmpbs' bs (ai+1) ahi (bi+1)

bestSol :: ByteString -> Int -> Int -> [(Int,Int)]
bestSol bs lo hi | lo > hi = []
bestSol bs lo hi = [(k,hi)] ++ bestSol bs lo (k-1)
  where
    k' = head [ i | i <- [hi,hi-1..lo], BS.index bs i /= '0' ]
    k = if cmpbs bs (lo,k'-1) (k',hi) >= EQ then k' else lo

best :: ByteString -> Int -> Int -> Int
best bs lo hi = go hi 0
  where
    go hi a | hi < lo = a
    go hi a = go (k-1) (a+1)
      where
        k' = head [ i | i <- [hi,hi-1..lo], BS.index bs i /= '0' ]
        k = if cmpbs bs (lo,k'-1) (k',hi) >= EQ then k' else lo

(-->) = flip fmap

showBSSolution :: ByteString -> [(Int,Int)] -> IO ()
showBSSolution bs sols = do
  forM_ sols $ \(a,b) -> do
    putStrLn $ printf "%3d - %3d : %s" a b [ BS.index bs i | i <- [a..b] ]
  putStrLn $ printf "length: %d" (length sols)

main = do
  digits <- BS.getLine --> BS.filter isDigit
  let n = BS.length digits
  print $ best digits 0 (n-1)


import Data.List
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
pairs (x:y:zs) = (y,x) : pairs zs
pairs _ = []
main = do
  (n:m:ns) <- liftM (unfoldr (B.readInt . B.dropWhile (not . isDigit))) B.getContents
  let (ms,cs) = splitAt (2*n) ns
      ms' = sort (pairs ms)
      cs' = sort (pairs cs)
  putStrLn $ show (commonBy fst ms' cs' 0) ++ " " ++
             show (commonBy id ms' cs' 0)
commonBy f (a:as) (b:bs) c | f a < f b = commonBy f as (b:bs) c
                           | f a > f b = commonBy f (a:as) bs c
                           | otherwise = commonBy f as bs $! c+1
commonBy _ _ _ c = c

import Data.List

minus as [] = as
minus [] _ = []
minus (a : as) (b : bs) = case compare a b of
  LT -> a : minus as (b : bs)
  EQ -> minus as bs
  GT -> minus (a : as) bs

f a b = (length a - length a', (a', b `minus` a)) where
  a' = a `minus` b

g(a,b)=case f a b of
  (n1, (a', b')) -> case f (map head a') (map head b') of
    (n2, _) -> [n1 + n2, n1]
j(a,b)=g(sort a,sort b)
s([_,n]:l)=j$splitAt n l
main=interact$unwords.map show.s.map(reverse.map(foldl(\a c->a*10+fromEnum c-fromEnum '0')0).words).lines

import Array ((!), accumArray)
import Control.Monad (liftM)
import Data.IntMap (IntMap, intersectionWith, fold, fromListWith)

--------------------------------------------------------------------------------
{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq (3,2) $ solve [(1,2), (3,4), (2,4)] [(5,4), (2,4), (1,1), (1,2)],
    Test "2" $ assertEq (1,0) $ solve [(1,2), (2,1)] [(3,4), (5,1)]
  ]

testManyEquals :: Test
testManyEquals  =  Test "TestManyEquals" $
    assertEq (n, n) $ solve
        [(1 + mod i maxN, 1 + mod i maxN) | i <- [1..n]]
        [(1 + mod i maxN, 1 + mod i maxN) | i <- [1..n]]
  where
    n  =  10^5

testManyEqualsDiametr :: Test
testManyEqualsDiametr  =  Test "TestManyEqualsDiametr" $
    assertEq (n, 0) $ solve
        [(1 + mod i maxN, 1 + mod i maxN) | i <- [1..n]]
        [(1 + mod (i+1) maxN, 1 + mod i maxN) | i <- [1..n]]
  where
    n  =  10^5

testMany :: Test
testMany  =  Test "TestMany" $
    assertEq (0, 0) $ solve
        [(1, 1 + mod (2*i + 1) maxN) | i <- [1..n]]
        [(1, 1 + mod (2*i) maxN) | i <- [1..n]]
  where
    n  =  10^5

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    testManyEquals,
    testManyEqualsDiametr,
    testMany
  ]
-}
--------------------------------------------------------------------------------

maxN :: Int
maxN  =  1000

solve :: [(Int, Int)] -> [(Int, Int)] -> (Int, Int)
solve as bs  =  (countOneDiameter, countOneColor)
  where
    mapDCA  =  fromListWith (+) $ map (\(c, d) -> (c * maxN + d, 1)) as
    mapDCB  =  fromListWith (+) $ map (\(c, d) -> (c * maxN + d, 1)) bs
    mapDCAB  =  intersectionWith min mapDCA mapDCB
    countOneColor  =  fold (+) 0 mapDCAB
    asArray'  =  accumArray (+) 0 (1, maxN) [(b, 1) | (a,b) <- as]
    bsArray'  =  accumArray (+) 0 (1, maxN) [(b, 1) | (a,b) <- bs]
    countOneDiameter  =  sum [min (asArray' ! i) (bsArray' ! i) | i <- [1..maxN]]

readPair :: String -> (Int, Int)
readPair line  =  case map read (words line) of
    [a, b]  ->  (a, b)
    _  ->  undefined

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let (n, m)  =  readPair $ head lines'
    let (as, bs)  =  splitAt n $ map readPair $ tail lines'
    let (c, d)  =  solve as bs
    putStrLn $ concat [show c, " ", show d]


module Main
    where

toInts :: [String] -> [Int]
toInts = map read

splitStr :: Int -> String -> [Int]
splitStr n (' ':xs) = n : (splitStr 0 xs)
splitStr n ('1':xs) = splitStr (n * 10 + 1) xs
splitStr n ('2':xs) = splitStr (n * 10 + 2) xs
splitStr n ('3':xs) = splitStr (n * 10 + 3) xs
splitStr n ('4':xs) = splitStr (n * 10 + 4) xs
splitStr n ('5':xs) = splitStr (n * 10 + 5) xs
splitStr n ('6':xs) = splitStr (n * 10 + 6) xs
splitStr n ('7':xs) = splitStr (n * 10 + 7) xs
splitStr n ('8':xs) = splitStr (n * 10 + 8) xs
splitStr n ('9':xs) = splitStr (n * 10 + 9) xs
splitStr n ('0':xs) = splitStr (n * 10 + 0) xs
splitStr n [] = [n]

split s = splitStr 0 s

next :: Char -> [String] -> Char
next ch [] = ch
next ch (x:xs) | ch == (head x)                 = next (head (tail (tail x))) xs
               | ch == (head (tail (tail x)))   = next (head x) xs
               | otherwise                      = next ch xs

mapper a b c d e f g h i j k l m n o p q r s t u v w x y z ch   | ch == 'a' = a
                                                                | ch == 'b' = b
                                                                | ch == 'c' = c
                                                                | ch == 'd' = d
                                                                | ch == 'e' = e
                                                                | ch == 'f' = f
                                                                | ch == 'g' = g
                                                                | ch == 'h' = h
                                                                | ch == 'i' = i
                                                                | ch == 'j' = j
                                                                | ch == 'k' = k
                                                                | ch == 'l' = l
                                                                | ch == 'm' = m
                                                                | ch == 'n' = n
                                                                | ch == 'o' = o
                                                                | ch == 'p' = p
                                                                | ch == 'q' = q
                                                                | ch == 'r' = r
                                                                | ch == 's' = s
                                                                | ch == 't' = t
                                                                | ch == 'u' = u
                                                                | ch == 'v' = v
                                                                | ch == 'w' = w
                                                                | ch == 'x' = x
                                                                | ch == 'y' = y
                                                                | ch == 'z' = z

calc :: [Char] -> (Char -> Char) -> [Char]
calc [] ch = []
calc (x:xs) ch = ((ch x) : (calc xs ch))

readLines 0 = do return []
readLines n = do line <- getLine
                 other <- readLines (n - 1)
                 return (line : other)

main = do   ns <- getLine
            nums <- return (split ns)
            name <- getLine
            c <- readLines (head (tail nums))
            solution <- return (calc name (mapper
                                                (next 'a' c)
                                                (next 'b' c)
                                                (next 'c' c)
                                                (next 'd' c)
                                                (next 'e' c)
                                                (next 'f' c)
                                                (next 'g' c)
                                                (next 'h' c)
                                                (next 'i' c)
                                                (next 'j' c)
                                                (next 'k' c)
                                                (next 'l' c)
                                                (next 'm' c)
                                                (next 'n' c)
                                                (next 'o' c)
                                                (next 'p' c)
                                                (next 'q' c)
                                                (next 'r' c)
                                                (next 's' c)
                                                (next 't' c)
                                                (next 'u' c)
                                                (next 'v' c)
                                                (next 'w' c)
                                                (next 'x' c)
                                                (next 'y' c)
                                                (next 'z' c)
                                ))
            putStrLn solution

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

process :: [String] -> (String, [String])
process str
  = (h, t)
  where
    (h:t) = tail str

change' :: Char -> Char -> [(Char,Char)] -> [(Char,Char)]
change' x y rules
  = map (\(x',y') -> if x == x' then (x,y) else (x',y') ) rules

rep :: [Char] -> [(Char,Char)] -> [(Char,Char)]
rep myPair rules
  = change' x' y ( change' y' x rules )
  where
    [x,y] = myPair
    x' = fromJust $ lookup x revRules
    y' = fromJust $ lookup y revRules
    revRules = zip r2 r1
    (r1,r2)  = unzip rules

initR :: [(Char,Char)]
initR = zip ['a'..'z'] ['a'..'z']

change :: String -> [(Char,Char)] -> String
change str rules
  = map ( fromJust . ( ( flip lookup ) rules ) ) str

solve :: (String, [String]) -> String
solve (str, ops)
  = change str ( foldl (\acc x -> rep ( map head ( words x ) ) acc ) initR ops )

main = ( solve . process . lines) <$> getContents >>= putStrLn

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.DeepSeq
import Control.Exception (assert)
import Control.Monad hiding (foldM)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import Data.Word
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  _ <- getLine
  cs <- getLine
  xys <- map B.head.B.words <$> B.getContents
  putStrLn $ solve cs xys

solve :: String -> String -> String
solve cs xys = [d|c<-cs,let Just d=lookup c table ]
   where
     !table = go (zip['a'..'z']['a'..'z']) xys
     go table (x:y:rest) = table `deepseq` go (swap x y table) rest
     go table _ = table

swap x y table | x == y = table
swap x y table = go table
   where
     go ((from,to):rest)
       | to == x = (from, y):go rest
       | to == y = (from, x):go rest
       | otherwise = (from,to):go rest
     go _ = []

------------------------------------------------------------------------------
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;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM p f=p>>=flip when f
unlessM p f=p>>=flip unless f
{-# INLINE whenM #-}
{-# INLINE unlessM #-}
foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM f a xs=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
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 #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=assert(inRange(bounds a)i).unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;assert(inRange lr i)$unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;assert(inRange lr i)$unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;assert(inRange lr i)$unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import qualified Data.List as L
import qualified Data.HashMap.Lazy as H

main :: IO ()
main = interact parse

parse input =
  let (_:name:tail) = lines input
      designers = map (map head . words) tail
      alpha = switch designers ['a'..'z']
      hash = build_alpha ['a'..'z'] alpha H.empty
  in map (\a -> hash H.! a) name

build_alpha [] [] hash = hash
build_alpha (a:as) (b:bs) hash =
  build_alpha as bs (H.insert a b hash)

switch [] name = name
switch (d:ds) name =
  let name' = case d of
                (x:y:_) -> map (\a -> if a == x then y else if a == y then x else a) name
  in switch ds name'

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
convert::String -> [[String]] -> String
convert s [] = s
convert s ([p,n]:ms) = convert (con s (head p) (head n)) ms
con::String-> Char -> Char -> String
con [] p n = []
con (c:s) p n
  | c==p = n:con s p n
  | c==n = p:con s p n
  | otherwise = c:con s p n
main = do
  [n,m] <- readLists
  s <- getLine
  m <- fmap (map words) $ fmap lines $ getContents
  let a = listArray ('a','z') $ convert ['a'..'z'] m
  putStr $ map (\x -> (a ! x)) s

module Main
    where

toInts :: [String] -> [Int]
toInts = map read

splitStr :: Int -> String -> [Int]
splitStr n (' ':xs) = n : (splitStr 0 xs)
splitStr n ('1':xs) = splitStr (n * 10 + 1) xs
splitStr n ('2':xs) = splitStr (n * 10 + 2) xs
splitStr n ('3':xs) = splitStr (n * 10 + 3) xs
splitStr n ('4':xs) = splitStr (n * 10 + 4) xs
splitStr n ('5':xs) = splitStr (n * 10 + 5) xs
splitStr n ('6':xs) = splitStr (n * 10 + 6) xs
splitStr n ('7':xs) = splitStr (n * 10 + 7) xs
splitStr n ('8':xs) = splitStr (n * 10 + 8) xs
splitStr n ('9':xs) = splitStr (n * 10 + 9) xs
splitStr n ('0':xs) = splitStr (n * 10 + 0) xs
splitStr n [] = [n]

split s = splitStr 0 s

next :: Char -> [String] -> Char
next ch [] = ch
next ch (x:xs) | ch == (head x)                 = next (head (tail (tail x))) xs
               | ch == (head (tail (tail x)))   = next (head x) xs
               | otherwise                      = next ch xs

mapper a b c d e f g h i j k l m n o p q r s t u v w x y z ch   | ch == 'a' = a
                                                                | ch == 'b' = b
                                                                | ch == 'c' = c
                                                                | ch == 'd' = d
                                                                | ch == 'e' = e
                                                                | ch == 'f' = f
                                                                | ch == 'g' = g
                                                                | ch == 'h' = h
                                                                | ch == 'i' = i
                                                                | ch == 'j' = j
                                                                | ch == 'k' = k
                                                                | ch == 'l' = l
                                                                | ch == 'm' = m
                                                                | ch == 'n' = n
                                                                | ch == 'o' = o
                                                                | ch == 'p' = p
                                                                | ch == 'q' = q
                                                                | ch == 'r' = r
                                                                | ch == 's' = s
                                                                | ch == 't' = t
                                                                | ch == 'u' = u
                                                                | ch == 'v' = v
                                                                | ch == 'w' = w
                                                                | ch == 'x' = x
                                                                | ch == 'y' = y
                                                                | ch == 'z' = z

calc :: [Char] -> (Char -> Char) -> [Char]
calc [] ch = []
calc (x:xs) ch = ((ch x) : (calc xs ch))

readLines 0 = do return []
readLines n = do line <- getLine
                 other <- readLines (n - 1)
                 return (line : other)

main = do   ns <- getLine
            nums <- return (split ns)
            name <- getLine
            c <- readLines (head (tail nums))
            solution <- return (calc name (mapper (next 'a' c) (next 'b' c) (next 'c' c) (next 'd' c) (next 'e' c) (next 'f' c) (next 'g' c) (next 'h' c) (next 'i' c) (next 'j' c) (next 'k' c) (next 'l' c) (next 'm' c) (next 'n' c) (next 'o' c) (next 'p' c) (next 'q' c) (next 'e' c) (next 's' c) (next 't' c) (next 'u' c) (next 'v' c) (next 'w' c) (next 'x' c) (next 'y' c) (next 'z' c)))
            putStrLn solution

import Control.Applicative
import Control.Monad

process :: [String] -> (String, [String])
process str
  = (h, t)
  where
    (h:t) = tail str

rep :: [Char] -> String -> String
rep myPair str
  = map (\x' -> rep' x' ) str
  where
    [x,y] = myPair
    rep' x'
      | x == x'   = y
      | y == x'   = x
      | otherwise = x'

solve :: (String, [String]) -> String
solve (str, ops)
  = foldl (\acc x -> rep ( map head ( words x ) ) acc ) str ops

main = ( solve . process . lines) <$> getContents >>= print


import Data.List
solve n = positive - 2 * negetive
  where positive = div (n * n + n) 2
        negetive = sum.filter (<=n) $ [2^x | x <- [0..100]]
main = do
  t <- readLn :: IO Int
  as <- getContents >>= return. map read. lines :: IO [Integer]
  putStrLn.intercalate "\n". map (show.solve) $ as

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

solve :: Integer -> Integer
solve n = (div (n * (n + 1)) 2) - (pow2sum 1 n) * 2

pow2sum :: Integer -> Integer -> Integer
pow2sum p n | p > n = 0
            | otherwise = p + (pow2sum (p * 2) n)

import Data.List (foldl')
import Control.Applicative ((<$>))
import Test.QuickCheck

log2Floor n = floor $ (log $ fromIntegral n) / (log 2)

power2 x = 2^x

trickySum n = integerSum n - 2 * (twoSum n)

-- double is tricky in Haskell, use `div`
integerSum n = n * (n+1) `div` 2

twoSum n = sum (map power2 [0 ..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map trickySum input
  mapM_ print res

main = do
	ns <- (tail . map read . lines) `fmap` getContents

	let solve n = a - 2*b
	     where
		a = n * (n + 1) `div` 2
		p = last $ takeWhile (<= n) $ map (2^) [0..]
  		b = 2*p - 1

	putStr . unlines $ map (show . solve) ns

import Control.Applicative ((<$>))

readInteger :: String -> Integer
readInteger = read
main = do
  nums <- map readInteger . tail . lines <$> getContents
  mapM_ (putStrLn . show) $ map solve nums

solve :: Integer -> Integer
solve n = n * (n + 1) `div` 2 - 2 * (sum . takeWhile (<= n) $ map (2 ^) [0..])

import Control.Applicative

main = do
    ans <- map (show . solve . read) . tail . words <$> getContents
    sequence_ . map putStrLn $ ans

solve n = n * (n + 1) `div` 2 - 2 * (sum . takeWhile (<= n) . map (2 ^) $ [0 ..])

main :: IO ()
main =
  getContents >>= putStr . unlines . map (show . solve . read) . tail . lines
  where
    solve :: Integer -> Integer
    solve n = n * (n + 1) `quot` 2 - 2 * (head $ take 1 $ filter (>n) [2^x | x <- [0..]]) + 2

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

process x = s -s1 -s1
    where s = div ((x+1)*x) 2
          s1 = sum $ takeWhile (<=x) [2^i|i<-[0..]]

main::IO ()
main=do
  getLine
  x<-  map read <$> lines <$> getContents ::IO [Integer]
  mapM_ print $ map process x

main = interact $ unlines . map (show . solve . read) . tail . words
solve n = n*(n+1) `div` 2 - 2^(floor (logBase 2 (fromIntegral n)) + 2) + 2

#!/usr/bin/runhaskell

roundUpToPowerOfTwo :: Integer -> Integer
roundUpToPowerOfTwo x = head (dropWhile (<= x) [2 ^ i | i <- [0 ..]])

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * (roundUpToPowerOfTwo x - 1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ putStrLn (map (show . calcResult . read) (lines contents))

import Data.List
import Data.Bits
import Control.Arrow

solve :: Integer -> Integer
solve = uncurry (+) . ((\x -> (*(-2)) . sum $ takeWhile (<= x) $ map (shiftL 1) [0..]) &&& (\x -> shiftR (x*(x+1)) 1))

main = interact (unlines . map (show . solve . read) . tail . lines)

import Control.Monad (replicateM)

log2 :: Integer -> Integer
log2 = floor . (logBase 2) . fromIntegral

process :: String -> String
process input = show answer
    where
        number = (read :: String -> Integer) input
        answer = number * (number + 1) `div` 2 - 2 * (2 ^ (log2 number + 1) - 1)

main = do
    t_str <- getLine
    inputs <- replicateM (read t_str) getLine
    putStr $ unlines $ map process inputs

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

onecase = do
		x<-read<$>getLine::IO Integer
		let x1 = div (x*(x+1)) 2
		let x2 = length $ takeWhile (>0) [div x (2^i)| i<-[0..]]
		let x3 = x1 +2  -2^(x2+1)
		print x3

main= do
	n<-  read<$> getLine ::IO Int
	replicateM_ n onecase

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 *  (sum . takeWhile (<= x) . map (2^) $ [0..])

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ print (map ( calcResult . read) (lines contents))

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * ((head . dropWhile (<= x) . map (2^) $ [0..])-1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ print (map ( calcResult . read) (lines contents))

powers :: (Integral a) => a -> a
powers 0 = 0
powers n = 1 + 2 * (powers $ n `div` 2)

calculate :: (Integral a) => a -> a
calculate x = x * (x+1) `div` 2 - 2 * powers x

main :: IO ()
main = interact $ unlines . map (show . calculate . read) . tail . words

import Control.Monad

main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    print $ n * (n+1) `div` 2 - 2 * sum (takeWhile (<=n) $ map (2^) [0..])

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal :: (Integral b, Integral a) => a -> b
sumTotal n = floor (allSum n - 2 * (twoSum n))
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map sumTotal input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal n = allSum n - 2 * (twoSum n)
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

main = do
  input <- map readInt . tail . words <$> getLine
  let res = map sumTotal input
  mapM_ print res

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal :: (Integral b, Integral a) => a -> b
sumTotal n = floor (allSum n - 2 * (twoSum n))
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . words <$> getLine
  let res = map sumTotal input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor n = floor $ (log n) / (log 2)

power2 x = 2^x

trickySum n = integerSum n - 2 * (twoSum n)

-- double is tricky in Haskell
integerSum n = round $ ((1+n)*n) * (1/2)

twoSum n = sum (map power2 [0 ..(log2Floor n)])

readInt::String -> Double
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map trickySum input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

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

process x = s -s1 -s1
    where s = div ((x+1)*x) 2
          s1 = sum $ takeWhile (<x) [2^i|i<-[0..]]

main::IO ()
main=do
  getLine
  x<-  map read <$> lines <$> getContents ::IO [Integer]
  mapM_ print $ map process x

#!/usr/bin/runhaskell

roundUpToPowerOfTwo :: Integer -> Integer
roundUpToPowerOfTwo x = head (dropWhile (<= x) [2 ^ i | i <- [0 ..]])

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * (roundUpToPowerOfTwo x - 1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ putStr (map (show . calcResult . read) (lines contents))

import Data.List
import Data.Bits
import Control.Arrow

solve :: Integer -> Integer
solve = uncurry (+) . ((\x -> (*(-2)) . sum $ takeWhile (<= x) $ map (shiftL 1) [0..]) &&& (\x -> shiftR (x*(x+1)) 1))

main = interact (show . unlines . map (show . solve . read) . tail . lines)

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

onecase = do
		x<-read<$>getLine::IO Integer
		let x1 = div (x*(x+1)) 2
		let x2 = length $ takeWhile (>0) [div x (2^i)| i<-[0..]]
		let x3 = x1 +2  -2^x2
		print x3

main= do
	n<-  read<$> getLine ::IO Int
	replicateM_ n onecase


import Data.Char

mu p a b | a == b = a
         | p c = mu p a c
         | otherwise  = mu p (c+1) b
         where c = (a+b) `div` 2
s x = fromIntegral $ sum (map digitToInt $ show x)

f 0 = 0
f x = 10 * f n + 45 * n + s n * k + k*(k-1) `div` 2 where (n,k) = x `divMod` 10
solve :: Integer->[Integer]
solve a | a<=9*200 = [n,n]
        | otherwise = head [ [l,r] |
     k<-[0..200],
     let n9=10^k-1,
     let l = mu (\l->f (10^k) - f l <= a) 0 (10^k),
     l>0,
     let r = head [r | r<-[10^k-1..], f (r+1)-f l >=a],
     f (r+1) - f l == a]
   where
    n=10^(-d)-1-m
    (d,m)=(-a) `divMod` 9
main = interact $ unwords . map show . solve . read

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

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

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

f x = sum $ map (fromIntegral.digitToInt) $ show x

solve :: Integer -> Integer
solve n = go (map (fromIntegral.digitToInt) $ show n) where
    go [] = 0
    go [v] = sum [1..v]
    go (v:vs) = v * ((v-1) * 10 ^ d `div` 2 + d * 10^(d-1) * 45 + decimal vs + 1) + go vs where
        d = fromIntegral $ length vs

solve' l r = solve r - solve (l-1)

hack :: Integer -> (String,String)
hack a = head $ do
    d <- [1..]
    let x = d * 10^(d-1) * 45 + 1
    k <- [(10^(d-1) + x) `div` a .. (10^d + x + a-1) `div` a - 1]
    let vs = k * a - x
    guard $ 10^(d-1) <= vs && vs < 10^d
    return ('1':show vs,show (vs+1))

decimal = foldl (\a b -> a * 10 + b) 0

prop_solve :: Integer -> Bool
prop_solve x = sum (map f [0..x]) == solve x

main :: IO ()
main = do
    a <- readLn
    let (r,l) = hack a
    putStrLn $ unwords [l,r]

import Data.Word (Word64)
import Control.Applicative ((<$>))

cumDigitSum :: Word64 -> Word64
cumDigitSum n = loop n k
    where
    k = last $ takeWhile (\i -> 10^i < n + 1) [0..]
    loop 0 _ = 0
    loop n k = x * 45 * k * 10^(k - 1)
             + (x * (x - 1) `div` 2) * 10^k
             + x * (r + 1) + rest
        where
        (x, r) = n `divMod` (10^k)
        rest = loop r (k - 1)

find :: Word64 -> Word64
find 0 = 0
find a = loop (ub `div` 2) ub
    where
    ub = head . dropWhile ((< a) . cumDigitSum) $ iterate (2*) 1
    loop lb ub
        | lb + 1 == ub = ub
        | cumDigitSum i < a = loop i ub
        | otherwise = loop lb i
        where i = (lb + ub) `div` 2

solve :: Word64 -> (Word64, Word64)
solve a = loop (find a)
    where
    loop r = if x == a + cumDigitSum l then (l + 1, r) else loop (r + 1)
        where
        x = cumDigitSum r
        l = find (x - a)

main = do
    a <- read <$> getLine
    let (l, r) = solve a
    putStrLn $ show l ++ " " ++ show r

import Data.Word (Word64)
import Control.Applicative ((<$>))

cumDigitSum :: Word64 -> Word64
cumDigitSum n = loop n k
    where
    k = last $ takeWhile (\i -> 10^i < n + 1) [0..]
    loop 0 _ = 0
    loop n k = x * 45 * k * 10^(k - 1)
             + (x * (x - 1) `div` 2) * 10^k
             + x * (r + 1) + rest
        where
        (x, r) = n `divMod` (10^k)
        rest = loop r (k - 1)

find :: Word64 -> Word64
find a = loop 0 ub
    where
    ub = head . dropWhile ((< a) . cumDigitSum) $ iterate (2*) 2
    loop lb ub
        | lb + 1 == ub = ub
        | cumDigitSum i < a = loop i ub
        | otherwise = loop lb i
        where i = (lb + ub) `div` 2

solve :: Word64 -> (Word64, Word64)
solve a = loop (find a)
    where
    loop r = if x == a + cumDigitSum l then (l + 1, r) else loop (r + 1)
        where
        x = cumDigitSum r
        l = find (x - a)

main = do
    a <- read <$> getLine
    let (l, r) = solve a
    putStrLn $ show l ++ " " ++ show r

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

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

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

f x = sum $ map (fromIntegral.digitToInt) $ show x

solve :: Integer -> Integer
solve n = go (map (fromIntegral.digitToInt) $ show n) where
    go [] = 0
    go [v] = sum [1..v]
    go (v:vs) = v * ((v-1) * 10 ^ d `div` 2 + d * 10^(d-1) * 45 + decimal vs + 1) + go vs where
        d = fromIntegral $ length vs

solve' l r = solve r - solve (l-1)

hack a = head $ do
    d <- [1..]
    let x = d * 10^(d-1) * 45 + 1
    k <- [(10^(d-1) + x) `div` a .. (10^d + x + a-1) `div` a - 1]
    let vs = k * a - x
    guard $ 10^(d-1) <= vs && vs < 10^d
    return ('1':show vs,show (vs+1))

decimal = foldl (\a b -> a * 10 + b) 0

prop_solve :: Integer -> Bool
prop_solve x = sum (map f [0..x]) == solve x

main = putStrLn "Hello World!"


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

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

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

main = do
    (n,m) <- readIntPair
    tbl <- replicateM n getLine
    print $ solve n m tbl

solve :: Int -> Int -> [String] -> Int
solve n m tbl = go ["" | i <- [1..n]] (transpose tbl) 0 where
    go _   []     !acc = acc
    go cur (l:ls) !acc
        | good cur1 = go cur1 ls acc
        | otherwise = go cur ls (acc+1) where
        cur1 = zipWith (\a b -> a ++ [b]) cur l

good :: [String] -> Bool
good l = and $ zipWith (<=) l (tail l)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

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=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine :: IO [Int]
  css <- transpose.lines <$> getContents
  print $ solve css

solve :: [String] -> Int
solve css0 = go 0 css0
   where
     go !cnt (cs:rest)
       | isAscending cs = go2 cnt (group cs) rest
       | otherwise = go (cnt+1) rest
     go cnt [] = cnt
     go2 !cnt ccs [] = cnt
     go2 !cnt ccs (xs:xss)
        | all isAscending yss = if all((1==).length)yss then cnt
                                else go2 cnt (concatMap group yss) xss
        | otherwise = go2 (cnt+1) ccs xss
      where
        ls = map length ccs
        f (l:ls) cs = take l cs : f ls (drop l cs)
        f _ _ = []
        yss = f ls xs

isAscending :: String -> Bool
isAscending (c:cs) = and $ zipWith (<=) (c:cs) cs
isAscending [] = True

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ [ls]

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

solve :: [[String]] -> Int
solve = go 0
  where
    go acc [] = acc
    go acc xsss = if mustBeRemoved xsss
                  then go (acc+1) (droppedXsss xsss)
                  else go acc (splittedXsss xsss)

    mustBeRemoved :: [[String]] -> Bool
    mustBeRemoved = any (or . headUnordered)

    headUnordered :: [String] -> [Bool]
    headUnordered xss = zipWith ((>) `on` head) xss (tail xss)

    droppedXsss :: [[String]] -> [[String]]
    droppedXsss = filterNotNullMap (filterNotNullMap tail)

    splittedXsss :: [[String]] -> [[String]]
    splittedXsss = filter (not . null) . concatMap collect

    collect :: [String] -> [[String]]
    collect ([_]:_) = []
    collect ((x1:xs1):(x2:xs2):xss')
      | x1 == x2  = (xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')) : (collect . dropWhile ((x1 ==) . head) $ xss')
      | otherwise = collect ((x2:xs2):xss')
    collect _ = []

    filterNotNullMap f = filter (not . null) . map f

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Array.IO
import qualified Data.ByteString.Char8 as B
import           Data.Maybe

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (0, m - 1) False :: IO (IOUArray Int Bool)
  ls <- replicateM n B.getLine
  let iteration = and <$> zipWithM (makeMatch m mismatch) ls (tail ls)
  let iteration2 = iteration >>= (\r -> if r then return True else iteration2)
  void iteration2
  print =<< length <$> filterM (readArray mismatch) [0..m-1]

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO Bool
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return True
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return True
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        return False
        --go (i + 1)

readInts :: B.ByteString -> [Int]
readInts = map (fst . fromJust . B.readInt) . B.words

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

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

main = do
  [n, m] <- getInts
  ls <- replicateM n getLine

  let
    isSorted xs = and $ zipWith (<=) xs $ tail xs

    f :: [[String]] -> Int
    f gs
      | head (head gs) == [] = 0
      | all (isSorted . map head) gs = f $ map (map tail) $ concat $ map (groupBy ((==) `on` head)) gs
      | otherwise = 1 + f (map (map tail) gs)

  print $ f [ls]

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

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

solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss') ++ (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

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

solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Array.IO
import qualified Data.ByteString.Char8 as B
import           Data.Maybe

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (1, m) True :: IO (IOUArray Int Bool)
  ls <- B.lines <$> B.getContents
  zipWithM_ (makeMatch m mismatch) ls (tail ls)

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO ()
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return ()
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return ()
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        go (i + 1)

readInts :: B.ByteString -> [Int]
readInts = map (fst . fromJust . B.readInt) . B.words

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Array.IO
import qualified Data.ByteString.Char8 as B
import           Data.Maybe

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (0, m - 1) False :: IO (IOUArray Int Bool)
  ls <- replicateM n B.getLine
  zipWithM_ (makeMatch m mismatch) ls (tail ls)
  print =<< length <$> filterM (readArray mismatch) [0..m-1]

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO ()
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return ()
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return ()
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        go (i + 1)

readInts :: B.ByteString -> [Int]
readInts = map (fst . fromJust . B.readInt) . B.words

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function
import qualified Data.Set as Set

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

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

solve :: [String] -> Int
solve = Set.size . go 0 Set.empty
  where
    go _ acc []     = acc
    go _ acc ([]:_) = acc
    go i acc xss    = if mustBeRemoved xss
                      then go (i+1) (Set.insert i acc) $ map tail xss
                      else foldr Set.union Set.empty $ map (go (i+1) acc) $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = (xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')) : (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

{-
solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss') ++ (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []
-}

{-
solve :: [String] -> Int
solve = go 0 0
  where
    go :: Int -> [String] -> Int
    go acc _ []     = acc
    go acc _ ([]:_) = acc
    go acc i xss'   = if mustBeRemoved xss'
                        then go (acc + 1) 0 $ map (deleteAt i) xss
                        else go acc (i + 1) xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith (>) takeidx $ tail takeidx
          where takeidx = map (take i) xss'

deleteAt n xs = h ++ t
  where
    (h, _:t) = splitAt n xs
-}


import Control.Monad
import Data.List

main = do
    n' <- getLine
    let n = read n' :: Int
    forM_ [1..n] $ \_ -> do
        getLine
        ns' <- getLine
        let ns = map (\x -> read x :: Int)  $ words ns'
        let a = map (head) $ group $ filter (/= '=')  $ zipWith (\x y -> if x == y then '=' else if y < x then '-' else '+') ns $ tail ns
        putStrLn $ if a  == "" ||  a == "-" || a == "+" || a == "-+" then "YES" else "NO"

collapse :: [Int] -> [Int]
collapse (x : y : xs)
        | x == y = collapse (y : xs)
        | otherwise =  x : collapse (y : xs)
collapse x = x

valleys :: [Int] -> Int
valleys a = edge a + middle a
        where
                middle (x : y : z : xs) = eval + middle (y : z : xs)
                        where eval = if x > y && y < z then 1 else 0
                middle _ = 0
                edge (x : []) = 1
                edge x = bgn + end
                        where
                                bgn = if a < b then 1 else 0
                                end = if c > d then 1 else 0
                                a = head x
                                b = x !! 1
                                d = last x
                                c = last $ take m x
                                m = length x - 1

answer :: Int -> Bool
answer 1 = True
answer _ = False

solve :: [Int] -> Bool
solve = answer . valleys . collapse

everyOther [] = []
everyOther (_ : x : xs) = (x : everyOther xs)

veredict True = "YES"
veredict False = "NO"

main = interact $ unlines . map (veredict . solve . map read . words) . everyOther . drop 1. lines

import Control.Monad
import Data.List

main = do
    n' <- getLine
    let n = read n' :: Int
    forM_ [1..n] $ \_ -> do
        getLine
        ns' <- getLine
        let ns = map (\x -> read x :: Int)  $ words ns'
        let m = minimum ns
        putStrLn $ if (length $ filter (\x ->  head x == m) $ group ns) > 1 then "NO" else "YES"