The length of the longest common prefix of two strings $$$s = s_1 s_2 \ldots s_n$$$ and $$$t = t_1 t_2 \ldots t_m$$$ is defined as the maximum integer $$$k$$$ ($$$0 \le k \le min(n,m)$$$) such that $$$s_1 s_2 \ldots s_k$$$ equals $$$t_1 t_2 \ldots t_k$$$.Koa the Koala initially has $$$n+1$$$ strings $$$s_1, s_2, \dots, s_{n+1}$$$.For each $$$i$$$ ($$$1 \le i \le n$$$) she calculated $$$a_i$$$ — the length of the longest common prefix of $$$s_i$$$ and $$$s_{i+1}$$$.Several days later Koa found these numbers, but she couldn't remember the strings.So Koa would like to find some strings $$$s_1, s_2, \dots, s_{n+1}$$$ which would have generated numbers $$$a_1, a_2, \dots, a_n$$$. Can you help her?If there are many answers print any. We can show that answer always exists for the given constraints.

Each test contains multiple test cases. The first line contains $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of elements in the list $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 50$$$) — the elements of $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$100$$$.

For each test case: Output $$$n+1$$$ lines. In the $$$i$$$-th line print string $$$s_i$$$ ($$$1 \le |s_i| \le 200$$$), consisting of lowercase Latin letters. Length of the longest common prefix of strings $$$s_i$$$ and $$$s_{i+1}$$$ has to be equal to $$$a_i$$$. If there are many answers print any. We can show that answer always exists for the given constraints.

aeren
ari
arousal
around
ari
monogon
monogamy
monthly
kevinvu
kuroni
kurioni
korone
anton
loves
adhoc
problems

NoteIn the $$$1$$$-st test case one of the possible answers is $$$s = [aeren, ari, arousal, around, ari]$$$.Lengths of longest common prefixes are:  Between $$$\color{red}{a}eren$$$ and $$$\color{red}{a}ri$$$ $$$\rightarrow 1$$$  Between $$$\color{red}{ar}i$$$ and $$$\color{red}{ar}ousal$$$ $$$\rightarrow 2$$$  Between $$$\color{red}{arou}sal$$$ and $$$\color{red}{arou}nd$$$ $$$\rightarrow 4$$$  Between $$$\color{red}{ar}ound$$$ and $$$\color{red}{ar}i$$$ $$$\rightarrow 2$$$

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ss [] "" 'a'

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> String -> Char -> [String]
getStrings []       ans last _    = ans ++ [last]
getStrings (a : xs) ans last elem = getStrings xs (ans ++ [f]) s c where
    (f, s, c) = nextString a last elem

nextString :: Int -> String -> Char -> (String, String, Char)
nextString a s elem | length s > a = (s, take a s, change (s !! a))
                    | otherwise    = (str, str, change elem) where
                                      str = s ++ replicate (a - length s) elem

change :: Char -> Char
change e | e == 'x' = 'a'
         | otherwise = succ e

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ss [] "" 'a'

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> String -> Char -> [String]
getStrings []       ans last _    = ans ++ [last]
getStrings (a : xs) ans last elem = getStrings xs (ans ++ [f]) s c where
    (f, s, c) = nextString a last elem

nextString :: Int -> String -> Char -> (String, String, Char)
nextString a s elem | length s >= a = (s, take a s, elem)
                    | otherwise     = (str, str, change elem) where
                                      str = s ++ replicate (a - length s) elem
                                      change e | e == 'a' = 'b'
                                               | e == 'b' = 'a'

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    print ss
    printSrtings $ checkZeroes $ getStrings ([0] ++ ss ++ [0]) []

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> [String]
getStrings (a : b : xs) ans = getStrings (b : xs) (ans ++ [replicate (max a b) 'a'])
getStrings _ ans = ans

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ([0] ++ ss ++ [0]) []

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> [String]
getStrings (a : b : xs) ans = getStrings (b : xs) (ans ++ [replicate (max a b) 'a'])
getStrings _ ans = ans

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ([0] ++ ss ++ [0]) [] False

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> Bool -> [String]
getStrings (a : b : xs) ans flag = getStrings (b : xs) (ans ++ [replicate (max a b) char]) bool where
    char = if flag then 'a' else 'b'
    bool = if b == 0 then not flag else flag
getStrings _ ans _ = ans

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ss [] "" 'a'

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> String -> Char -> [String]
getStrings []       ans last _    = ans ++ [last]
getStrings (a : xs) ans last elem = getStrings xs (ans ++ [f]) s c where
    (f, s, c) = nextString a last elem

nextString :: Int -> String -> Char -> (String, String, Char)
nextString a s elem | length s >= a = (s, take a s, elem)
                    | otherwise     = dup (s ++ replicate (a - length s) (change elem)) where
                                      dup a = (a, a, change elem)
                                      change e | e == 'a' = 'b'
                                               | e == 'b' = 'a'

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ checkZeroes $ getStrings ss [] "" 'a'

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> String -> Char -> [String]
getStrings []       ans last _    = ans ++ [last]
getStrings (a : xs) ans last elem = getStrings xs (ans ++ [f]) s c where
    (f, s, c) = nextString a last elem

nextString :: Int -> String -> Char -> (String, String, Char)
nextString a s elem | length s >= a = (s, take a s, elem)
                    | otherwise     = (str, str, change elem) where
                                      str = s ++ replicate (a - length s) elem
                                      change e | e == 'a' = 'b'
                                               | e == 'b' = 'c'
                                               | e == 'c' = 'a'

checkZeroes :: [String] -> [String]
checkZeroes ss = helper 0 ss [] where
    helper _ [] ans = ans
    helper cnt (s : ss) ans = case s of
        ""        -> helper (cnt + 1) ss (ans ++ [(if even cnt then "x" else "y")])
        otherwise -> helper (cnt + 1) ss (ans ++ [s])

module Main where

import Control.Monad

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    replicateM_ n solve

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    ss <- map read . words <$> getLine :: IO [Int]
    printSrtings $ getStrings ([0] ++ ss ++ [0]) [""]

printSrtings :: [String] -> IO ()
printSrtings [] = return ()
printSrtings (s : ss) = do
                    putStrLn s
                    printSrtings ss

getStrings :: [Int] -> [String] -> [String]
getStrings (a : b : xs) ans = getStrings (b : xs) (ans ++ [replicate (max a b) 'a'])
getStrings _ ans = ans


A non-empty string is called palindrome, if it reads the same from the left to the right and from the right to the left. For example, "abcba", "a", and "abba" are palindromes, while "abab" and "xy" are not.A string is called a substring of another string, if it can be obtained from that string by dropping some (possibly zero) number of characters from the beginning and from the end of it. For example, "abc", "ab", and "c" are substrings of the string "abc", while "ac" and "d" are not.Let's define a palindromic count of the string as the number of its substrings that are palindromes. For example, the palindromic count of the string "aaa" is $$$6$$$ because all its substrings are palindromes, and the palindromic count of the string "abc" is $$$3$$$ because only its substrings of length $$$1$$$ are palindromes.You are given a string $$$s$$$. You can arbitrarily rearrange its characters. You goal is to obtain a string with the maximum possible value of palindromic count.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 100\,000$$$) — the length of string $$$s$$$. The second line contains string $$$s$$$ that consists of exactly $$$n$$$ lowercase characters of Latin alphabet.

Print string $$$t$$$, which consists of the same set of characters (and each characters appears exactly the same number of times) as string $$$s$$$. Moreover, $$$t$$$ should have the maximum possible value of palindromic count among all such strings strings. If there are multiple such strings, print any of them.

NoteIn the first example, string "ololo" has $$$9$$$ palindromic substrings: "o", "l", "o", "l", "o", "olo", "lol", "olo", "ololo". Note, that even though some substrings coincide, they are counted as many times as they appear in the resulting string.In the second example, the palindromic count of string "abccbaghghghgdfd" is $$$29$$$.

import Control.Applicative
import Data.List

main = do
  n <- readLn :: IO Int
  s <- sort <$> getLine

  putStrLn $ s

-- Codeforces 1064 C
import qualified Data.Map.Strict as Map
import Data.List

createMap :: String -> Map.Map Char Int
createMap string = Map.fromListWith (+) [(c, 1) | c <- string]

toString :: Map.Map Char Int -> String
toString charMap = concat $ map (\(c, n) -> replicate n c) (Map.toList charMap)

main :: IO ()
main = do
    n <- getLine
    input <- getLine
    putStrLn ((toString . createMap) input )

import Data.List

main = do
  _ <- getLine
  t <- getLine
  putStrLn $ sort t


A permutation of length n is an array containing each integer from 1 to n exactly once. For example, q = [4, 5, 1, 2, 3] is a permutation. For the permutation q the square of permutation is the permutation p that p[i] = q[q[i]] for each i = 1... n. For example, the square of q = [4, 5, 1, 2, 3] is p = q2 = [2, 3, 4, 5, 1].This problem is about the inverse operation: given the permutation p you task is to find such permutation q that q2 = p. If there are several such q find any of them.

The first line contains integer n (1 ≤ n ≤ 106) — the number of elements in permutation p. The second line contains n distinct integers p1, p2, ..., pn (1 ≤ pi ≤ n) — the elements of permutation p.

If there is no permutation q such that q2 = p print the number "-1". If the answer exists print it. The only line should contain n different integers qi (1 ≤ qi ≤ n) — the elements of the permutation q. If there are several solutions print any of them.

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems, array, listArray, (!))
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.ByteString.Char8 (readInt, words, getLine)
import Data.List (partition, sortBy)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Prelude hiding (words, getLine)

