--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np $ 1 : [x+2, 2*x+2 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, x, y] -> case matchOf n x y of
                        Nothing -> putStrLn "-1"
                        Just as -> mapM_ (\a -> putStr (show a ++ " ")) as >>
                                   putStrLn ""

matchOf :: Int -> Int -> Int -> Maybe [Int]
matchOf n x y | (x /= 0 && y /= 0) || (x == 0 && y == 0) = Nothing
              | otherwise = let k = if x == 0 then y else x in
                              if (mod (n-1) k) == 0
                              then Just $ concatMap (replicate k) [2+k*i | i <- [0..(div (n-1) k)-1]]
                              else Nothing

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ y) 2
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

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

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> Int -> Int -> Maybe [Int]
solve n x y | x > y = solve n y x
solve n 0 0 = Nothing
solve n 0 y | (n - 1) `mod` y == 0  = Just $ L.concatMap (L.replicate y) . L.take ((n - 1) `div` y) $ iterate (+ (y + 1)) 1
solve n _ _ = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let answer = solve n x y
        case answer of
            Just results -> M.forM_ results (printf "%d ") >> printf "\n"
            Nothing -> printf "-1\n"

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,x,y] <- ri
        return (n,x,y)
    mapM_ (putStrLn.showAns.solve) tcs

showAns Nothing = "-1"
showAns (Just xs) = unwords . map show $ xs

solve (_,0,0) = Nothing
solve (n,0,y) = solve (n,y,0)
solve (n,x,0) | (n-1) `mod` x /= 0  = Nothing
              | otherwise           = Just ans
  where
    np = (n-1) `div` x
    winners = take np [1, 1+x+1 ..]
    ans = concatMap (replicate x) $ winners
solve _       = Nothing


g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = 0
f n as bs
  | (null bs) || (not (null as)) && ((head as) < (head bs)) = 1 + f (n - 1) (tail as) bs
  | otherwise = f(n - 1) as (tail bs)
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let k = f n as bs
  putStrLn $ [if x <= (max k (div n 2)) then '1' else '0' | x <- [1..n]]
  putStrLn $ [if x <= (max (n - k) (div n 2)) then '1' else '0' | x <- [1..n]]

g (x:y:[]) = [(x, y)]
g (x:y:s) = (x, y) : g s
f 0 _ _ = (0, 0)
f n [] (b:bs) = (p, q + 1) where (p, q) = f (n - 1) [] bs
f n (a:as) [] = (p + 1, q) where (p, q) = f (n - 1) as []
f n (a:as) (b:bs)
  | a < b = let (p, q) = f (n - 1) as (b:bs) in (p + 1, q)
  | otherwise = (r, s + 1) where (r, s) = f(n - 1) (a:as) bs
main = do
  all <- getContents
  let ns = map read $ words all :: [Int]
  let n = head ns
  let (as, bs) = unzip $ g $ tail ns
  let (an, bn) = f n as bs
  let (man, mbn) = (max an (div n 2), max bn (div n 2))
  putStrLn $ (replicate man '1') ++ (replicate (n - man) '0')
  putStrLn $ (replicate mbn '1') ++ (replicate (n - mbn) '0')


{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns,
  FlexibleContexts,
  TypeApplications,
  MultiWayIf #-}

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

main = do
  [!t] <- readInts
  replicateM_ t solve

solve = do
  [!n, !c, !q] <- readInts
  s <- listArray @UArray (0,n-1) <$> getLine
  cs <- replicateM c $ do
    [!l, !r] <- readInts
    return (l,r)
  qs <- replicateM q (head <$> readInts)
  let go _ [] = []
      go !ind ((l,r):xs) = (ind,l-1,r-1) : go (ind+r-l+1) xs
      cs' = reverse $ go n cs
      find [] i = i
      find ((ind,l,r):xs) i
        | i >= ind = find xs (i - ind + l)
        | otherwise = find xs i
  mapM_ (putStrLn . (:[]) . (s!) . find cs' . subtract  1) qs

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,c,q] <- ri
        s        <- B.takeWhile isPrint <$> B.getLine
        [lrs,qs] <- mapM (`replicateM` ri) [c,q]
        return (s,lrs,qs)
    mapM_ (putStr.showChars.solve) tcs

showChars = unlines . map (:"")

solve (s,lrs,qs) = ans
  where
    (_,offMap) = foldl nxt (B.length s, Map.empty) . map lr2il $ lrs
      where
        lr2il = f  where  f [l,r] = (l, r+1-l)
                          f _     = error "Input error (LR pair)"

        nxt (len, imap) (si,slen) = (len+slen, (len+1) `Map.insert` (len+1-si) $ imap)

    ans = map (B.index s . pred . v2i) qs
      where
        v2i [i] = case (Map.lookupLE i offMap) of
            Nothing      -> i
            Just (_,off) -> v2i [i - off]

        v2i _ = error "Input error (single index expected)"


doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y  = doprob (x:xs) ys
  | x == y = doprob xs ys
  | x < y  = doprob xs ys

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

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)

main = do
   nm <- getLine
   an <- getLine
   bn <- getLine
   let xs = map read (words an) :: [Int]
       ys = map read (words bn) :: [Int]
       ans = solve xs ys
   print ans

solve [] _ = 0
solve xs [] = length xs
solve (x:xs) (y:ys)
   | x <= y    = solve xs ys
   | otherwise = solve (x:xs) ys

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs (y:ys) (acc+1)
    |otherwise  = solve xs ys acc

import Control.Monad

deal [] _ = []
deal as [] = as
deal (a:as) (b:bs)
  | a <= b = deal as bs
  | True = deal (a:as) bs

main = do
  [n, m] <- liftM (map read . words) getLine :: IO [Int]
  as <- liftM (map read . words) getLine :: IO [Int]
  bs <- liftM (map read . words) getLine :: IO [Int]
  putStrLn . show . length $ deal as bs

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe
-- import Debug.Trace

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

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = if a <= b then f as bs else f (a:as) bs

  print $ f as bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | otherwise = 1 + f as bs

solve :: [Int] -> [Int] -> Int
solve [] wants = length wants
solve _ []     = 0
solve (h:ht) ws@(w:wt)
  | h >= w    = solve ht wt
  | otherwise = solve ht ws

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  wants <- getLine --> words --> take n --> map read
  haves <- getLine --> words --> take m --> map read
  print $ solve haves wants

main = do
    getLine
    a<-getLine
    b<-getLine
    putStr $ solve (reverse(map read (words a))) (reverse(map read (words b))) 0
solve::[Int]->[Int]->Int->String
solve [] _ acc = show acc
solve x [] acc = show (length x+acc)
solve (x:xs) (y:ys) acc
    |y<x        = solve xs ys (acc+1)
    |otherwise  = solve xs ys acc

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as _ = length as
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f [] _ = 0
    f _ [] = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  let
    f as [] = length as
    f [] _ = 0
    f (a:as) (b:bs) = (if b >= a then 0 else 1) + f as bs

  print $ f (reverse as) (reverse bs)

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

getInts = fmap (words) getLine

main = do
  [n, m] <- getInts
  as <- getInts
  bs <- getInts

  print $ length $ as \\ bs

main = getContents >>= print . (\[[n, m], a, b] -> n - f a b) . map (map read . words) . lines
f _ [] = 0
f [] _ = 0
f (a:as) (b:bs)
  | b < a = f (a:as) bs
  | b > a = f as (b:bs)
  | b == a = 1 + f as bs

doprob [] ys = 0
doprob xs [] = length xs
doprob (x:xs) (y:ys)
  | x > y = 1 + doprob xs ys
  | x <= y = doprob xs ys

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

main = do
  _ <- getLine
  reqd <- getLine
  george <- getLine
  putStrLn $ show $ doprob (tolist reqd) (tolist george)


{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack, reverse, dropWhile)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)
import Data.Char (isSpace)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

rstrip = C.reverse . C.dropWhile isSpace . C.reverse

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack . rstrip -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

decreaseElem Nothing = Nothing
decreaseElem (Just x) = if x > 1 then (Just (x - 1)) else Nothing

solve [] [] u _ = u
solve [] (t:ts) u f = solve [] ts (t:u) f
solve (s:ss) [] u f = solve ss [s] u (Map.alter decreaseElem s f)
solve (s:ss) (t:ts) u f
 | t <= (fst $ Map.findMin f) = solve (s:ss) ts (t:u) f
 | otherwise = solve ss (s:t:ts) u (Map.alter decreaseElem s f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  putStrLn $ map chr $ reverse $ solve v [] [] (getFreq v Map.empty)

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | s == c
    = if nc > 1
        then solve ss t (s:u) c (nc - 1) f
        else solve ss t (s:u) (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (f Map.! a) f

import Data.List
import qualified Data.IntMap as Map
import Data.Bits
import Data.Int (Int64)
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List
import Data.Char

solve [] [] u _ _ _ = u
solve [] (t:ts) u c nc f = solve [] ts (t:u) c nc f
solve (s:ss) t u c nc f
 | (not.null) t && (head t) <= c = solve (s:ss) (tail t) ((head t):u) c nc f
 | nc == 0 = solve (s:ss) t u (c + 1) (Map.findWithDefault 0 (c + 1) f) (Map.delete c f)
 | s == c = solve ss t (s:u) c (nc - 1) f
 | otherwise = solve ss (s:t) u c nc (Map.insertWith (+) c (-1) f)

getFreq [] f = f
getFreq (x:xs) f = getFreq xs (Map.insertWith (+) x 1 f)

main = do
  v <- (map ord) <$> getLine
  let f = getFreq v Map.empty
      a = ord 'a'
  putStrLn $ map chr $ reverse $ solve v [] [] a (Map.findWithDefault 0 a f) f

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStrLn $ run [] (cmap (L.sort xs) M.empty) xs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (unpack)
import qualified Data.Map.Strict as M (adjust, insert, findMin, empty, alter, member, Map)
import qualified Data.List as L (sort)

run [] _ [] = ""
run (t:ts) _ [] = t:run ts (M.empty) []
run [] mm (x:xs) = run [x] (M.alter f x mm) xs
run (t:ts) mm (x:xs) | t <= ms   = t:run ts mm (x:xs)
                     | otherwise = run (x:t:ts) (M.alter f x mm) xs where
    (ms, _) = M.findMin mm

f (Just 1) = Nothing
f (Just x) = Just (x - 1)

cmap [] m = m
cmap (x:xs) m | M.member x m = cmap xs (M.adjust succ x m)
              | otherwise    = cmap xs (M.insert x 1 m)

main = do
    (C.unpack -> xs) <- B.getLine
    putStr $ run [] (cmap (L.sort xs) M.empty) xs


import Control.Monad

solve :: [Int] -> Int
solve l = max 0 (2*(ma-mi-2))
  where
    ma= maximum l
    mi= minimum l

routine :: IO ()
routine = do
  l <- (map read.words) <$> getLine
  print $ solve l

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

import Control.Monad (replicateM_)
import Data.List (sort)

findMin :: [Int] -> Int
findMin xs = max 0 (2*(mx - mn - 2)) where
    [mn, mid, mx] = sort xs

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

main =
    read <$> getLine >>= \q ->
    replicateM_ q (findMin <$> readLine >>= print)

module Main where

import Control.Monad
import Data.List

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    cas <- readLn
    replicateM_ cas $ do
        [a, b, c] <- sort <$> getList
        print $ cal a b c

cal :: Int -> Int -> Int -> Int
cal a b c
    | a == b && b == c = 0
    | otherwise = max 0 ((c - a) * 2 - 4)


import Control.Applicative
import Data.List
import Data.Char

main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  s <- getLine

  let count = [length $ filter (==c) s | c <- map (chr . (+(ord 'A'))) [0..k-1]]

  print $ minimum count * k

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

main = sol <$> get <*> getLine >>= print

get = map read . words <$> getLine

sol [n,k] s = (* k) . last . take k . sortBy (flip compare) . elems . accumArray (+) 0 ('A','Z') . zip s $ repeat 1

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

longestGoodSubsequence :: Int -> String -> Int
longestGoodSubsequence k s
    | c /= k    = 0
    | otherwise = c * b
        where a = map length $ group $ sort s
              b = minimum a
              c = length a

main :: IO ()
main = do
    [n, k] <- readInts
    s      <- getLine
    print $ longestGoodSubsequence k s

import Data.List
main = interact $ show . solve . tail . words
solve [k,s] | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s

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

main = do
		[n,k]<-map read <$> words <$> getLine ::IO [Int]
		s<-getLine
		let m=  map length $ group $ sort s
		print $ if length m <k then 0 else k*minimum m

{-# LANGUAGE ViewPatterns #-}
module Main where
import Data.Array.Unboxed

main = interact exec
exec = show . (\[_, read -> k, xs] -> solve k xs) . words
solve k xs = (k *) $ minimum $ take k $ elems (accumArray (+) 0 ('A', 'Z') $ zip xs (repeat 1) :: UArray Char Int)

import Data.List (sort, group)

process :: Int -> [Char] -> Int
process k xs = k * minimum (take k $ ls ++ (repeat 0))
    where ls = map length $ group $ sort xs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n, k] <- fmap (map readInt.words) getLine
    xs <- getLine
    print $ process k xs

import Data.List

main = do
       e<-getLine
       e2<-getLine
       let (n:k:[])=map read (words e)::[Int]
           xs=map length $ group $ sort e2
       print $ if k==(length xs) then k*(minimum xs) else 0

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS

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

count :: B8.ByteString -> MapS.Map Char Int
count string = B8.foldr' (flip update) MapS.empty string
    where update map char = MapS.alter (\value -> Just $ 1 + fromMaybe 0 value) char map

main :: IO ()
main = do
    [n, k] <- (map readB8Int) <$> B8.words <$> B8.getLine
    string <- B8.getLine
    let keys = take k ['A'..'Z']
    let counts = count string
    let charCount = foldr1 min . map (\x -> fromMaybe 0 $ MapS.lookup x counts) $ keys
    printf "%d\n" (charCount * k)

import Data.List
main = interact $ show . solve . tail . words
solve (k:s) | length fs < read k = 0
            | otherwise = read k * minimum fs
  where fs = map length $ group $ sort s


import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        map read .words <$> getLine >>= putStrLn . show . solve n k (a+1)

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, (n + 1) `div` (a + 1) - k, fromList [0, n + 1])
    count x y = (y - x) `div` (a + 1)

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf + count u i + count i v - count u v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs

import Data.IntSet (insert, fromList, lookupGT, lookupLE)

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

solve :: [Int]->Int
solve (n:k:a:_:x)  = let tot = (n+1) `div` (a+1)
                         check _ _ _ [] = -1
                         check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`(a+1) + (r-x)`div`(a+1) - (r-l)`div`(a+1)
                     in check (fromList [0, n+1]) 1 tot x

import Data.IntSet (insert,fromList, lookupGT, lookupLE)
import Control.Applicative ((<$>))

main = do
        [n,k,a] <- map read . words <$> getLine
        getLine
        x <-  map read . words <$> getLine
        putStrLn $ show $ solve n k (a+1)  x

solve :: Int->Int->Int->[Int]->Int
solve n k a  = let  tot = (n+1) `div` a
                    check _ _ _ [] = -1
                    check s c t (x:xs) = if t'< k then c else check (insert x s) (c+1) t' xs
                                where Just r = lookupGT x s
                                      Just l = lookupLE x s
                                      t' = t + (x-l)`div`a + (r-x)`div`a - (r-l)`div`a
                in check (fromList [0, n+1]) 1 tot

import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Set (Set, fromList, lookupLT, lookupGT, insert)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: Int -> Int -> Int -> [Int] -> Int
solve n k a xs = foldr loop (`seq` -1) xs init
    where
    init = (1, n `div` a - k, fromList [0, n + 1])
    count x y = (y - x - 1) `div` a

    loop i f (acc, buf, obs)
        | buf' < 0  = acc
        | otherwise = f (acc + 1, buf', i `insert` obs)
        where
        u = fromJust $ i `lookupLT` obs
        v = fromJust $ i `lookupGT` obs
        buf' = buf - count u v + count u i + count i v

main = do
    [n, k, a] <- parse <$> B.getLine
    B.getLine
    xs <- parse <$> B.getLine
    print $ solve n k a xs


{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , j <- [0..7]
        -- , x || (mask .&. i) == mask
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j)
          | isOne || (mask .&. i) == mask = do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray, Ix (range))
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          let gg = (go c1 c2 x)
          mapM_  gg indices
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray, Ix (range))
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          mapM_ (go c1 c2 x) indices
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray, Ix (range))
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 xs
    where
      gogo :: Count -> [Bool] -> IO Count
      gogo c1 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          c2 <- newArray ((0, 0), (7, 7)) 0
          mapM_ (go c1 c2 x) indices
          resetArray c1
          gogo c2 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray, Ix (range))
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int,Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

resetArray ::  Count -> IO ()
resetArray x = mapM_ (flip (writeArray x) 0) $ range ((0,0), (7,7))

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray ((0, 0), (7, 7)) 0
    c2 <- newArray ((0, 0), (7, 7)) 0
    writeArray c1 (0,0) 1
    gogo c1 c2 xs
    where
      gogo :: Count -> Count -> [Bool] -> IO Count
      gogo c1 c2 xs = case xs of
        [] -> return c1
        (x:xs) -> do
          mapM_ (go c1 c2 x)  indices
          resetArray c1
          gogo c2 c1 xs
      indices = [(mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]]
      go ::
        Count
        -> Count
        -> Bool
        -> (Int -- mask
        ,   Int -- prefix less
        ,   Int )
        -> IO ()
      go c1 c2 isOne (mask, i, j)
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i,  j)
            val2 <- readArray c2 (ni, nj)
            writeArray c2 (ni, nj) (val1+val2 `mod` mm)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , j <- [0..7]
        , x || (mask .&. i) == mask
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        |
        (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            -- print (k, i, j)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        |
        (k, x) <- zip [0..length xs-1] xs
        , mask <-[0..7]
        , i <- [0..7]
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            print (k, i, j)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | mask <-[0..7]
        , i <- [0..7]
        , (k, x) <- zip [0..length xs-1] xs
        , x || (mask .&. i) == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits
import Data.Ix (Ix(range))

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray (Int, Int, Int) Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c <- newArray ((0, 0, 0), (length xs, 7, 7)) 0
    writeArray c (0,0,0) 1
    mapM_ (go c) $ indices xs
    return c
    where
      indices :: [Bool] -> [(Int, Bool, Int, Int, Int)]
      indices xs = [(k, x ,mask, i, j)
        | mask <-[0..7]
        , i <- [0..7]
        , (k, x) <- zip [0..length xs-1] xs
        , x || mask .&. i == mask
        , j <- [0..7]
         ]
      go ::
        Count
        -> (
          Int -- index for xs
        , Bool
        , Int -- mask
        ,  Int -- prefix less
        ,  Int) -- minor
        -> IO ()
      go c (k, isOne, mask, i, j) =
          do
            v1 <- readArray c (k, i, j)
            v2 <- readArray c (k+1, ni,nj)
            writeArray c (k+1,ni,nj) (v1+v2 `mod` mm)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

a :: Integer
a = 2
main :: IO ()
main = do
  -- print (range ((0,0),(7,7)) )
  -- print $ 2 ^ 200000
  xs <- parse
  res <- solve1 xs
  printAns =<< (foldr (((`mod` mm).) . (+)) 0) <$> sequence (readArray res <$> [(length xs, i, 7) |i <- [0..7]])
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'))
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = Map.IntMap Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> Count
solve1 xs = foldl
  (\m (k, a) ->  foldr (\(mask, g) m1 ->  go m m1 a k mask (g`div`8) (g`mod`8)) Map.empty $ liftM2 (,) [0..7] (Map.keys m))
  (Map.fromList [((0 `gi` 0),1)])
  (zip [0..] xs)
    where
      updateX :: Int -> Maybe Int -> Maybe Int
      updateX x Nothing = Just x
      updateX x (Just y) = Just (x+y)
      inject :: Count -> (Int, Int) -> Count
      inject c (k, v) = Map.alter (updateX v) k c

      go ::
        Count
        -> Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> Count
      go c c2 isOne k mask i j
        | isOne || (mask .&. i) == mask = inject c2 ((ni`gi`nj), c Map.! (i `gi` j))
        | otherwise = inject c2 ((0`gi`0),0)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve :: Solver
solve xs = (`mod` mm) $ sum $ Map.elems $ Map.filterWithKey (\k _ -> k`mod`8==7) $ solve1 xs

main :: IO ()
main = do
  printAns =<< solve <$> parse
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'))
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = Map.IntMap Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 8 + j

solve1 :: [Bool] -> Count
solve1 xs = foldl
  (\m ys -> Map.fromListWith (((`mod` mm).) . (+)) $ (\(isOne, k, mask,i,j) -> go m isOne k mask i j) <$> ys (Map.keys m))
  (Map.fromList [((0 `gi` 0),1)])
  indices
    where
      indices =
        [\keys -> [(xs!!k, k, mask, g `div` 8, g `mod` 8) | mask <-[0..7],g <- keys ] | k <- [0..length xs-1]]
      go :: Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> (Int, Int)
      go c isOne k mask i j
        | isOne || (mask .&. i) == mask = ((ni`gi`nj), c Map.! (i `gi` j))
        | otherwise = ((0`gi`0),0)
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve :: Solver
solve xs = (`mod` mm) $ sum $ Map.elems $ Map.filterWithKey (\k _ -> k`mod`10==7) $ solve1 xs

main :: IO ()
main = do
  printAns =<< solve <$> parse
  return ()

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.IntMap as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems, MArray)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'))
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Data.Bits

mm = 998244353
type Domain = [Bool]
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> C.getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn . show

parse :: IO Domain
parse = do
  xs <- map (=='1') <$> getLine
  return xs

showResult :: [Bool] -> String
showResult xs = (bool '0' '1') <$> xs

type Count = IOUArray Int Int

ones :: Int -> Int
ones 0 = 0
ones 1 = 1
ones i
  | even i = ni
  | odd i = ni + 1
  where ni = ones $ i `div` 2

gi :: Int -> Int -> Int
gi i j = i * 10 + j

solve1 :: [Bool] -> IO Count
solve1 xs = do
    c1 <- newArray (0, 7`gi`7) 0
    writeArray c1 0 1
    foldlM goBig c1 indices
    where
      goBig :: Count -> [(Bool, Int, Int, Int, Int)] -> IO Count
      goBig c1 xs = do
        c2 <- newArray (0, 7`gi`7) 0
        mapM_ (\(isOne, k, mask,i,j) -> go c1 c2 isOne k mask i j) xs
        return c2

      indices = [[(xs!!k, k, mask, i, j) | mask <-[0..7],i <- [0..7], j <- [0..7]] | k <- [0..length xs-1]]
      go ::
        Count
        -> Count
        -> Bool
        -> Int -- count
        -> Int -- mask
        -> Int -- prefix less
        -> Int -- minor
        -> IO ()
      go c1 c2 isOne k mask i j
        | isOne || (mask .&. i) == mask =
          do
            val1 <- readArray c1 (i `gi` j)
            val2 <- readArray c2 (ni`gi`nj)
            writeArray c2 (ni`gi`nj) (val1+val2)
        | otherwise = return ()
          where
            vmask = 7 .&. (complement mask)
            ni = if isOne then i .|. vmask else i
            nj = case ones mask of
              1 -> j .|. mask
              2 -> j .|. vmask
              otherwise -> j

solve2 :: IOUArray Int Int -> Int
solve2 xs = undefined
go :: [Bool] -> IO ()
go bs = do
  na <- newArray (0, length bs -1 ) 0
  let x = solve2 na
  return ()

a :: Int
a = 1 .&. 1

main :: IO ()
main = do
  res <- solve1 =<< parse
  printAns =<< (\x -> mod (sum x) mm) <$> sequence (readArray res <$> [i `gi` 7 |i <- [0..7]])
  -- printAns =<<
  return ()


toArray :: String -> [Int]
toArray = map (read :: String -> Int) . words

process :: [Int] -> Int
process = maximum . compress
    where  compress [] = []
           compress (x : xs) =
               let (pref, suf) = span (==x) xs
               in 1 + length pref : compress suf

main :: IO ()
main = interact (unlines . map (show . process . toArray) . takeEven . tail . lines)
    where takeEven l = map snd $ filter (even . fst) (zip [1..] l)

toArray :: String -> [Int]
toArray = map (read :: String -> Int) . words

process :: [Int] -> Int
process = maximum . compressed
    where compressed [] = []
          compressed (x : xs) = 1 + length (takeWhile (==x) xs) :
                                    compressed (dropWhile (==x) xs)

main :: IO ()
main = interact (unlines . map (show . process . toArray) . takeEven . tail . lines)
    where takeEven l = map snd $ filter (even . fst) (zip [1..] l)


import Data.Int
import Data.List
import Control.Monad

traceShowId = id

main = do
  t <- readLn
  replicateM_ t $ do
    [n,a,b] <- map read . words <$> getLine :: IO [Int64]
    road <- getLine
    print $ solve a b $ group road
solve a b [road] = traceShowId $ a * genericLength road + b * (genericLength road + 1)
solve a b (start:road) = go road $! traceShowId (a * (genericLength (traceShowId start) + 1) + b * (genericLength start + 2))
 where
  go [end] acc = acc + traceShowId (a * (genericLength (traceShowId end) + 1) + b * (genericLength end + 2))
  go (seg@(h:_):road) acc = go road $! acc + (traceShowId $
    case h of '1' -> a * genericLength (traceShowId seg) + 2*b * (genericLength seg - 1)
              '0' -> min (a * (genericLength (traceShowId seg) + 2) + b * (genericLength seg + 3))
                         (a * genericLength seg + 2*b * (genericLength seg + 1))

    )

gint :: IO Int
gint = fmap read getLine
main = do
    t <- gint
    mymain t

mymain 0 = return ()
mymain x = do
    strabc <- getLine
    strbits <- getLine
    let [a,b,c] = map read $ words strabc
    print (fst (solve b c strbits))
    mymain (x - 1)

solve :: Integer -> Integer -> String -> (Integer,Integer)
solve pipeline pillar [] = (pillar, 1000000000000000000)
solve pipeline pillar (b:road)
    | b == '0' = (newdown, newup)
    | b == '1' = (1000000000000000000,  newup1)
    where (down, up) = solve pipeline pillar road
          newup = 2 * pillar + (min (up + pipeline) (down + 2*pipeline) )
          newdown = pillar + (min (up + 2 * pipeline) (down + pipeline) )
          newup1 = 2 * pillar + up + pipeline

import Data.List
import Control.Monad

traceShowId = id

main = do
  t <- readLn
  replicateM_ t $ do
    [n,a,b] <- map read . words <$> getLine
    road <- getLine
    print $ solve a b $ group road
solve a b [road] = traceShowId $ a * length road + b * (length road + 1)
solve a b (start:road) = go road $! traceShowId (a * (length (traceShowId start) + 1) + b * (length start + 2))
 where
  go [end] acc = acc + traceShowId (a * (length (traceShowId end) + 1) + b * (length end + 2))
  go (seg@(h:_):road) acc = go road $! acc + (traceShowId $
    case h of '1' -> a * length (traceShowId seg) + 2*b * (length seg - 1)
              '0' -> min (a * (length (traceShowId seg) + 2) + b * (length seg + 3))
                         (a * length seg + 2*b * (length seg + 1))

    )


import qualified Data.Array as A
import Data.Char (ord)

main = interact $ printAns. uncurry solve. readInp

readInp = prep. tail. lines
    where prep (s:lst:_) = (s, A.listArray (0, 25). fmap read. words $ lst)

printAns (a,b,c) = unlines. map show $ [a,b,c]

solve :: String -> A.Array Int Int -> (Int,Int,Int)
solve s a = d slen
  where slen = length s
        lims = A.listArray (1, slen) (map toLim s)
        toLim = (a A.!). (\x -> x - (ord 'a')). ord

        d 0 = (1,0,0)
        d i = getRes. toVals. okPos $ (reverse [0..i-1])
            where okPos l = map snd. takeWhile isOk. zip (lstLim l) $ l
                  lstLim = scanl1 min. map ((lims A.!). (+1))
                  isOk (a, b) = a >= i - b
                  toVals = map (ds A.!)
                  getRes l = addCur (length l). foldl upd (0,0,10^5) $ l
                  upd (a,b,c) (x,y,z) = (add a x, max b y, min c z)
                  addCur len (a,b,c) = (a, max b len, c+1)

        ds = A.listArray bounds
               [d i | i <- A.range bounds]
        bounds = (0, slen)

        add a b = (a+b) `rem` md
        md = 10^9 + 7

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve n s as0 = [cnt!n, maximum $ zipWith (-) [1..] bs, mc!n]
  where
    as = listArray ('a', 'z') as0 :: UArray Char Int
    bs = map (\(i, c2l) -> foldl (\(!b) (c, l) -> let b' = i - as!c in max b $ min l b') 0 $ assocs c2l) $ zip [1..] $ tail $ scanl (\a p -> a // [p]) (listArray ('a', 'z') (repeat (-9000)) :: UArray Char Int) $ zip s [1..]
    cnt = listArray (-1, n) $ ([0, 1] ++) $ map (\(i, b) -> (ps!(i - 1)) -% (ps!(b - 1))) $ zip [1..] bs :: Array Int Int
    ps = listArray (-1, n) $ scanl1 (+%) $ elems cnt :: Array Int Int
    mc = listArray (0, n) $ (0:) $ map ((+1) . (mc!)) bs :: Array Int Int
    mb = 1000000007
    a +% b = (a + b) `rem` mb
    a -% b = (a - b) `mod` mb

main = do
  n <- fmap readInt B.getLine
  s <- getLine
  as <- fmap readInts B.getLine
  putStr $ unlines $ map show $ solve n s as

import qualified Data.Array as A
import Data.Char (ord)

main = interact $ printAns. uncurry solve. readInp

readInp = prep. tail. lines
    where prep (s:lst:_) = (s, A.listArray (0, 25). fmap read. words $ lst)

printAns (a,b,c) = unlines. map show $ [a,b,c]

solve :: String -> A.Array Int Int -> (Int,Int,Int)
solve s a = d slen
  where slen = length s
        lims = A.listArray (1, slen) (map toLim s)
        toLim = (a A.!). (\x -> x - (ord 'a')). ord

        d 0 = (1,0,0)
        d i = getRes. toVals. okPos $ (reverse [0..i-1])
            where okPos l = map snd. takeWhile isOk. zip (lstLim l) $ l
                  lstLim = scanl1 min. map ((lims A.!). (+1))
                  isOk (a, b) = a >= dist i b
                  dist = (-)
                  toVals = map (ds A.!)
                  getRes l = addCur (length l). foldl upd (0,0,10^5) $ l
                  upd (a,b,c) (x,y,z) = (add a x, max b y, min c z)
                  addCur len (a,b,c) = (a, max b len, c+1)

        ds = A.listArray bounds
               [d i | i <- A.range bounds]
        bounds = (0, slen)

        add a b = (a+b) `rem` md
        md = 10^9 + 7

import qualified Data.Array as A
import Data.Char (ord)

main = interact $ printAns. uncurry solve. readInp

readInp = prep. tail. lines
    where prep (s:lst:_) = (s, A.listArray (0, 25). fmap read. words $ lst)

printAns (a,b,c) = unlines. map show $ [a,b,c]

solve :: String -> A.Array Int Int -> (Int,Int,Int)
solve s a = d slen
  where slen = length s
        lims = A.listArray (1, slen) (map toLim s)
        toLim = (a A.!). (flip (-) (ord 'a')). ord

        d 0 = (1,0,0)
        d i = getRes. toVals. okPos $ (reverse [0..i-1])
            where okPos l = map snd. takeWhile isOk. zip (lstLim l) $ l
                  lstLim = scanl1 min. map ((lims A.!). (+1))
                  isOk (a, b) = a >= dist i b
                  dist = (-)
                  toVals = map (ds A.!)
                  getRes l = addCur (length l). foldl upd (0,0,10^5) $ l
                  upd (a,b,c) (x,y,z) = (add a x, max b y, min c z)
                  addCur len (a,b,c) = (a, max b len, c+1)

        ds = A.listArray bounds
               [d i | i <- A.range bounds]
        bounds = (0, slen)

        add a b = (a+b) `rem` md
        md = 10^9 + 7

import qualified Data.Array as A
import Data.Char (ord)

main = interact $ printAns. uncurry solve. readInp

readInp = prep. tail. lines
    where prep (s:lst:_) = (s, A.listArray (0, 25). fmap read. words $ lst)

printAns (a,b,c) = unlines. map show $ [a,b,c]

solve :: String -> A.Array Int Int -> (Int,Int,Int)
solve s a = d slen
  where slen = length s
        lims = A.listArray (1, slen) (map toLim s)
        toLim = (a A.!). (flip (-) (ord 'a')). ord

        d 0 = (1,0,0)
        d i = getRes. toVals. okPos $ (reverse [0..i-1])
            where okPos l = map snd. takeWhile isOk. zip (lstLim l) $ l
                  lstLim = scanl1 min. map ((lims A.!). (+1))
                  isOk (a, b) = a >= dist i b
                  dist = (-)
                  toVals = map (ds A.!)
                  getRes l = addCur (length l). foldl upd (0,0,10^5) $ l
                  upd (a,b,c) (x,y,z) = (a + x, max b y, min c z)
                  addCur len (a,b,c) = (a, max b len, c+1)

        ds = A.listArray bounds
               [d i | i <- A.range bounds]
        bounds = (0, slen)

        add a b = (a+b) `rem` md
        md = 10^9 + 7


import Data.List (transpose)

solve :: [String] -> Maybe [(Int, Int)]
solve ss
  | findELine ss && findELine (transpose ss)  =  Nothing
  | not $ findELine ss  =  Just $ solve' ss
  | otherwise  =  Just $ map swap $ solve' $ transpose ss
  where
    findELine ss  =  any (all (== 'E')) ss
    swap (a, b)  =  (b, a)
    solve' ss  =  [(i, findDot s) | (i, s) <- zip [1..] ss]
    findDot  =  fst . head . filter ((== '.') . snd) . zip [1..]

print' :: Maybe [(Int, Int)] -> IO ()
print' Nothing  =  print (-1)
print' (Just xs)
    =  mapM_ (\(x, y) -> putStrLn (concat [show x, " ", show y])) xs

main :: IO ()
main  =  do
    n  <-  readLn
    ss  <-  sequence $ replicate n getLine
    print' $ solve ss

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

import Data.List

main = do
    n <- read <$> getLine
    l <- replicateM n getLine
    case solve n l of
        [] -> putStrLn "-1"
        ls -> forM_ ls $ \ (r,c) -> putStrLn $ show r ++ " " ++ show c

solve :: Int -> [String] -> [(Int,Int)]
solve n l | length r1 == n = r1
          | length r2 == n = map swap r2
          | otherwise      = []
    where
    lt = transpose l
    r1 = zip l [1..] >>= f
    r2 = zip lt [1..] >>= f
    swap (a,b) = (b,a)

f (s,r) = case findIndex (=='.') s of
    Just c -> return (r,c+1)
    Nothing -> fail "impossible"

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
  n <- readLn :: IO Int
  css <- lines <$> getContents
  putStr.unlines.map(unwords.map show) $ solve css

solve :: [String] -> [[Int]]
solve css
  | all (any('.'==)) css = zipWith (:) [1..] [[i+1]|cs<-css,let Just i=findIndex ('.'==) cs]
  | all (any('.'==)) $ transpose css = map(\[i,j]->[j,i]).solve $ transpose css
  | otherwise = [[-1]]

import Data.List (transpose)

solve :: [String] -> Maybe [(Int, Int)]
solve ss
  | findELine ss && findELine (transpose ss)  =  Nothing
  | not $ findELine ss  =  Just $ solve' ss
  | otherwise  =  Just $ map swap $ solve' $ transpose ss
  where
    findELine ss  =  any (all (== 'E')) ss
    swap (a, b)  =  (b, a)
    solve' ss  =  [(i, findDot s) | (i, s) <- zip [1..] ss]
    findDot  =  fst . head . filter ((== '.') . snd) . zip [1..]

print' :: Maybe [(Int, Int)] -> IO ()
print' Nothing  =  print (-1)
print' (Just xs)
    =  print (length xs) >> mapM_ (\(x, y) -> putStrLn (concat [show x, " ", show y])) xs

main :: IO ()
main  =  do
    n  <-  readLn
    ss  <-  sequence $ replicate n getLine
    print' $ solve ss


import Data.List

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, m] = map read . words . head $ input
	let v = map (map read . words) . take n . tail $ input
	let d = sort . map read . words $ input !! (n+1) :: [Int]
	let sumc = map sum v
	let sumr = [ sum $ map (!!i) v | i <- [0..m-1] ]
	let divc i j = sort . map sum $ [take i sumc, take (j-i) . drop i $ sumc, drop j sumc]
	let divr i j = sort . map sum $ [take i sumr, take (j-i) . drop i $ sumr, drop j sumr]
	writeFile "output.txt" . show . length $ [ 1 | i <- [1..n-1], j <- [i+1..n-1], d == divc i j ] ++ [ 1 | i <- [1..m-1], j <- [i+1..m-1], d == divr i j]

import IO
import List (sort)
import Array (Array (..), array, bounds, (!))

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

testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq 2 (solve (3,3,3) $ array ((1,1), (3,3)) [((i,j), 1) | i <- [1..3], j <- [1..3]]),
    Test "2" $ assertEq 3 (solve (3,6,6) $ array ((1,1), (2,5)) [((i,j), if i == 1 then 1 else 2) | i <- [1..2], j <- [1..5]])
  ]

test  =  mapM_ run
  [
    testInput
  ]
-}
--------------------------------------------------------------------------------

solve :: (Int, Int, Int) -> Array (Int, Int) Int -> Int
solve (a,b,c) d
  =  solve' (map sum (map (\i -> [d ! (i,j) | j <- [1..m]]) [1..n]))
  +  solve' (map sum (map (\j -> [d ! (i,j) | i <- [1..n]]) [1..m]))
  where
    (n, m)  =  snd $ bounds d
    abc  =  sort [a,b,c]
    solve' :: [Int] -> Int
    solve' xs  =  length [(i,j) | i <- [0..n-3], j <- [i+1..n-2],
        abc == sort [summ !! i, summ !! j - summ !! i, summ !! (n-1) - summ !! j]]
      where
        n  =  length xs
        summ  =  scanl1 (+) xs

parseLine :: Read a => String -> IO [a]
parseLine  =  return . map read . words

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, m]  <-  hGetLine hInput >>= parseLine
    d  <-  mapM (\i -> hGetLine hInput >>= parseLine) [1..n]
    [a, b, c]  <-  hGetLine hInput >>= parseLine

    let res  =  solve (a,b,c) $ array ((1,1), (n,m)) [((i+1,j+1), d !! i !! j) | i <- [0..n-1], j <- [0..m-1]]

    hPrint hOutput res

    hClose hInput
    hClose hOutput

import Data.List

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, m] = map read . words . head $ input
	let v = map (map read . words) . take n . tail $ input
	let d = sort . map read . words $ input !! (n+1) :: [Int]
	let sumc = map sum v
	let sumr = [ sum $ map (!!i) v | i <- [0..m-1] ]
	let divc i j = sort . map sum $ [take i sumc, take (j-i) . drop i $ sumc, drop j sumc]
	let divr i j = sort . map sum $ [take i sumr, take (j-i) . drop i $ sumr, drop j sumr]
	writeFile "output.txt" . show . length $ [ 1 | i <- [0..n-1], j <- [i+1..n-1], d == divc i j ] ++ [ 1 | i <- [0..m-1], j <- [i+1..m-1], d == divr i j]

import IO
import List (sort)
import Array (Array (..), array, bounds, (!))

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

testInput  =  TestList "TestInput"
  [
    Test "1" $ assertEq 2 (solve (3,3,3) $ array ((1,1), (3,3)) [((i,j), 1) | i <- [1..3], j <- [1..3]]),
    Test "2" $ assertEq 3 (solve (3,6,6) $ array ((1,1), (2,5)) [((i,j), if i == 1 then 1 else 2) | i <- [1..2], j <- [1..5]])
  ]

test  =  mapM_ run
  [
    testInput
  ]
-}
--------------------------------------------------------------------------------

solve :: (Int, Int, Int) -> Array (Int, Int) Int -> Int
solve (a,b,c) d
  =  solve' (map sum (map (\i -> [d ! (i,j) | j <- [1..m]]) [1..n]))
  +  solve' (map sum (map (\j -> [d ! (i,j) | i <- [1..n]]) [1..m]))
  where
    (n, m)  =  snd $ bounds d
    abc  =  sort [a,b,c]
    solve' :: [Int] -> Int
    solve' xs  =  length [(i,j) | i <- [0..n-3], j <- [i+1..n-1],
        abc == sort [summ !! i, summ !! j - summ !! i, summ !! (n-1) - summ !! j]]
      where
        n  =  length xs
        summ  =  scanl1 (+) xs

parseLine :: Read a => String -> IO [a]
parseLine  =  return . map read . words

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, m]  <-  hGetLine hInput >>= parseLine
    d  <-  mapM (\i -> hGetLine hInput >>= parseLine) [1..n]
    [a, b, c]  <-  hGetLine hInput >>= parseLine

    let res  =  solve (a,b,c) $ array ((1,1), (n,m)) [((i+1,j+1), d !! i !! j) | i <- [0..n-1], j <- [0..m-1]]

    hPrint hOutput res

    hClose hInput
    hClose hOutput


module Main where

f _ _ n t [] = n
f u r n t (s:ss)
 | u == r && u /= 0 = f (if s == 'U' then u+1 else u)
                        (if s == 'R' then r+1 else r)
                        (if s == t then n+1 else n)
                        s
                        ss
 | s == 'U' = f (u+1) r n s ss
 | s == 'R' = f u (r+1) n s ss
 | otherwise = f u r n s ss

main = getLine >> getLine >>= print . f 0 0 0 '-'

import Data.List

main = do
    temp <- getLine
    let n = read temp :: Int
    input <- getLine
    putStrLn $ show $ solve n input

step (a,b) 'R' = (a+1, b)
step (a,b) 'L' = (a-1, b)
step (a,b) 'U' = (a, b+1)
step (a,b) 'D' = (a, b-1)

solve n input =
    let
        cords = scanl step (0,0) input
        signs = filter (/=0) $ map (\(a,b) -> signum (a-b)) cords
        diffs = zipWith (-) signs (tail signs)
    in  (sum $ map abs diffs) `div` 2

f::Int->Int->Int->String->Int
f c x y ""=0
f c x y ('U':xs)=let t1=if x<y+1 && c==0 then 1 else 0
                     c2=if x<y+1 then 1 else 0
                 in t1 + f c2 x (y+1) xs
f c x y ('R':xs)=let t1=if y<x+1 && c==1 then 1 else 0
                     c2=if y<x+1 then 0 else 1
                 in t1+f c2 (x+1) y xs

main = do
       e<-getLine
       es<-getLine
       print $ f (-1) 0 0 es

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

main = do
   n <- fmap head toInt
   s <- getLine
   putStrLn $ show $ f (0,0) (0,0) s

f :: (Integer,Integer) -> (Integer,Integer) -> String -> Int
f _ _ [] = 0
f (lastx,lasty) (x,y) (m:ms) = case m of
                                            'U' -> if (lastx-lasty)*(x-y-1)<0 then 1+(f (x,y) (x,y+1) ms)
                                                                            else f (x,y) (x,y+1) ms
                                            'R' -> if (lastx-lasty)*(x+1-y)<0 then 1+(f (x,y) (x+1,y) ms)
                                                                            else f (x,y) (x+1,y) ms

main = getContents >>= print . solve 0 0 0 . last . lines

solve cnt _ _ [] = cnt
solve cnt x y ('U':'U':cs) = if x - y == 1
  then solve (cnt + 1) x (y + 2) cs
  else solve cnt x (y + 1) ('U':cs)
solve cnt x y ('R':'R':cs) = if y - x == 1
  then solve (cnt + 1) (x + 2) y cs
  else solve cnt (x + 1) y ('R':cs)
solve cnt x y ('U':cs) = solve cnt x (y + 1) cs
solve cnt x y ('R':cs) = solve cnt (x + 1) y cs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, unpack, reverse, dropWhile)
import qualified Data.Maybe as M (fromJust)
import Data.Char as C (isSpace)

readInt = fst . M.fromJust . C.readInt
rstrip = C.reverse . C.dropWhile C.isSpace . C.reverse

run r (x, y) (g:h:gs) | g == h && g == 'R' && x + 1 == y = run (r + 1) (x + 2, y) gs
                      | g == h && g == 'U' && x == y + 1 = run (r + 1) (x, y + 2) gs
run r (x, y) ('R':gs) = run r (x + 1, y) gs
run r (x, y) ('U':gs) = run r (x, y + 1) gs
run r (x, y) [] = r

main = do
    B.getLine
    (C.unpack . rstrip -> xxs) <- B.getLine
    putStrLn $ show $ run 0 (0, 0) xxs

f::Int->Int->String->Int
f x y ""=0
f x y (_:[])=0
f x y ('U':'U':xs)=let t = if y<x && x<y+2 then 1 else 0
                   in  t+f x (y+2) xs
f x y ('R':'R':xs)=let t = if x<y && y<x+2 then 1 else 0
                   in t+f (x+2) y xs
f x y ('U':xs)=f x (y+1) xs
f x y ('R':xs)=f (x+1) y xs

main = do
       e<-getLine
       es<-getLine
       print $ f 0 0 es

f::Int->Int->String->Int
f x y ""=0
f x y (_:[])=0
f x y ('U':'U':xs)=let t = if y<x && x<y+2 then 1 else 0
                   in  t+f x (y+1) xs
f x y ('R':'R':xs)=let t = if x<y && y<x+2 then 1 else 0
                   in t+f (x+1) y xs
f x y ('U':xs)=f x (y+1) xs
f x y ('R':xs)=f (x+1) y xs

main = do
       e<-getLine
       es<-getLine
       print $ f 0 0 es

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

main = do
   n <- fmap head toInt
   s <- getLine
   putStrLn $ show $ f (0,0) (0,0) s

f :: (Int,Int) -> (Int,Int) -> String -> Int
f _ _ [] = 0
f (lastx,lasty) (x,y) (m:ms) = case m of
                                            'U' -> if (lastx-lasty)*(x-y-1)<0 then 1+(f (x,y) (x,y+1) ms)
                                                                            else f (x,y) (x,y+1) ms
                                            'R' -> if (lastx-lasty)*(x+1-y)<0 then 1+(f (x,y) (x+1,y) ms)
                                                                            else f (x,y) (x+1,y) ms


{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Array.Unboxed

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  x <- poi
  es <- replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve n x es
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x es = (2*) $ maximum $ map (lowestOf!) $ takeWhile (\u -> depthOf!u - depthOf!1 > depthOf!x - depthOf!u) $ iterate (parentOf!) x
  where
    g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
    depthOf = array (1, n) $ dfs g (\u cs d -> ((u, d):) . foldr ( (.) . ($ d + 1)) id cs) 0 [] :: UArray Int Int
    parentOf = array (1, n) $ dfs g (\u cs p -> ((u, p):) . foldr ((.) . ($ u)) id cs) 0 [] :: UArray Int Int
    lowestOf = array (1, n) $ ($ []) $ snd $ dfs g (\u cs -> let l = maximum $ (depthOf!u):map fst cs in (l, ((u, l):) . foldr ((.) . snd) id cs)) :: UArray Int Int

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Array.Unboxed
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  x <- poi
  es <- replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve n x es
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x es = (2*) $ maximum $ map (lowestOf!) $ takeWhile (\u -> depthOf!u - depthOf!1 > depthOf!x - depthOf!u) $ iterate (parentOf!) x
  where
    g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
    depthOf = array (1, n) $ dfs g (\u cs d -> ((u, d):) . foldl' (\p f -> p . f (d + 1)) id cs) 0 [] :: UArray Int Int
    parentOf = array (1, n) $ dfs g (\u cs p -> ((u, p):) . foldl' (\p f -> p . f u) id cs) 0 [] :: UArray Int Int
    lowestOf = array (1, n) $ ($ []) $ snd $ dfs g (\u cs -> let l = maximum $ (depthOf!u):map fst cs in (l, ((u, l):) . foldl' (\p f -> p . snd f) id cs)) :: UArray Int Int

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List
import Data.Ord
import Data.Maybe

readInt = fst . fromJust . B.readInt
readInts = fmap readInt . B.words

maximaBy f xs = filter (\x -> f x m == EQ) xs
  where m = maximumBy f xs

solve n x es = 2 * max aCnt bCnt
  where
    g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
    aCnt = depthOf!head deepestUs - depthOf!1
    bCnt
      | x `elem` deepestUs = 0
      | otherwise = minimum $ map (\u -> depthOf!u + depthOf!x - 2 * depthOf!lca u x) deepestUs
    deepestUs = map fst $ maximaBy (comparing snd) $ assocs depthOf
    depthOf = array (1, n) $ dfs (\u cs d -> (u, d) : concatMap ($ d + 1) cs) (const []) 0 :: UArray Int Int
    lca a b = fromJust $ dfs go Nothing
      where
        go u cs
          | u == a || u == b = Just u
          | otherwise = case filter isJust cs of
              [v] -> v
              [_, _] -> Just u
              _ -> Nothing
          | otherwise = foldl (<|>) mzero cs
    dfs f z = go 0 1
      where
        go p u = case filter (/= p) (g!u) of
          [] -> f u [z]
          vs -> f u $ map (go u) vs

main = do
  [n, x] <- fmap readInts B.getLine
  es <- replicateM (n - 1) (fmap ((\(u:v:_) -> (u, v)) . readInts) B.getLine)
  print $ solve n x es

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List
import Data.Ord
import Data.Maybe

readInt = fst . fromJust . B.readInt
readInts = fmap readInt . B.words

maximaBy f xs = filter (\x -> f x m == EQ) xs
  where m = maximumBy f xs

solve n x es = g -- 2 * max aCnt bCnt
  where
    g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
    aCnt = depthOf!head deepestUs - depthOf!1
    bCnt
      | x `elem` deepestUs = 0
      | otherwise = minimum $ map (\u -> depthOf!u + depthOf!x - 2 * depthOf!lca u x) deepestUs
    deepestUs = map fst $ maximaBy (comparing snd) $ assocs depthOf
    depthOf = array (1, n) $ dfs (\u cs d -> (u, d) : concatMap ($ d + 1) cs) (const []) 0 :: UArray Int Int
    lca a b = fromJust $ dfs go Nothing
      where
        go u cs
          | u == a || u == b || all isJust cs = Just u
          | otherwise = foldl (<|>) mzero cs
    dfs f z = go 0 1
      where
        go p u = case filter (/= p) (g!u) of
          [] -> f u [z]
          vs -> f u $ map (go u) vs

main = do
  [n, x] <- fmap readInts B.getLine
  es <- replicateM (n - 1) (fmap ((\(u:v:_) -> (u, v)) . readInts) B.getLine)
  print $ solve n x es


f :: String -> String
f s
	| null s=[]
	| null y=[x]
	| x >= (head y)=x:y
	| otherwise = y
	where (x,y) = (head s,f $ tail s)
main = do
	s <- getLine
	putStrLn $ f s

f s
	| null s=[]
	| null y=[x]
	| x >= (head y)=x:y
	| True = y
	where (x,y) = (head s,f $ tail s)
main = do
	s <- getLine
	putStrLn $ f s

solve :: String -> String
solve s  =  reverse $ (head s') : solve' (head s') (tail s')
  where
    s'  =  reverse s
    solve' p []  =  []
    solve' p (c:s)
      | p > c  =  solve' p s
      | otherwise  =  c : solve' c s

main :: IO ()
main  =  getLine >>= putStrLn . solve

solve :: String -> String
solve "" = ""
solve s = filter (== max) s ++ solve rest
          where
            max = maximum s
            rest = reverse . takeWhile (/= max) $ reverse s

main :: IO ()
main = do
  s <- getLine
  putStrLn $ solve s

x#[]=[x]
x#y|x<head y=y|1>0=x:y
main=interact$foldr(#)[]

main = getLine >>= putStrLn.solve 'a' [].reverse

solve c ans [] = ans
solve c ans (x:xs)
  | c<=x = solve x (x:ans) xs
  | otherwise = solve c ans xs