main = do
  n <- readLn
  p <- map (fst . fromJust . readInt) . words <$> getLine

  let
    (es, os) = partition (even . length) loops
      where
        loops = filter (not . null) $ runST $ do
            bs <- newArray (1, n) False :: ST s (STUArray s Int Bool)

            forM [1..n] $ \i -> do
              b <- readArray bs i

              let
                find j = do
                    writeArray bs j True
                    if k == i then return [j] else (j:) <$> find k
                  where k = a ! j

              if b then return [] else find i
          where
            a = listArray (1, n) p

    es' = sortBy (comparing length) es

    check = check' es'
      where
        check' [] = True
        check' [_] = False
        check' (a:b:ls)
          | length a == length b = check' ls
          | otherwise = False

    ans = elems . array (1, n) . concat $ map (\l -> zip l (tail l ++ [head l])) (es'' ++ os')
      where
        es'' = map (uncurry merge) $ group2 es'
          where
            group2 [] = []
            group2 (a:b:xs) = (a, b):(group2 xs)

        os' = map f os
          where
            f vs = uncurry merge $ splitAt (l `div` 2 + 1) vs
              where l = length vs

        merge [] [] = []
        merge [x] [] = [x]
        merge (x:xs) (y:ys) = x:y:(merge xs ys)

  if not $ check
    then print (-1)
    else putStr . unwords $ map show ans


The ship crashed into a reef and is sinking. Now the entire crew must be evacuated. All n crew members have already lined up in a row (for convenience let's label them all from left to right with positive integers from 1 to n) and await further instructions. However, one should evacuate the crew properly, in a strict order. Specifically:The first crew members to leave the ship are rats. Then women and children (both groups have the same priority) leave the ship. After that all men are evacuated from the ship. The captain leaves the sinking ship last.If we cannot determine exactly who should leave the ship first for any two members of the crew by the rules from the previous paragraph, then the one who stands to the left in the line leaves the ship first (or in other words, the one whose number in the line is less).For each crew member we know his status as a crew member, and also his name. All crew members have different names. Determine the order in which to evacuate the crew.

The first line contains an integer n, which is the number of people in the crew (1 ≤ n ≤ 100). Then follow n lines. The i-th of those lines contains two words — the name of the crew member who is i-th in line, and his status on the ship. The words are separated by exactly one space. There are no other spaces in the line. The names consist of Latin letters, the first letter is uppercase, the rest are lowercase. The length of any name is from 1 to 10 characters. The status can have the following values: rat for a rat, woman for a woman, child for a child, man for a man, captain for the captain. The crew contains exactly one captain.

Print n lines. The i-th of them should contain the name of the crew member who must be the i-th one to leave the ship.

6
Jack captain
Alice woman
Charlie man
Teddy rat
Bob child
Julia woman

module Main where

import Control.Monad
import Data.List

data Crew = Crew { crewPri, crewPos :: Int, crewName :: String } deriving (Eq, Ord, Show)

groupPri "rat" = 1
groupPri "woman" = 2
groupPri "child" = 2
groupPri "man" = 3
groupPri "captain" = 4

main = do
    n <- read `liftM` getLine
    crews <- forM [1..n] $ \i -> do
        [name, group] <- words `liftM` getLine
        return $ Crew ( groupPri group ) i name

    putStr $ unlines $ map crewName $ sort crews

main = do
	t<-getLine
	rest<-getContents
	let dict = map words $ lines rest
	putStrLn $ unlines $ solve dict

solve c = map head
           ((filter (elem "rat") c) ++
           (filter (\x->elem "child" x || elem "woman" x) c) ++
           (filter (elem "man") c) ++
           (filter (elem "captain") c))

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

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

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

main = do
  getLine
  ls <- fmap (map (\[a, b] -> (a, b)) . map words . lines) getContents

  let
    f ((a, b), i) = (j, i)
      where
        j = case b of
              "rat" -> 0
              "woman" -> 1
              "child" -> 1
              "man" -> 2
              "captain" -> 3

  putStrLn $ unlines $ map (fst . fst) $ sortBy (compare `on` f) $ zip ls [1..]

import Data.List
import Data.Ord
import System.IO

main :: IO()
main = do
  interact $ unlines . map head . sortBy (comparing $ rank . (!!1)) . map words . tail . lines

rank :: String -> Int
rank x
  |x == "rat" = 0
  |x == "child" = 1
  |x == "woman" = 1
  |x == "man" = 2
  |x == "captain" = 3

import List

data CrewMember =  Rat Int String | WomanOrChild Int String | Man Int String | Captain Int String
    deriving (Show, Eq, Ord)

crewMember :: String -> Int -> String -> CrewMember
crewMember "captain" n name = Captain n name
crewMember "man" n name = Man n name
crewMember "woman" n name = WomanOrChild n name
crewMember "child" n name = WomanOrChild n name
crewMember _ n name = Rat n name

readLine :: Int -> IO CrewMember
readLine n = do
    line <- getLine
    let [name, status] = words line
    return (crewMember status n name)

myPrint :: [CrewMember] -> IO ()
myPrint members = do
    sequence_ (map myPrint_ members)
    where
        myPrint_ :: CrewMember -> IO ()
        myPrint_ (Captain n name) = putStrLn name
        myPrint_ (Man n name) = putStrLn name
        myPrint_ (WomanOrChild n name) = putStrLn name
        myPrint_ (Rat n name) = putStrLn name

main = do
    n <- readLn::(IO Int)
    lines <- sequence (map readLine [1..n])
    myPrint (sort lines)

import Data.List
main=interact$unlines.map snd.sort.map f.zip[1..].tail.lines
f(i,x)=((g b,i),a) where [a,b]=words x
g('m':_)=3
g('w':_)=2
g(_:'h':_)=2
g('c':_)=4
g _=1

import Data.List (sortBy)
import Data.Function (on)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . map words . tail . lines

solve :: [[String]] -> [String]
solve = map (!!0) . sortBy (compare `on` (priority . (!!1)))
  where priority "rat" = 0 :: Int
        priority "woman" = 1
        priority "child" = 1
        priority "man" = 2
        priority "captain" = 3
        priority _ = 4

import Data.List
import Data.Ord
rank "rat" = 0
rank "child" = 1
rank "woman" = 1
rank "man" = 2
rank "captain" = 3
main = interact $ unlines . map head . sortBy (comparing $ rank . (!!1)) . map words . tail . lines

import Prelude
import List
import Char

main = interact q

q = func.tail.lines

func::[String]->String
func = unlines.solve.map words
fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[[String]]->[String]
solve a = rat ++ wac ++ man ++ cap
    where
      rat = map (!!0) $ filter (\ (_:a:[]) -> a `elem` ["rat"]) a
      wac = map (!!0) $ filter (\ (_:a:[]) -> a `elem` ["woman","child"]) a
      man = map (!!0) $ filter (\ (_:a:[]) -> a `elem` ["man"]) a
      cap = map (!!0) $ filter (\ (_:a:[]) -> a `elem` ["captain"]) a

import qualified Data.Map as M
import Data.List
pri = M.fromList [("rat", 1), ("child", 2), ("woman", 2), ("man", 4), ("captain", 5)]
main = do
    n <- read `fmap` getLine
    l <- mapM (\_ -> words `fmap` getLine) [1..n]
    let l1 = unlines $ map head $ sortBy (\[_, a] [_, b] -> compare (pri M.! a) (pri M.! b)) l
    putStr l1

import Data.List

order s = case s of
    "rat"       -> 0
    "woman"     -> 1
    "child"     -> 1
    "man"       -> 2
    _           -> 3

parseInput input = zip3 as bs cs where
    n = read $ head $ lines input :: Int
    is = map words $ tail $ lines input
--    xs = [x | [x,_] <- is]
    cs = map head is
    ys = map last is
    as = map order ys
    bs = take n [1..]

solve xs = ys where
    ys = map (\(_, _, c) -> c) $ sort xs

main = do
    input <- getContents
    let xs = parseInput input
    putStrLn $ intercalate "\n" $ solve xs

import Data.List
main=interact$unlines.map snd.sort.map f.zip[1..].tail.lines
f(i,x)=((g b,i),a) where [a,b]=words x
g('m':_)=3
g('w':_)=2
g(_:'h':_)=4
g('c':_)=2
g _=1

import Data.List (sort)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . map words . tail . lines

solve :: [[String]] -> [String]
solve = map snd . sort . map f
  where f [x, "rat"] = (0 :: Int, x)
        f [x, "woman"] = (1, x)
        f [x, "child"] = (2, x)
        f [x, "man"] = (3, x)
        f [x, "captain"] = (4, x)
        f _ = undefined

import Data.List (sort)

main :: IO ()
main = getContents >>= mapM_ putStrLn . solve . map words . tail . lines

solve :: [[String]] -> [String]
solve = map snd . sort . map f
  where f [x, "rat"] = (0 :: Int, x)
        f [x, "woman"] = (1, x)
        f [x, "child"] = (1, x)
        f [x, "man"] = (2, x)
        f [x, "captain"] = (3, x)
        f _ = undefined


Chaneka has a hobby of playing with animal toys. Every toy has a different fun value, a real number. Chaneka has four boxes to store the toys with specification:   The first box stores toys with fun values in range of $$$(-\infty,-1]$$$.  The second box stores toys with fun values in range of $$$(-1, 0)$$$.  The third box stores toys with fun values in range of $$$(0, 1)$$$.  The fourth box stores toys with fun value in range of $$$[1, \infty)$$$. Chaneka has $$$A$$$, $$$B$$$, $$$C$$$, $$$D$$$ toys in the first, second, third, and fourth box, respectively. One day she decides that she only wants one toy, a super toy. So she begins to create this super toy by sewing all the toys she has.While the number of toys Chaneka has is more than 1, she takes two different toys randomly and then sews them together, creating a new toy. The fun value of this new toy is equal to the multiplication of fun values of the sewn toys. She then puts this new toy in the appropriate box. She repeats this process until she only has one toy. This last toy is the super toy, and the box that stores this toy is the special box.As an observer, you only know the number of toys in each box initially but do not know their fun values. You also don't see the sequence of Chaneka's sewing. Determine which boxes can be the special box after Chaneka found her super toy.

The first line has an integer $$$T$$$ $$$(1 \le T \le 5 \cdot 10^4)$$$, the number of test cases. Every case contains a line with four space-separated integers $$$A$$$ $$$B$$$ $$$C$$$ $$$D$$$ $$$(0 \le A, B, C, D \le 10^6, A + B + C + D > 0)$$$, which denotes the number of toys in the first, second, third, and fourth box, respectively.

For each case, print four space-separated strings. Each string represents the possibility that the first, second, third, and fourth box can be the special box from left to right. For each box, print "Ya" (Without quotes, Indonesian for yes) if that box can be the special box. Print "Tidak" (Without quotes, Indonesian for No) otherwise.

NoteFor the first case, here is a scenario where the first box is the special box:   The first box had toys with fun values $$$\{-3\}$$$.  The second box had toys with fun values $$$\{ -0.5, -0.5 \}$$$  The fourth box had toys with fun values $$$\{ 3 \}$$$ The sewing sequence:   Chaneka sews the toy with fun $$$-0.5$$$ and $$$-0.5$$$ to a toy with fun $$$0.25$$$ and then put it in the third box.  Chaneka sews the toy with fun $$$-3$$$ and $$$0.25$$$ to a toy with fun $$$-0.75$$$ and then put it in the second box.  Chaneka sews the toy with fun $$$-0.75$$$ and $$$3$$$ to a toy with fun $$$-1.25$$$ and then put it in the first box, which then became the special box. Here is a scenario where the second box ends up being the special box:   The first box had toys with fun values $$$\{-3\}$$$  The second box had toys with fun values $$$\{ -0.33, -0.25 \}$$$.  The fourth box had toys with fun values $$$\{ 3 \}$$$. The sewing sequence:   Chaneka sews the toy with fun $$$-3$$$ and $$$-0.33$$$ to a toy with fun $$$0.99$$$ and then put it in the third box.  Chaneka sews the toy with fun $$$0.99$$$ and $$$3$$$ to a toy with fun $$$2.97$$$ and then put in it the fourth box.  Chaneka sews the toy with fun $$$2.97$$$ and $$$-0.25$$$ to a toy with fun $$$-0.7425$$$ and then put it in the second box, which then became the special box.  There is only one toy for the second case, so Chaneka does not have to sew anything because that toy, by definition, is the super toy.

import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [a, b, c, d] <- map read . words <$> getLine :: IO [Int]
        let sgn = even $ a + b
            big = a + d > 0
            small = b + c > 0
            f x = if x then "Ya " else "Tidak "
        putStr   $ f $ not sgn && big
        putStr   $ f $ not sgn && small
        putStr   $ f $     sgn && small
        putStrLn $ f $     sgn && big


One day Sasha visited the farmer 2D and his famous magnetic farm. On this farm, the crop grows due to the influence of a special magnetic field. Maintaining of the magnetic field is provided by $$$n$$$ machines, and the power of the $$$i$$$-th machine is $$$a_i$$$. This year 2D decided to cultivate a new culture, but what exactly he didn't say. For the successful growth of the new culture, it is necessary to slightly change the powers of the machines. 2D can at most once choose an arbitrary integer $$$x$$$, then choose one machine and reduce the power of its machine by $$$x$$$ times, and at the same time increase the power of one another machine by $$$x$$$ times (powers of all the machines must stay positive integers). Note that he may not do that if he wants. More formally, 2D can choose two such indices $$$i$$$ and $$$j$$$, and one integer $$$x$$$ such that $$$x$$$ is a divisor of $$$a_i$$$, and change powers as following: $$$a_i = \frac{a_i}{x}$$$, $$$a_j = a_j \cdot x$$$Sasha is very curious, that's why he wants to calculate the minimum total power the farmer can reach. There are too many machines, and Sasha can't cope with computations, help him!

The first line contains one integer $$$n$$$ ($$$2 \le n \le 5 \cdot 10^4$$$) — the number of machines. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 100$$$) — the powers of the machines.

Print one integer — minimum total power.

NoteIn the first example, the farmer can reduce the power of the $$$4$$$-th machine by $$$2$$$ times, and increase the power of the $$$1$$$-st machine by $$$2$$$ times, then the powers will be: $$$[2, 2, 3, 2, 5]$$$.In the second example, the farmer can reduce the power of the $$$3$$$-rd machine by $$$2$$$ times, and increase the power of the $$$2$$$-nd machine by $$$2$$$ times. At the same time, the farmer can leave is be as it is and the total power won't change.In the third example, it is optimal to leave it be as it is.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  print $ query n as

query :: Int -> [Int] -> Int
query n as = (summ -) $ maximum $ map gainFor as
  where
    (!mini,!summ) = foldl' (\(!mini,!summ) a -> (mini `min` a, summ + a))
                    (maxBound,0) as
    gainFor a = search a 2 1 0
    search !a !x !prevx !prevgain
      | x > a `shiftR` 1 = prevgain
      | r /= 0           = search a (x+1) prevx prevgain
      | gain > prevgain  = search a (x+1) x gain
      | otherwise        = prevgain
      where
        (q,r) = a `divMod` x
        gain = (a + mini) - (q + mini * x)

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

import Data.List
main = interact $ show . solve . sort . map read . tail . words
solve (a0:as) = sum (as) + minimum (map f as) where
  f a = minimum [ x*a0 + a `div` x - a | x <- [1..a], a `mod` x == 0 ]

main = interact (format . solve . parse)

parse :: String -> [Int]
parse = (map read) . (drop 1) . words

solve a = (sum a) - maximum (0:
  (concat [
    map (\x -> let (q, r) = divMod ai x in if r == 0
      then ai - x - minA * (q - 1)
      else 0)
    [minA + 1..ai]
    | ai <- a])
  )
  where minA = minimum a

format = show


This is the hard version of the problem. The only difference is that in this version $$$n \leq 200000$$$. You can make hacks only if both versions of the problem are solved.There are $$$n$$$ potions in a line, with potion $$$1$$$ on the far left and potion $$$n$$$ on the far right. Each potion will increase your health by $$$a_i$$$ when drunk. $$$a_i$$$ can be negative, meaning that potion will decrease will health.You start with $$$0$$$ health and you will walk from left to right, from first potion to the last one. At each potion, you may choose to drink it or ignore it. You must ensure that your health is always non-negative.What is the largest number of potions you can drink?

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 200000$$$) — the number of potions.  The next line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ... ,$$$a_n$$$ ($$$-10^9 \leq a_i \leq 10^9$$$) which represent the change in health after drinking that potion.

Output a single integer, the maximum number of potions you can drink without your health becoming negative.

NoteFor the sample, you can drink $$$5$$$ potions by taking potions $$$1$$$, $$$3$$$, $$$4$$$, $$$5$$$ and $$$6$$$. It is not possible to drink all $$$6$$$ potions because your health will go negative at some point

import Data.Int (Int64)
import qualified Data.IntMap.Strict as S
import Data.Maybe (fromJust, isNothing)

main = do
    _ <- getLine
    a <- map read . words <$> getLine
    print $ solve S.empty 0 a

solve :: S.IntMap Int -> Int64 -> [Int] -> Int
solve s h [] = sum $ S.elems s
solve s h (x:xs)
    | h' >= 0 = solve s' h' xs
    | otherwise =
        let ((y, c), s'') = S.deleteFindMin s'
         in solve
                (if c > 1
                     then S.insert y (c - 1) s''
                     else s'')
                (h' - fromIntegral y)
                xs
  where
    s' = S.insert x (1 + count s x) s
    h' = h + fromIntegral x

count :: S.IntMap Int -> Int -> Int
count s x
    | isNothing c = 0
    | otherwise = fromJust c
  where
    c = S.lookup x s

import Data.Maybe
import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import qualified Data.IntMap.Strict as IM
import System.IO

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

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
  _ <- getInts
  as <- getInts
  let (result, _, _) = foldl' acc (0, 0, IM.empty) as
      acc :: (Int, Int64, IM.IntMap Int) -> Int -> (Int, Int64, IM.IntMap Int)
      acc (num, hp, mp) a
        | a >= 0 = (num + 1, hp + fromIntegral a, mp)
        | hp + fromIntegral a < 0 = (num, hp', IM.alter dec a' mp')
        | otherwise = (num + 1, hp + fromIntegral a, IM.alter inc a mp)
        where Just (a', _) = IM.lookupMin mp'
              mp' = IM.alter inc a mp
              hp' = hp + fromIntegral a - fromIntegral a'
              inc Nothing = Just 1
              inc (Just x) = Just (x + 1)
              dec Nothing = Nothing
              dec (Just 1) = Nothing
              dec (Just x) = Just (x - 1)
  hPutBuilder stdout $ intDec result `mappend` charUtf8 '\n'


Recently, you bought a brand new smart lamp with programming features. At first, you set up a schedule to the lamp. Every day it will turn power on at moment $$$0$$$ and turn power off at moment $$$M$$$. Moreover, the lamp allows you to set a program of switching its state (states are "lights on" and "lights off"). Unfortunately, some program is already installed into the lamp.The lamp allows only good programs. Good program can be represented as a non-empty array $$$a$$$, where $$$0 < a_1 < a_2 < \dots < a_{|a|} < M$$$. All $$$a_i$$$ must be integers. Of course, preinstalled program is a good program.The lamp follows program $$$a$$$ in next manner: at moment $$$0$$$ turns power and light on. Then at moment $$$a_i$$$ the lamp flips its state to opposite (if it was lit, it turns off, and vice versa). The state of the lamp flips instantly: for example, if you turn the light off at moment $$$1$$$ and then do nothing, the total time when the lamp is lit will be $$$1$$$. Finally, at moment $$$M$$$ the lamp is turning its power off regardless of its state.Since you are not among those people who read instructions, and you don't understand the language it's written in, you realize (after some testing) the only possible way to alter the preinstalled program. You can insert at most one element into the program $$$a$$$, so it still should be a good program after alteration. Insertion can be done between any pair of consecutive elements of $$$a$$$, or even at the begining or at the end of $$$a$$$.Find such a way to alter the program that the total time when the lamp is lit is maximum possible. Maybe you should leave program untouched. If the lamp is lit from $$$x$$$ till moment $$$y$$$, then its lit for $$$y - x$$$ units of time. Segments of time when the lamp is lit are summed up.

First line contains two space separated integers $$$n$$$ and $$$M$$$ ($$$1 \le n \le 10^5$$$, $$$2 \le M \le 10^9$$$) — the length of program $$$a$$$ and the moment when power turns off. Second line contains $$$n$$$ space separated integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 < a_1 < a_2 < \dots < a_n < M$$$) — initially installed program $$$a$$$.

Print the only integer — maximum possible total time when the lamp is lit.

NoteIn the first example, one of possible optimal solutions is to insert value $$$x = 3$$$ before $$$a_1$$$, so program will be $$$[3, 4, 6, 7]$$$ and time of lamp being lit equals $$$(3 - 0) + (6 - 4) + (10 - 7) = 8$$$. Other possible solution is to insert $$$x = 5$$$ in appropriate place.In the second example, there is only one optimal solution: to insert $$$x = 2$$$ between $$$a_1$$$ and $$$a_2$$$. Program will become $$$[1, 2, 10]$$$, and answer will be $$$(1 - 0) + (10 - 2) = 9$$$.In the third example, optimal answer is to leave program untouched, so answer will be $$$(3 - 0) + (7 - 4) = 6$$$.

module Main where

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import Data.Tuple
import Control.Monad
import Control.Applicative
import qualified Data.Set as Set
import qualified Data.Map.Lazy as Map
import qualified Data.ByteString.Char8 as B

h :: Int64 -> (Int64, Int64) -> Int64 -> Int64 -> Int64 -> Int64
h n (lhs, rhs) sum l r
  | lhs + 1 == rhs = 0
  | otherwise = sum + rhs - lhs - 1 + if even n then l else r

f :: [Int64] -> Int64
f (n : m : list) =
  maximum . (:) (last s) . zipWith5 h [0..] intervals s (g even) $ g odd
  where intervals :: [(Int64, Int64)]
        intervals = liftA2 zip ((:) 0) (flip (++) [m]) list
        q = abs . uncurry (flip (-))
        g :: (Int64 -> Bool) -> [Int64]
        g o = tail . scanr (+) 0 . zipWith (\x y -> if o x then q y else 0) [0..] $ intervals
        s :: [Int64]
        s = scanl (+) 0 . zipWith (\x y -> if even x then q y else 0) [0..] $ intervals

main :: IO()
main = interact $ show .  f . map read . words


Appleman has a tree with n vertices. Some of the vertices (at least one) are colored black and other vertices are colored white.Consider a set consisting of k (0 ≤ k < n) edges of Appleman's tree. If Appleman deletes these edges from the tree, then it will split into (k + 1) parts. Note, that each part will be a tree with colored vertices.Now Appleman wonders, what is the number of sets splitting the tree in such a way that each resulting part will have exactly one black vertex? Find this number modulo 1000000007 (109 + 7).

The first line contains an integer n (2  ≤ n ≤ 105) — the number of tree vertices.  The second line contains the description of the tree: n - 1 integers p0, p1, ..., pn - 2 (0 ≤ pi ≤ i). Where pi means that there is an edge connecting vertex (i + 1) of the tree and vertex pi. Consider tree vertices are numbered from 0 to n - 1. The third line contains the description of the colors of the vertices: n integers x0, x1, ..., xn - 1 (xi is either 0 or 1). If xi is equal to 1, vertex i is colored black. Otherwise, vertex i is colored white.

Output a single integer — the number of ways to split the tree modulo 1000000007 (109 + 7).

import qualified Data.List.Split as Split
import qualified Data.Tree as T
import qualified Data.Array as A
import Data.Int

data Color = Black | White

type Node = Int64

myToInt64 x = read x :: Int64
getInt64List = fmap ((map myToInt64) .(Split.splitOn " ")) getLine

listToAdjList :: Int64 -> [Int64] -> A.Array Int64 [Node]
listToAdjList n edges =
  A.accumArray (\l i -> (i+1):l) [] (0, n-1) (zip edges [0..])

modu x = x `mod` 1000000007

f :: A.Array Int64 Color -> A.Array Int64 [Node] -> Node -> Int64 -> Int64
f colors edges node b = go node b
  where memo = A.array ((0,0), (n-1, 1)) [ ((i, j), recu i j) | i <- [0 .. n - 1], j <- [0, 1]]
        go node b = memo A.! (node, b)
        n = snd (A.bounds colors) + 1
        recu node b = ways (colors A.! node) b (edges A.! node)
        ways :: Color -> Int64 -> [Node] -> Int64
        ways Black 1 ch = multiplyAll ch
        ways Black 0 ch = 0
        ways White 1 ch = fst $
          foldr (\c (r,p) ->
                   (modu $ modu (r * both c) + modu(p * go c 1),
                    modu $ p * both c))
                (0, 1)
                ch
        ways White 0 ch = multiplyAll ch
        multiplyAll :: [Node] -> Int64
        multiplyAll = moduProduct . (map both)
        both c = modu $ sum [go c b | b <- [0, 1]]

moduProduct :: [Int64] -> Int64
moduProduct = foldr (\x y -> modu $ x * y) 1

main = do
  n <- fmap myToInt64 getLine
  edges <- getInt64List
  colors <- fmap (map (\x -> case x of
                              1 -> Black
                              0 -> White))
                 getInt64List
  print $ f (A.listArray (0, n - 1) colors) (listToAdjList n edges) 0 1

import qualified Data.List.Split as Split
import qualified Data.Tree as T
import qualified Data.Array as A
import Data.Int
import Data.List as L

data Color = Black | White

type Node = Int64

myToInt64 x = read x :: Int64
getInt64List = fmap ((map myToInt64) .(Split.splitOn " ")) getLine

listToAdjList :: Int64 -> [Int64] -> A.Array Int64 [Node]
listToAdjList n edges =
  A.accumArray (\l i -> (i+1):l) [] (0, n-1) (zip edges [0..])

modu x = x `mod` 1000000007

f :: A.Array Int64 Color -> A.Array Int64 [Node] -> Node -> Int64 -> Int64
f colors edges node b = go node b
  where memo = A.array ((0,0), (n-1, 1)) [ ((i, j), recu i j) | i <- [0 .. n - 1], j <- [0, 1]]
        go node b = memo A.! (node, b)
        n = snd (A.bounds colors) + 1
        recu node b = ways (colors A.! node) b (edges A.! node)
        ways :: Color -> Int64 -> [Node] -> Int64
        ways Black 1 ch = multiplyAll ch
        ways Black 0 ch = 0
        ways White 1 ch = fst $
          L.foldl' (\(r,p) c ->
                   (modu $ modu (r * both c) + modu(p * go c 1),
                    modu $ p * both c))
                (0, 1)
                ch
        ways White 0 ch = multiplyAll ch
        multiplyAll :: [Node] -> Int64
        multiplyAll = moduProduct . (map both)
        both c = modu $ sum [go c b | b <- [0, 1]]

moduProduct :: [Int64] -> Int64
moduProduct = L.foldl' (\x y -> modu $ x * y) 1

main = do
  n <- fmap myToInt64 getLine
  edges <- getInt64List
  colors <- fmap (map (\x -> case x of
                              1 -> Black
                              0 -> White))
                 getInt64List
  print $ f (A.listArray (0, n - 1) colors) (listToAdjList n edges) 0 1

import qualified Data.List.Split as Split
import qualified Data.Tree as T
import qualified Data.Array as A

data Color = Black | White

type Node = Integer

myToInteger x = read x :: Integer
getIntegerList = fmap ((map myToInteger) .(Split.splitOn " ")) getLine

listToAdjList :: Integer -> [Integer] -> A.Array Integer [Node]
listToAdjList n edges =
  A.accumArray (\l i -> (i+1):l) [] (0, n-1) (zip edges [0..])

modu x = x `mod` 1000000007

f :: A.Array Integer Color -> A.Array Integer [Node] -> Node -> Integer -> Integer
f colors edges node b = go node b
  where memo = A.array ((0,0), (n-1, 1)) [ ((i, j), recu i j) | i <- [0 .. n - 1], j <- [0, 1]]
        go node b = memo A.! (node, b)
        n = snd (A.bounds colors) + 1
        recu node b = ways (colors A.! node) b (edges A.! node)
        ways :: Color -> Integer -> [Node] -> Integer
        ways Black 1 ch = multiplyAll ch
        ways Black 0 ch = 0
        ways White 1 ch = fst $
          foldr (\c (r,p) ->
                   (modu $ modu (r * both c) + modu(p * go c 1),
                    modu $ p * both c))
                (0, 1)
                ch
        ways White 0 ch = multiplyAll ch
        multiplyAll :: [Node] -> Integer
        multiplyAll = moduProduct . (map both)
        both c = modu $ sum [go c b | b <- [0, 1]]

moduProduct :: [Integer] -> Integer
moduProduct = foldr (\x y -> modu $ x * y) 1

main = do
  n <- fmap myToInteger getLine
  edges <- getIntegerList
  colors <- fmap (map (\x -> case x of
                              1 -> Black
                              0 -> White))
                 getIntegerList
  print $ f (A.listArray (0, n - 1) colors) (listToAdjList n edges) 0 1

import qualified Data.List.Split as Split
import qualified Data.Tree as T
import qualified Data.Array as A

data Color = Black | White

type Node = Int

toInt x = read x :: Int
getIntList = fmap ((map toInt) .(Split.splitOn " ")) getLine

listToAdjList :: Int -> [Int] -> A.Array Int [Node]
listToAdjList n edges =
  A.accumArray (\l i -> (i+1):l) [] (0, n-1) (zip edges [0..])

modu x = x `mod` 1000000007

f :: A.Array Int Color -> A.Array Int [Node] -> Node -> Int -> Int
f colors edges node b = go node b
  where memo = A.array ((0,0), (n-1, 1)) [ ((i, j), recu i j) | i <- [0 .. n - 1], j <- [0, 1]]
        go node b = memo A.! (node, b)
        n = snd (A.bounds colors) + 1
        recu node b = ways (colors A.! node) b (edges A.! node)
        ways :: Color -> Int -> [Node] -> Int
        ways Black 1 ch = multiplyAll ch
        ways Black 0 ch = 0
        ways White 1 ch = fst $
          foldr (\c (r,p) ->
                   (modu $ modu (r * both c) + modu(p * go c 1),
                    modu $ p * both c))
                (0, 1)
                ch
        ways White 0 ch = multiplyAll ch
        multiplyAll :: [Node] -> Int
        multiplyAll = moduProduct . (map both)
        both c = modu $ sum [go c b | b <- [0, 1]]

moduProduct :: [Int] -> Int
moduProduct = foldr (\x y -> modu $ x * y) 1

main = do
  n <- fmap toInt getLine
  edges <- getIntList
  colors <- fmap (map (\x -> case x of
                              1 -> Black
                              0 -> White))
                 getIntList
  print $ f (A.listArray (0, n - 1) colors) (listToAdjList n edges) 0 1

import qualified Data.List.Split as Split
import qualified Data.Tree as T
import qualified Data.Array as A

data Color = Black | White

type Node = Int

toInt x = read x :: Int
getIntList = fmap ((map toInt) .(Split.splitOn " ")) getLine

listToAdjList :: Int -> [Int] -> A.Array Int [Node]
listToAdjList n edges =
  A.accumArray (\l i -> (i+1):l) [] (0, n-1) (zip edges [0..])

modu x = x `mod` 1000000007

f :: A.Array Int Color -> A.Array Int [Node] -> Node -> Int -> Int
f colors edges node b = go node b
  where memo = A.array ((0,0), (n-1, 1)) [ ((i, j), recu i j) | i <- [0 .. n - 1], j <- [0, 1]]
        go node b = memo A.! (node, b)
        n = snd (A.bounds colors) + 1
        recu node b = ways (colors A.! node) b (edges A.! node)
        ways :: Color -> Int -> [Node] -> Int
        ways Black 1 ch = multiplyAll ch
        ways Black 0 ch = 0
        ways White 1 ch = fst $
          foldr (\c (r,p) ->
                   (modu $ r * both c + p * go c 1,
                    modu $ p * both c))
                (0, 1)
                ch
        ways White 0 ch = multiplyAll ch
        multiplyAll :: [Node] -> Int
        multiplyAll = moduProduct . map both
        both c = modu $ sum [go c b | b <- [0, 1]]

moduProduct :: [Int] -> Int
moduProduct = foldr (\x y -> modu $ x * y) 1

main = do
  n <- fmap toInt getLine
  edges <- getIntList
  colors <- fmap (map (\x -> case x of
                              1 -> Black
                              0 -> White))
                 getIntList
  print $ f (A.listArray (0, n - 1) colors) (listToAdjList n edges) 0 1


On February, 30th n students came in the Center for Training Olympiad Programmers (CTOP) of the Berland State University. They came one by one, one after another. Each of them went in, and before sitting down at his desk, greeted with those who were present in the room by shaking hands. Each of the students who came in stayed in CTOP until the end of the day and never left.At any time any three students could join together and start participating in a team contest, which lasted until the end of the day. The team did not distract from the contest for a minute, so when another student came in and greeted those who were present, he did not shake hands with the members of the contest writing team. Each team consisted of exactly three students, and each student could not become a member of more than one team. Different teams could start writing contest at different times.Given how many present people shook the hands of each student, get a possible order in which the students could have come to CTOP. If such an order does not exist, then print that this is impossible.Please note that some students could work independently until the end of the day, without participating in a team contest.

The first line contains integer n (1 ≤ n ≤ 2·105) — the number of students who came to CTOP. The next line contains n integers a1, a2, ..., an (0 ≤ ai < n), where ai is the number of students with who the i-th student shook hands.

If the sought order of students exists, print in the first line "Possible" and in the second line print the permutation of the students' numbers defining the order in which the students entered the center. Number i that stands to the left of number j in this permutation means that the i-th student came earlier than the j-th student. If there are multiple answers, print any of them. If the sought order of students doesn't exist, in a single line print "Impossible".

NoteIn the first sample from the statement the order of events could be as follows:   student 4 comes in (a4 = 0), he has no one to greet;  student 5 comes in (a5 = 1), he shakes hands with student 4;  student 1 comes in (a1 = 2), he shakes hands with two students (students 4, 5);  student 3 comes in (a3 = 3), he shakes hands with three students (students 4, 5, 1);  students 4, 5, 3 form a team and start writing a contest;  student 2 comes in (a2 = 1), he shakes hands with one student (number 1). In the second sample from the statement the order of events could be as follows:   student 7 comes in (a7 = 0), he has nobody to greet;  student 5 comes in (a5 = 1), he shakes hands with student 7;  student 2 comes in (a2 = 2), he shakes hands with two students (students 7, 5);  students 7, 5, 2 form a team and start writing a contest;  student 1 comes in(a1 = 0), he has no one to greet (everyone is busy with the contest);  student 6 comes in (a6 = 1), he shakes hands with student 1;  student 8 comes in (a8 = 2), he shakes hands with two students (students 1, 6);  student 3 comes in (a3 = 3), he shakes hands with three students (students 1, 6, 8);  student 4 comes in (a4 = 4), he shakes hands with four students (students 1, 6, 8, 3);  students 8, 3, 4 form a team and start writing a contest;  student 9 comes in (a9 = 2), he shakes hands with two students (students 1, 6). In the third sample from the statement the order of events is restored unambiguously:   student 1 comes in (a1 = 0), he has no one to greet;  student 3 comes in (or student 4) (a3 = a4 = 1), he shakes hands with student 1;  student 2 comes in (a2 = 2), he shakes hands with two students (students 1, 3 (or 4));  the remaining student 4 (or student 3), must shake one student's hand (a3 = a4 = 1) but it is impossible as there are only two scenarios: either a team formed and he doesn't greet anyone, or he greets all the three present people who work individually.

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

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

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

main = do
    n <- readLn :: IO Int
    as <- readInts
    let go k s | (M.null s) = return []
               | otherwise = do
                let v = M.findMax s
                let k1 :: Maybe Int
                    k1 = k + 1 <$ (guard $ M.member k s)
                    k2 :: Maybe Int
                    k2 = listToMaybe [ m' | m' <- [k-2,k-2-3..0],
                                            M.member (m'-1) s ]
                k' <- k1 <|> k2
                let (i,s') = case s M.! (k'-1)  of
                            [x] -> (x,M.delete (k'-1) s)
                            (x:xs) -> (x,M.insert (k'-1) xs s)
                (i:) <$> go k' s'
    case go 0 $ M.fromListWith (++) [ (a,[i]) | (a,i) <- zip as [1..] ] of
        Just l -> do
            putStrLn "Possible"
            putStrLn $ unwords $ map show l
        Nothing ->
            putStrLn "Impossible"

-- 0 -> 1
-- 1 -> 2
-- 2 -> 0
-- 2 -> 3
-- n -> n + 1
-- n -> n - k * 3 + 1
-- 0 {0,0,1,1,2,2,2,3,4} -> 1 {0,1,1,2,2,2,3,4} ->
-- 2 {0,1,2,2,2,3,4} -> 3 {0,1,2,2,3,4}
-- 4 {0,1,2,2,4} -> 5 {0,1,2,2}
-- 3 {0,1,2} -> 0 {1,2} -> 1 {2} -> 2 {}
--
-- n
--

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

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

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

main = do
    n <- readLn :: IO Int
    as <- readInts
    let go k s | (M.null s) = return []
               | otherwise = do
                let v = M.findMax s
                let k1 :: Maybe Int
                    k1 = k + 1 <$ (guard $ M.member k s)
                    k2 :: Maybe Int
                    k2 = listToMaybe [ m' | m' <- [k-2,k-2-3..0],
                                            M.member (m'-1) s ]
                k' <- k1 <|> k2
                let s' = case s M.! (k'-1)  of
                            1 -> M.delete (k'-1) s
                            x -> M.insert (k'-1) (x-1) s
                (k':) <$> go k' s'
    case go 0 $ M.fromListWith (+) [ (a,1) | a <- as ] of
        Just l -> do
            putStrLn "Possible"
            putStrLn $ unwords $ map show l
        Nothing ->
            putStrLn "Impossible"

-- 0 -> 1
-- 1 -> 2
-- 2 -> 0
-- 2 -> 3
-- n -> n + 1
-- n -> n - k * 3 + 1
-- 0 {0,0,1,1,2,2,2,3,4} -> 1 {0,1,1,2,2,2,3,4} ->
-- 2 {0,1,2,2,2,3,4} -> 3 {0,1,2,2,3,4}
-- 4 {0,1,2,2,4} -> 5 {0,1,2,2}
-- 3 {0,1,2} -> 0 {1,2} -> 1 {2} -> 2 {}
--
-- n
--


You are given two integers $$$a$$$ and $$$b$$$. You may perform any number of operations on them (possibly zero).During each operation you should choose any positive integer $$$x$$$ and set $$$a := a - x$$$, $$$b := b - 2x$$$ or $$$a := a - 2x$$$, $$$b := b - x$$$. Note that you may choose different values of $$$x$$$ in different operations.Is it possible to make $$$a$$$ and $$$b$$$ equal to $$$0$$$ simultaneously?Your program should answer $$$t$$$ independent test cases.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then the test cases follow, each test case is represented by one line containing two integers $$$a$$$ and $$$b$$$ for this test case ($$$0 \le a, b \le 10^9$$$).

For each test case print the answer to it — YES if it is possible to make $$$a$$$ and $$$b$$$ equal to $$$0$$$ simultaneously, and NO otherwise. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes and YES will all be recognized as positive answer).

NoteIn the first test case of the example two operations can be used to make both $$$a$$$ and $$$b$$$ equal to zero:  choose $$$x = 4$$$ and set $$$a := a - x$$$, $$$b := b - 2x$$$. Then $$$a = 6 - 4 = 2$$$, $$$b = 9 - 8 = 1$$$;  choose $$$x = 1$$$ and set $$$a := a - 2x$$$, $$$b := b - x$$$. Then $$$a = 2 - 2 = 0$$$, $$$b = 1 - 1 = 0$$$.

import Control.Monad; import Data.List; main = do { t <- readLn; replicateM_ t $ do { [a, b] <- fmap (sort . map read . words) getLine; putStrLn $ if or [mod (a + b) 3 > 0, b - a > a] then "NO" else "YES" } }

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

f :: Integer -> Integer -> String
f a b
    | mod (a + b) 3 > 0 = "NO"
    | b - a > a = "NO"
    | otherwise = "YES"

main :: IO()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b] <- fmap sort getIntList
        putStrLn $ f a b

import Control.Monad

solve :: Integer -> Integer -> Bool
solve x y = ((x+y) `mod` 3 ==0) && (2*min x y>=max x y)

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) then putStrLn "YES" else putStrLn "NO"

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

import Control.Monad

solve :: Int -> Int -> Bool
solve x y = ((x+y) `mod` 3 ==0) && (3*min x y>=max x y)

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) then putStrLn "YES" else putStrLn "NO"

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

import Control.Monad

solve :: Integer -> Integer -> Bool
solve x y = ((x+y) `mod` 3 ==0) && (3*min x y>=max x y)

routine :: IO ()
routine = do
  l <- fmap (map read . words) getLine
  if solve (head l) (l!!1) then putStrLn "YES" else putStrLn "NO"

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


Country of Metropolia is holding Olympiad of Metrpolises soon. It mean that all jury members of the olympiad should meet together in Metropolis (the capital of the country) for the problem preparation process.There are n + 1 cities consecutively numbered from 0 to n. City 0 is Metropolis that is the meeting point for all jury members. For each city from 1 to n there is exactly one jury member living there. Olympiad preparation is a long and demanding process that requires k days of work. For all of these k days each of the n jury members should be present in Metropolis to be able to work on problems.You know the flight schedule in the country (jury members consider themselves important enough to only use flights for transportation). All flights in Metropolia are either going to Metropolis or out of Metropolis. There are no night flights in Metropolia, or in the other words, plane always takes off at the same day it arrives. On his arrival day and departure day jury member is not able to discuss the olympiad. All flights in Megapolia depart and arrive at the same day.Gather everybody for k days in the capital is a hard objective, doing that while spending the minimum possible money is even harder. Nevertheless, your task is to arrange the cheapest way to bring all of the jury members to Metrpolis, so that they can work together for k days and then send them back to their home cities. Cost of the arrangement is defined as a total cost of tickets for all used flights. It is allowed for jury member to stay in Metropolis for more than k days.

The first line of input contains three integers n, m and k (1 ≤ n ≤ 105, 0 ≤ m ≤ 105, 1 ≤ k ≤ 106).  The i-th of the following m lines contains the description of the i-th flight defined by four integers di, fi, ti and ci (1 ≤ di ≤ 106, 0 ≤ fi ≤ n, 0 ≤ ti ≤ n, 1 ≤ ci ≤ 106, exactly one of fi and ti equals zero), the day of departure (and arrival), the departure city, the arrival city and the ticket cost.

Output the only integer that is the minimum cost of gathering all jury members in city 0 for k days and then sending them back to their home cities. If it is impossible to gather everybody in Metropolis for k days and then send them back to their home cities, output "-1" (without the quotes).

NoteThe optimal way to gather everybody in Metropolis in the first sample test is to use flights that take place on days 1, 2, 8 and 9. The only alternative option is to send jury member from second city back home on day 15, that would cost 2500 more.In the second sample it is impossible to send jury member from city 2 back home from Metropolis.

{-# 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.Trans.State.Lazy
import Control.Monad
import Data.Array.Unboxed
import Data.Int
import qualified Data.IntMap.Strict as M

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

data F = F { fDay :: !Int, fOrg :: !Int, fDest :: !Int, fCost :: !Int64 }

app = do
  n <- poi
  m <- poi
  k <- poi
  fs <- replicateM m $ liftM4 F poi poi poi (fmap fromIntegral poi)
  return $ show $ solve n k fs
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve n k fs0
  | null fs0 = -1
  | otherwise = (\m -> if m == maxBound then -1 else m) $ minimum $ (maxBound:) $ zipWith (\a b -> if a > 0 && b > 0 then a + b else maxBound) (elems mdeps) (drop (k + 1) $ elems mrets)
  where
  hi = maximum $ map fDay fs0
  d2fs = accumArray (flip (:)) [] (1, hi) $ map (\f -> (fDay f, f)) fs0 :: Array Int [F]
  go idx (m, cnt, cost) f = case M.insertLookupWithKey (\_ c' c -> min c c') (idx f) (fCost f) m of
    (Just c, m') -> (m', cnt, if c > fCost f then cost - c + fCost f else cost)
    (Nothing, m') -> (m', cnt + 1, cost + fCost f)
  mdeps = listArray (1, hi) $ map (\(_, cnt, cost) -> if cnt >= n then cost else 0) $ tail $ scanl (\st fs -> foldl (go fOrg) st $ filter ((== 0) . fDest) fs) (M.empty, 0, 0) $ elems d2fs :: UArray Int Int64
  mrets = array (1, hi) $ zip [hi, hi - 1..1] $ map (\(_, cnt, cost) -> if cnt >= n then cost else 0) $ tail $ scanl (\st d -> foldl (go fDest) st $ filter ((== 0) . fOrg) (d2fs!d)) (M.empty, 0, 0) [hi, hi - 1..1] :: UArray Int Int64

{-# 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.List
import Data.Int
import Data.Array
import qualified Data.Set as S

main = putStr . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  k <- poi
  cs <- replicateM n poi
  return $ unlines $ map show $ solve n k cs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve n k cs = liftM2 (:) (sum . map (\(i, (t, c)) -> (t - i) * c)) (map (fst . snd)) $ assocs $ array (1, to64 n) $ snd $ mapAccumL go ((\(f, s) -> (S.fromList f, s)) $ splitAt k $ flip (zipWith P) [1..] $ map to64 cs) [to64 (k + 1)..to64 (k + n)]
  where
  go (f, ss) t = ((f', ss'), (i, (t, c)))
    where
    ((P c i, f'), ss') = (\(a, b) -> (S.deleteFindMax a, b)) $ case ss of
      [] -> (f, [])
      s:rs -> (S.insert s f, rs)

data P = P !Int64 !Int64 deriving (Eq, Show, Ord)

{-

sum (ti - i) * ci
sum (ti*ci) - sum(i*ci)
min (ti*ci)

-}


You are given two even integers $$$n$$$ and $$$m$$$. Your task is to find any binary matrix $$$a$$$ with $$$n$$$ rows and $$$m$$$ columns where every cell $$$(i,j)$$$ has exactly two neighbours with a different value than $$$a_{i,j}$$$.Two cells in the matrix are considered neighbours if and only if they share a side. More formally, the neighbours of cell $$$(x,y)$$$ are: $$$(x-1,y)$$$, $$$(x,y+1)$$$, $$$(x+1,y)$$$ and $$$(x,y-1)$$$.It can be proven that under the given constraints, an answer always exists.

Each test contains multiple test cases. The first line of input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The following lines contain the descriptions of the test cases. The only line of each test case contains two even integers $$$n$$$ and $$$m$$$ ($$$2 \le n,m \le 50$$$) — the height and width of the binary matrix, respectively.

For each test case, print $$$n$$$ lines, each of which contains $$$m$$$ numbers, equal to $$$0$$$ or $$$1$$$ — any binary matrix which satisfies the constraints described in the statement. It can be proven that under the given constraints, an answer always exists.

NoteWhite means $$$0$$$, black means $$$1$$$. The binary matrix from the first test caseThe binary matrix from the second test caseThe binary matrix from the third test case

--
-- 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,m] <- ri
        return (n,m)
    mapM_ (putStr.showM.solve) tcs

showM = unlines . map showL
showL = unwords . map show

solve (n,m) = matr
  where
    matr = [[f (y-1,x-1) | x <- [1..m]]
            |              y <- [1..n] ]
    f (a,b) = (y+x) `mod` 2
      where
        y = (a+1) `div` 2
        x = (b+1) `div` 2

(>>>) = flip (.)

main :: IO ()
main =
  interact $
    lines
      >>> tail
      >>> map
        ( words
            >>> map read
            >>> solve
            >>> map (map show >>> unwords)
            >>> unlines
        )
      >>> unlines

solve :: [Int] -> [[Int]]
solve [n, m] =
  [ [ (bits (i `mod` 4) + bits (j `mod` 4)) `mod` 2
      | j <- [0 .. m - 1]
    ]
    | i <- [0 .. n - 1]
  ]

bits :: Int -> Int
bits 0 = 0
bits n = bits (n `div` 2) + (n `mod` 2)

getRow :: Int -> Int -> String
getRow i m = unwords $ take m $ cycle (if i `mod` 4 == 0 || i `mod` 4 == 3 then ["0", "1", "1", "0"] else ["1", "0", "0", "1"])

getNRows :: Int -> Int -> String
getNRows 0 _ = ""
getNRows n m = getNRows (n - 1) m ++ "\n" ++ getRow (n - 1) m

solveCase :: IO ()
solveCase = do
    dimensions <- getLine
    let nm = map (\w -> (read w :: Int)) $ words dimensions
    let n = head nm
    let m = last nm
    putStrLn $ getNRows n m

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

getRow :: Int -> Int -> String
getRow i m = unwords $ take m $ cycle (if i `mod` 4 == 0 || i `mod` 4 == 3 then ["0", "1", "1", "0"] else ["1", "0", "0", "1"])

getNRows :: Int -> Int -> String
getNRows 0 _ = ""
getNRows n m = getNRows (n - 1) m ++ "\n" ++ getRow (n - 1) m

solveCase :: IO ()
solveCase = do
    dimensions <- getLine
    let nm = map (\w -> (read w :: Int)) $ words dimensions
    let n = head nm
    let m = last nm
    putStrLn $ getNRows n m

solve :: Int -> IO ()
solve cases_left = do
    if cases_left == 1 then
        solveCase
    else do
        solveCase
        solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

m :: Int64
m = 998_244_353

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> Int -> [[Int]]
solve n m = do
    i <- [1 .. n]
    let iValue = (i `div` 2) `mod` 2
    let
        row :: [Int] = do
            j <- [1 .. m]
            let jValue = (j `div` 2) `mod` 2
            return $ iValue `xor` jValue
    return row

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> readIntB8s
        let answer = solve n m
        forM_ answer $ \row -> do
            forM_ row $ \value -> do
                printf "%d " value
            putStrLn ""

-- 1 0 0 1
-- 0 1 1 0
-- 0 1 1 0
-- 1 0 0 1
-- 1 0 0 1
-- 0 1 1 0
-- 0 1 1 0
-- 1 0 0 1

{-# LANGUAGE CPP #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace

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

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

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  m <- getInt
  let
    row1 = take m $ cycle $ [1, 0] ++ [0, 1]
    row2 = take m $ cycle $ [0, 1] ++ [1, 0]
    rows = cycle $ [row1, row2, row2, row1]
    ans = take n rows
  fmap mconcat $ sequence $ fmap (pure . putInts) ans

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

gen :: Int -> Int -> Int
gen x y = let (x1, y1) = (x `mod` 4, y `mod` 4) in [[1, 0, 0, 1], [0, 1, 1, 0], [0, 1, 1, 0], [1, 0, 0, 1]] !! x1 !! y1

pr :: [[Int]] -> IO ()
pr [] = pure ()
pr (x: xs) = do
  putStrLn $ concat $ map (\x -> show x ++ " ") x
  pr xs

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: m: _) <- readArr
  pr $ map (\x -> map (\y -> gen x y) [0..(m - 1)]) [0..(n - 1)]
  for $ i - 1

main :: IO ()
main = do
  n <- readLn :: IO Int
  for 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,m] <- ri
        return (n,m)
    mapM_ (putStr.showM.solve) tcs

showM = unlines . map showL
showL = unwords . map show

solve (n,m) = matr
  where
    matr = [[f (y,x) | x <- [1..m]]
            |          y <- [1..n] ]
    f (y,x) = (y+x) `mod` 2

(>>>) = flip (.)

main :: IO ()
main =
  interact $
    lines
      >>> tail
      >>> map
        ( words
            >>> map read
            >>> solve
            >>> map (map show >>> unwords)
            >>> unlines
        )
      >>> unlines

solve :: [Int] -> [[Int]]
solve [n, m] =
  [ [ (bits i + bits j) `mod` 2
      | j <- [0 .. m -1]
    ]
    | i <- [0 .. n -1]
  ]

bits :: Int -> Int
bits 0 = 0
bits n = bits (n `div` 2) + (n `mod` 2)


After you had helped George and Alex to move in the dorm, they went to help their friend Fedor play a new computer game «Call of Soldiers 3».The game has (m + 1) players and n types of soldiers in total. Players «Call of Soldiers 3» are numbered form 1 to (m + 1). Types of soldiers are numbered from 0 to n - 1. Each player has an army. Army of the i-th player can be described by non-negative integer xi. Consider binary representation of xi: if the j-th bit of number xi equal to one, then the army of the i-th player has soldiers of the j-th type. Fedor is the (m + 1)-th player of the game. He assume that two players can become friends if their armies differ in at most k types of soldiers (in other words, binary representations of the corresponding numbers differ in at most k bits). Help Fedor and count how many players can become his friends.

The first line contains three integers n, m, k (1 ≤ k ≤ n ≤ 20; 1 ≤ m ≤ 1000). The i-th of the next (m + 1) lines contains a single integer xi (1 ≤ xi ≤ 2n - 1), that describes the i-th player's army. We remind you that Fedor is the (m + 1)-th player.

Print a single integer — the number of Fedor's potential friends.

import Control.Monad

type BinaryArmy = [Int]

getArmies :: Int -> IO [Int]
getArmies n = replicateM n getArmy

getArmy :: IO Int
getArmy = do
    army <- getLine
    return $ read army

countFriends :: Int -> [Int] -> Int -> Int
countFriends army [] k = 0
countFriends army (player:others) k = (if binaryDifference binaryArmy binaryPlayer > k
                                      then 0
                                      else 1) + countFriends army others k
    where binaryArmy = toBinary army
          binaryPlayer = toBinary player

toBinary :: Int -> BinaryArmy
toBinary 0 = []
toBinary n = (n `mod` 2) : toBinary (n `div` 2)

binaryDifference :: BinaryArmy -> BinaryArmy -> Int
binaryDifference [] [] = 0
binaryDifference [] binary = sum binary
binaryDifference binary [] = sum binary
binaryDifference (x:xs) (y:ys) = (if x == y
                                 then 0
                                 else 1) + binaryDifference xs ys

main :: IO ()
main = do
    input <- getLine
    let [n, m, k] = map read (words input)
    armies <- getArmies m
    _army <- getLine
    let army = read _army
    putStrLn $ show $ countFriends army armies k

import Control.Monad
main = interact $ show . solve . map read . words
solve(_:_:k:xs)=(length $ filter (\y->k>=(diff y $ last xs)) xs)-1
diff 0 0 = 0
diff x y = (diff (div x 2) (div y 2))+a
	where a=if odd x==odd y then 0 else 1

import Data.Bits

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

solve :: [Int] -> Int
solve (_:m:k:x) = solve' (init x) (last x)
    where solve' :: [Int] -> Int -> Int
          solve' []     _ = 0
          solve' (x:xs) l | popCount (xor x l) <= k = 1 + solve' xs l
                          | otherwise               = solve' xs l

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

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

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

solve :: [Int] -> Int
solve (n:m:k:xs) = sum $ map (\x -> if (popCount $ xor x l) <= k then 1 else 0) (init xs)
	where l = last xs

import Data.Bits

main = do
  [n, m, k] <- fmap (map read . words) getLine
  xs <- fmap (map read . lines) getContents :: IO [Int]

  let
    x = last xs

  print $ length $ filter (\y -> popCount (x `xor` y) <= k) $ init xs

import Data.Bits
main=getContents>>=print.solve.map read.words
solve(_:_:k:xs)=length[x|x<-xs,popCount(x`xor`last xs)<=k]-1

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
--import Data.Bits.Bitwise as Bit
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine>>= \ns-> let [x,y,z]= map read $ words ns  in (solve.(++) [z].concat =<< forM [1 .. y+1] ( \i -> map (fst.fromJust.C.readInt).C.words <$> C.getLine))
solve::[Int]->IO()
solve (x:xs) = let l=last xs in  print $ sum $ map (\a->if popCount (xor a l)<=x then 1 else 0) (init xs)

import Control.Applicative
import Data.Bits
import Control.Monad

solve :: Int -> [Int] -> Int -> Int
solve m ms k = length $ filter ((<=k).popCount.xor m) ms

main = do
    [_,m,k] <- fmap read.words <$> getLine
    ms <- replicateM (m+1) (read <$> getLine)
    print $ solve (last ms) (init ms) k

import Data.Bits
import Control.Applicative
import qualified Data.List as L

main = do
  [n,m,k] <- map read . words <$> getLine :: IO [Int]
  xs <- map read . lines <$> getContents
  let (ls,[fed]) = L.splitAt m xs :: ([Int], [Int])
      diff = map (popCount . xor fed) ls
  print . sum $ map (\x -> if x <= k then 1 else 0) diff

import Data.Bits(popCount,xor)

main = interact solve

solve input = show (foldr folder 0 tocheck)
    where
        folder::Int->Int->Int
        folder current count = if popCount (current `xor` own) > k then
                                    count
                               else
                                    count+1
        numbers = (map read . words) input
        (n:m:k:thelist) = numbers
        tocheck::[Int]
        tocheck = init thelist
        own = last thelist

module Main where

import Control.Monad
import Data.List
import Data.Bits

main :: IO ()
main = do
    [_, m, k] <- getLine >>= (mapM (return . (read :: String -> Int))) . words
    vals <- forM [1..(m+1)] (\_ -> getLine >>= (return . (read :: String -> Int)))
    print . length $ filter (<=k) [popCount (xor (last vals) i) | i <- init vals]

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

main=do
  [n,m,k]<-map read <$> words <$> getLine ::IO [Int]
  s<-map read <$> lines <$> getContents ::IO [Int]
  let q = last s
  let s1 = init s
  print $  length $  filter (<=k) $ map popCount $ map (xor q) s1

import Numeric (showIntAtBase)
import Data.Bits (xor)
import Data.Char (intToDigit)

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

solve :: [Int] -> Int
solve (_:_:k:xs) = length [ x | x <- init xs, length (filter (=='1') (showIntAtBase 2 intToDigit (x `xor` last xs) "")) <= k ]
solve _ = undefined

import Data.Bits (xor, popCount)

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

solve :: [Int] -> Int
solve (_:_:k:xs) = length [ x | x <- init xs, popCount (x `xor` last xs) <= k ]
solve _ = undefined

import Data.Bits
main=getContents>>=print.solve.map read.words
solve(_:_:k:xs)=length[x|x<-init xs,popCount(x`xor`last xs)<=k]

import Data.Bits
main = interact $ show . solve . map read . words
solve (n:m:k:xs) = length $ filter ((<= k) . popCount) $ map (xor f) es
  where (es,[f]) = splitAt m xs

import Data.Bits

main :: IO()
main = do
    co <- getContents
    let (n:m:k:ca) = map read $ words co
        va = take (1+m) ca
        fu = va !! m
        in putStrLn $ show $ (length [x | x <- va, popCount (x `xor` fu) <= k]) - 1

import Data.Bits

main :: IO()
main = do
    co <- getContents
    let (n:m:k:ca) = map read $ words co
        va = take (1+m) ca
        fu = va !! m
        in putStrLn $ show $ (length $ filter (\x -> popCount (x `xor` fu) <= k) va) - 1

module Main where

import Data.List (unfoldr)
import Data.Bits (xor)
import Control.Monad (replicateM)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

readNumber = head `fmap` readNumbers

binaryList :: Int -> [Int]
binaryList n0 =
  reverse $
  unfoldr (\n ->
              if n > 0
                 then Just (n `mod` 2, n `div` 2)
                 else Nothing)
            n0

friendship :: Int -> Int -> Int
friendship fedor other =
  sum (binaryList (xor fedor other))

main :: IO ()
main = do
  (_n:m:k:_) <- readNumbers
  others <- replicateM m readNumber
  fedor  <- readNumber
  print (length (filter (<= k)
                        (map (friendship fedor) others)))

import Control.Applicative
import Data.List
import Data.Bits

main= do
	[n,m,k]<- map read. words <$> getLine ::IO [Int]
	s<- map read. words <$> getContents ::IO [Int]
	let s1= init s
	let f = last s
	print $ length $ filter (<=k) $ map (popCount.xor f) s1

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

sol (_:_:k:xs) = (subtract 1) $ length $ filter id $ map (\x -> k >= (dif x $ last xs)) xs

dif 0 0 = 0
dif a b
    | odd a == odd b = nx
    | otherwise      = nx+1
    where nx = dif (a `div` 2) (b `div` 2)

import Data.Bits

main :: IO ()
main = do
        _:_:k:xs <- getReadAll
        print $ solve k xs

solve :: Int -> [Int] -> Int
solve k xs = length $ filter (\x-> popCount(xor fedor x) <= k) rest
    where
        rest = init xs
        fedor = last xs

getReadAll :: (Read a) => IO [a]
getReadAll = fmap (fmap read. words) getContents


Let's consider a k × k square, divided into unit squares. Please note that k ≥ 3 and is odd. We'll paint squares starting from the upper left square in the following order: first we move to the right, then down, then to the left, then up, then to the right again and so on. We finish moving in some direction in one of two cases: either we've reached the square's border or the square following after the next square is already painted. We finish painting at the moment when we cannot move in any direction and paint a square. The figure that consists of the painted squares is a spiral.   The figure shows examples of spirals for k = 3, 5, 7, 9.  You have an n × m table, each of its cells contains a number. Let's consider all possible spirals, formed by the table cells. It means that we consider all spirals of any size that don't go beyond the borders of the table. Let's find the sum of the numbers of the cells that form the spiral. You have to find the maximum of those values among all spirals.

The first line contains two integers n and m (3 ≤ n, m ≤ 500) — the sizes of the table. Each of the next n lines contains m space-separated integers: the j-th number in the i-th line aij ( - 1000 ≤ aij ≤ 1000) is the number recorded in the j-th cell of the i-th row of the table.

Print a single number — the maximum sum of numbers among all spirals.

NoteIn the first sample the spiral with maximum sum will cover all 1's of the table.In the second sample the spiral may cover only six 1's.

{-# OPTIONS_GHC -O2 -optc-O3 -funbox-strict-fields -XBangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array.Base (unsafeAt)
import Data.Array.Unboxed (UArray, listArray, (!))
import qualified Data.ByteString.Char8 as C

solve :: Int -> Int -> [[Int]] -> Int
solve r c a = maximum $ [total i j | i <- [1 .. r], j <- [1 .. c]]
  where
    inf = 10000
    b = replicate (c+1) 0: map (0:) a
    e :: UArray Int Int
    e = listArray (0,(r+1)*(c+1)) $ concat b
    s :: UArray Int Int
    s = listArray (0,(r+1)*(c+1)) $ concat $ scanl1 (zipWith (+)) $ map (scanl1 (+)) b
    query !(x1, y1, x2, y2) =
      unsafeAt s (x2 * (c + 1) + y2) +
      unsafeAt s (x1 * (c + 1) + y1) -
      unsafeAt s (x1 * (c + 1) + y2) -
      unsafeAt s (x2 * (c + 1) + y1)
    total !x !y = maximum $ (-inf:) $ drop 1 $ scanl1 subtract $ center: map diff [1 .. m]
      where
        m = minimum [x - 1, y - 1, r - x, c - y]
        center = unsafeAt e (x * (c + 1) + y)
        diff z =
          query (x - z - 1, y - z - 1, x + z, y + z) -
          unsafeAt e ((x - z + 1) * (c + 1) + y - z)

main = do
  [r, c] <- getArray
  a <- replicateM r getArray
  print $ solve r c a
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

-- Time limit exceeded on test 19

{-# OPTIONS_GHC -O2 -optc-O3 -funbox-strict-fields -XBangPatterns #-}
import Control.Monad
import Data.Array.Base (unsafeAt)
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve r c a = e `seq` s `seq` maximum $ [total i j | i <- [1 .. r], j <- [1 .. c]]
  where
    inf = 10000
    e = listArray ((1,1),(r,c)) $! concat a
    s = listArray ((0,0),(r,c)) $! concat $!
      scanl (zipWith (+)) (replicate (c+1) 0) $! map (scanl (+) 0) a
    query !t !(a, b, c, d) =
      unsafeAt s (t + a) -
      unsafeAt s (t + a) -
      unsafeAt s (t + a) +
      unsafeAt s (t + a)
    todo = [(\[a, b, c, d] -> (a, b, c, d))
      [x * (c + 1) + y | x <- [-i - 1, i], y <- [-i - 1, i]] | i <- [1 ..]]
    total !x !y = maximum $ (-inf:) $ drop 1 $ scanl1 subtract $
      ((e!(x,y)):) $ map diff $ zip [1 .. m] todo
      where
        m = minimum [x - 1, y - 1, r - x, c - y]
        diff !(z, off) = query (x * (c + 1) + y) off - e!(x - z + 1, y - z)

main = do
  [r, c] <- getArray
  a <- replicateM r getArray
  print $ solve r c a
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

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

(>+<) = liftM2 (+)
(>-<) = liftM2 (-)

sumTable r c a = listArray ((0,0),(r,c)) $ concat $
  scanl (zipWith (+)) (replicate (c+1) 0) $ map (scanl (+) 0) a

querySum s (x1, y1, x2, y2) = at (x2, y2) >+< at (x1, y1) >-< at (x1, y2) >-< at (x2, y1)
  where
    r = bounds s
    at i = if inRange r i then Just $ s!i else Nothing

solve r c a = maximum $ [total i j | i <- [1 .. r], j <- [1 .. c]]
  where
    e = listArray ((1,1),(r,c)) $ concat a
    s = sumTable r c a
    total x y = maximum $ (0:) $ drop 1 $ scanl1 subtract $
      map fromJust $ takeWhile isJust $ Just (e!(x,y)): map diff [1 ..]
      where
        shift x y (a, b, c, d) = (a + x, b + y, c + x, d + y)
        query = querySum s . shift x y
        diff z = query (-z - 1, -z - 1, z, z) >-< query (-z, -z - 1, -z + 1, -z)

main = do
  [r, c] <- getArray
  a <- replicateM r getArray
  print $ solve r c a
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine