A schoolboy named Vasya loves reading books on programming and mathematics. He has recently read an encyclopedia article that described the method of median smoothing (or median filter) and its many applications in science and engineering. Vasya liked the idea of the method very much, and he decided to try it in practice.Applying the simplest variant of median smoothing to the sequence of numbers a1, a2, ..., an will result a new sequence b1, b2, ..., bn obtained by the following algorithm:  b1 = a1, bn = an, that is, the first and the last number of the new sequence match the corresponding numbers of the original sequence.  For i = 2, ..., n - 1 value bi is equal to the median of three values ai - 1, ai and ai + 1. The median of a set of three numbers is the number that goes on the second place, when these three numbers are written in the non-decreasing order. For example, the median of the set 5, 1, 2 is number 2, and the median of set 1, 0, 1 is equal to 1.In order to make the task easier, Vasya decided to apply the method to sequences consisting of zeros and ones only.Having made the procedure once, Vasya looked at the resulting sequence and thought: what if I apply the algorithm to it once again, and then apply it to the next result, and so on? Vasya tried a couple of examples and found out that after some number of median smoothing algorithm applications the sequence can stop changing. We say that the sequence is stable, if it does not change when the median smoothing is applied to it.Now Vasya wonders, whether the sequence always eventually becomes stable. He asks you to write a program that, given a sequence of zeros and ones, will determine whether it ever becomes stable. Moreover, if it ever becomes stable, then you should determine what will it look like and how many times one needs to apply the median smoothing algorithm to initial sequence in order to obtain a stable one.

The first input line of the input contains a single integer n (3 ≤ n ≤ 500 000) — the length of the initial sequence. The next line contains n integers a1, a2, ..., an (ai = 0 or ai = 1), giving the initial sequence itself.

If the sequence will never become stable, print a single number  - 1. Otherwise, first print a single integer — the minimum number of times one needs to apply the median smoothing algorithm to the initial sequence before it becomes is stable. In the second line print n numbers separated by a space  — the resulting sequence itself.

NoteIn the second sample the stabilization occurs in two steps: , and the sequence 00000 is obviously stable.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where

import Control.Applicative
import Data.Foldable (foldMap)
import Data.List
import Data.Monoid

newtype Nat = Nat Int deriving (Eq, Ord, Num)

instance Monoid Nat where
  mempty  = 0
  mappend = max

data Segment = Segment Int Bool deriving Show

type Solution = (Nat, [Bool])

segments :: [Bool] -> [Segment]
segments = foldr f []
  where
    f x (s@(Segment n y):ss)
      | odd n == (x /= y) = Segment (n + 1) y : ss
    f x ss = Segment 1 x : ss

solveSegment :: Segment -> Solution
solveSegment (Segment n x)
  | even n    = (Nat (k - 1), replicate k (not x) ++ replicate k x)
  | otherwise = (Nat k,       replicate n x)
  where
    k = n `div` 2

solve :: [Bool] -> Solution
solve = foldMap solveSegment . segments

main :: IO ()
main = do
  _ <- getLine
  xs <- map (toEnum . read) . words <$> getLine
  let (Nat n, ys) = solve xs
  print n
  putStrLn (showSeq ys)

  where
    showSeq = intercalate " " . map (show . fromEnum)

module Main where
import Data.List
import Debug.Trace

split :: String -> [String]
split str = result where
  result
    | remain == "" = reslist
    | otherwise = remain:reslist
  (remain, reslist) = foldr process ("", []) str
  process ' ' ("", a) = ("", a)
  process ' ' (str, a) = ("", str:a)
  process c (str, a) = (c:str, a)

summerize :: [Int] -> (Int, Int)
summerize xs = (head xs, length xs)

dupHeadTail :: [Int] -> [Int]
dupHeadTail xs@(x:_) = x:dupTail xs where
  dupTail (x:[]) = [x, x]
  dupTail (x:xs) = x:dupTail xs

remHeadTail :: [Int] -> [Int]
remHeadTail xss@(x:xs) = remTail xs where
  remTail (x:[]) = []
  remTail (x:xs) = x:remTail xs

main = do
  getLine -- for length, which we don't need
  input <- getLine
  let
    result1 = (maxOne + 1) `div` 2
    result2List = remHeadTail $ expand header result2Lens
    origList = dupHeadTail $ (read :: String -> Int) `map` split input
    header = head origList
    lenList = length `map` group origList
    groupLen = group lenList
    lenLens = length `map` filter ((==1) . head) groupLen
    maxOne
      | lenLens == [] = 0
      | otherwise = maximum lenLens
    result2Lens = concat . map modOne $ groupLen
    modOne xs@(1:_) =
      if length xs `mod` 2 == 0 then
        [0, length xs `div` 2, length xs `div` 2, 0]
      else
        [0, length xs, 0]
    modOne xs = xs
    expand h xs = concat $ zipWith replicate xs (cycle [h, 1-h])
  print result1
  putStrLn $ " " `intercalate` (show `map` result2List)

module Main where
import Data.List
import Data.List.Split

main = do
  getLine -- for length, which we don't need
  input <- getLine
  let
    list = (read :: String -> Int) `map` splitOn " " input
    result2List = init . tail $ expand (head origList) result2Lens
    origList = head list : list ++ [last list]
    groupLen = group $ length `map` group origList
    lenLens = length `map` filter ((==1) . head) groupLen
    result2Lens = concat . map modOne $ groupLen
    modOne xs@(1:_) =
      if length xs `mod` 2 == 0 then
        [0, length xs `div` 2, length xs `div` 2, 0]
      else
        [0, length xs, 0]
    modOne xs = xs
    expand h xs = concat $ zipWith replicate xs (cycle [h, 1-h])
  print $ (maximum (0:lenLens) + 1) `div` 2
  putStrLn $ " " `intercalate` (show `map` result2List)

module Main where
import Data.List
import Data.List.Split

main = do
  getLine -- for length, which we don't need
  input <- getLine
  let
    list = (read :: String -> Int) `map` splitOn " " input
    result2List = init . tail $ expand (head origList) result2Lens
    origList = [head list] ++ list ++ [last list]
    groupLen = group $ length `map` group origList
    lenLens = length `map` filter ((==1) . head) groupLen
    result2Lens = concat . map modOne $ groupLen
    modOne xs@(1:_) =
      if length xs `mod` 2 == 0 then
        [0, length xs `div` 2, length xs `div` 2, 0]
      else
        [0, length xs, 0]
    modOne xs = xs
    expand h xs = concat $ zipWith replicate xs (cycle [h, 1-h])
  print $ (maximum (0:lenLens) + 1) `div` 2
  putStrLn $ " " `intercalate` (show `map` result2List)

module Main where
import Data.List
import Debug.Trace
import Data.List.Split

{-
split :: String -> [String]
split str = result where
  result
    | remain == "" = reslist
    | otherwise = remain:reslist
  (remain, reslist) = foldr process ("", []) str
  process ' ' ("", a) = ("", a)
  process ' ' (str, a) = ("", str:a)
  process c (str, a) = (c:str, a)
-}

summerize :: [Int] -> (Int, Int)
summerize xs = (head xs, length xs)

dupHeadTail :: [Int] -> [Int]
dupHeadTail xs@(x:_) = x:dupTail xs where
  dupTail (x:[]) = [x, x]
  dupTail (x:xs) = x:dupTail xs

remHeadTail :: [Int] -> [Int]
remHeadTail xss@(x:xs) = remTail xs where
  remTail (x:[]) = []
  remTail (x:xs) = x:remTail xs

main = do
  getLine -- for length, which we don't need
  input <- getLine
  let
    result1 = (maxOne + 1) `div` 2
    result2List = remHeadTail $ expand header result2Lens
    origList = dupHeadTail $ (read :: String -> Int) `map` splitOn " " input
    header = head origList
    lenList = length `map` group origList
    groupLen = group lenList
    lenLens = length `map` filter ((==1) . head) groupLen
    maxOne
      | lenLens == [] = 0
      | otherwise = maximum lenLens
    result2Lens = concat . map modOne $ groupLen
    modOne xs@(1:_) =
      if length xs `mod` 2 == 0 then
        [0, length xs `div` 2, length xs `div` 2, 0]
      else
        [0, length xs, 0]
    modOne xs = xs
    expand h xs = concat $ zipWith replicate xs (cycle [h, 1-h])
  print result1
  putStrLn $ " " `intercalate` (show `map` result2List)

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

splitAll :: [Int] -> [[Int]]

splitAll []
  = [[]]
splitAll [x]
  = [[x]]
splitAll [x,y]
  | x == y = [[x],[y]]
  | x /= y = [[x,y]]
splitAll (x:y:xs)
  | x == y && null rest = [x] : [[y]]
  | x == y              = [x] : rest
  | otherwise           = (x : h) : t
  where
    rest  = splitAll (y:xs)
    (h:t) = rest

change :: [Int] -> [Int]
change xs
  | n < 3  = xs
  | odd  n = arrOf (n-1) ft ++ [lt]
  | even n = arrOf hn ft ++ arrOf hn lt
  where
    n  = length xs
    hn = n `div` 2
    ft = head xs
    lt = last xs

    arrOf l v
      = take l $ repeat v

solve :: [Int] -> (Int,[Int])
solve xs
  = ( ans, concat arr' )
  where
    ans = ( maximum (map length arr) - 1 ) `div` 2
    arr  = splitAll xs
    arr' = map change arr

output :: (Int,[Int]) -> String
output (x, xs) = show x ++ "\n" ++ ( concat $ map (++ " ") (map show xs) )

main = ( output . solve . map ( read :: String -> Int ) . words . last . lines) <$> getContents >>= putStrLn

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

splitAll :: [Int] -> [[Int]]

splitAll []
  = [[]]
splitAll [x]
  = [[x]]
splitAll [x,y]
  | x == y = [[x],[y]]
  | x /= y = [[x,y]]
splitAll (x:y:xs)
  | x == y && null rest = [x] : [[y]]
  | x == y              = [x] : (y : h) : t
  | otherwise           = (x : h') : t'
  where
    rest  = splitAll xs
    (h:t) = rest

    rest'   = splitAll (y:xs)
    (h':t') = rest'

change :: [Int] -> [Int]
change xs
  | n < 2  = xs
  | odd  n = arrOf n ft
  | even n = arrOf hn ft ++ arrOf hn lt
  where
    n  = length xs
    hn = n `div` 2
    ft = head xs
    lt = last xs

    arrOf l v
      = take l $ repeat v

solve :: [Int] -> (Int,[Int])
solve xs
  = ( ans, concat arr' )
  where
    ans = ( maximum (map length arr) - 1 ) `div` 2
    arr  = splitAll xs
    arr' = map change arr

output :: (Int,[Int]) -> String
output (x, xs) = show x ++ "\n" ++ ( concat $ map (++ " ") (map show xs) )

main = ( output . solve . map ( read :: String -> Int ) . words . last . lines) <$> getContents >>= putStrLn

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

splitAll :: [Int] -> [[Int]]

splitAll []
  = [[]]
splitAll [x]
  = [[x]]
splitAll [x,y]
  | x == y = [[x],[y]]
  | x /= y = [[x,y]]
splitAll (x:y:xs)
  | x == y && null rest = [x] : [[y]]
  | x == y              = [x] : (y : h) : t
  | otherwise           = (x : h') : t'
  where
    rest  = splitAll xs
    (h:t) = rest

    rest'   = splitAll (y:xs)
    (h':t') = rest'

change :: [Int] -> [Int]
change xs
  | n < 3  = xs
  | odd  n = arrOf (n-1) ft ++ [lt]
  | even n = arrOf hn ft ++ arrOf hn lt
  where
    n  = length xs
    hn = n `div` 2
    ft = head xs
    lt = last xs

    arrOf l v
      = take l $ repeat v

solve :: [Int] -> (Int,[Int])
solve xs
  = ( ans, concat arr' )
  where
    ans = ( maximum (map length arr) - 1 ) `div` 2
    arr  = splitAll xs
    arr' = map change arr

output :: (Int,[Int]) -> String
output (x, xs) = show x ++ "\n" ++ ( concat $ map (++ " ") (map show xs) )

main = ( output . solve . map ( read :: String -> Int ) . words . last . lines) <$> getContents >>= putStrLn


Cat Furrier Transform is a popular algorithm among cat programmers to create longcats. As one of the greatest cat programmers ever exist, Neko wants to utilize this algorithm to create the perfect longcat.Assume that we have a cat with a number $$$x$$$. A perfect longcat is a cat with a number equal $$$2^m - 1$$$ for some non-negative integer $$$m$$$. For example, the numbers $$$0$$$, $$$1$$$, $$$3$$$, $$$7$$$, $$$15$$$ and so on are suitable for the perfect longcats.In the Cat Furrier Transform, the following operations can be performed on $$$x$$$:  (Operation A): you select any non-negative integer $$$n$$$ and replace $$$x$$$ with $$$x \oplus (2^n - 1)$$$, with $$$\oplus$$$ being a bitwise XOR operator. (Operation B): replace $$$x$$$ with $$$x + 1$$$. The first applied operation must be of type A, the second of type B, the third of type A again, and so on. Formally, if we number operations from one in the order they are executed, then odd-numbered operations must be of type A and the even-numbered operations must be of type B.Neko wants to produce perfect longcats at industrial scale, thus for each cat Neko only wants to perform at most $$$40$$$ operations. Can you help Neko writing a transformation plan?Note that it is not required to minimize the number of operations. You just need to use no more than $$$40$$$ operations.

The only line contains a single integer $$$x$$$ ($$$1 \le x \le 10^6$$$).

The first line should contain a single integer $$$t$$$ ($$$0 \le t \le 40$$$) — the number of operations to apply. Then for each odd-numbered operation print the corresponding number $$$n_i$$$ in it. That is, print $$$\lceil \frac{t}{2} \rceil$$$ integers $$$n_i$$$ ($$$0 \le n_i \le 30$$$), denoting the replacement $$$x$$$ with $$$x \oplus (2^{n_i} - 1)$$$ in the corresponding step. If there are multiple possible answers, you can print any of them. It is possible to show, that there is at least one answer in the constraints of this problem.

NoteIn the first test, one of the transforms might be as follows: $$$39 \to 56 \to 57 \to 62 \to 63$$$. Or more precisely: Pick $$$n = 5$$$. $$$x$$$ is transformed into $$$39 \oplus 31$$$, or $$$56$$$.  Increase $$$x$$$ by $$$1$$$, changing its value to $$$57$$$.  Pick $$$n = 3$$$. $$$x$$$ is transformed into $$$57 \oplus 7$$$, or $$$62$$$.  Increase $$$x$$$ by $$$1$$$, changing its value to $$$63 = 2^6 - 1$$$. In the second and third test, the number already satisfies the goal requirement.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

import Data.Bits

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	x <- readInt
	let
		res = solve 0 x
	print $ length res
	putStrLn $ unwords $ map ( show . fst ) $ filter snd $ zip res $ cycle [ True, False ]

solve _ 0 = [ 0 ]
solve _ 1 = []
solve 1 x
	| x `elem` take 30 [ 2 ^ x - 1 | x <- [ 1 .. ] ] = []
	| otherwise = 0 : solve 0 ( x + 1 )
solve 0 x
	| x `elem` take 30 [ 2 ^ x - 1 | x <- [ 1 .. ] ] = []
	| otherwise = lg x : solve 1 ( x `xor` ( 2 ^ lg x - 1 ) )
	where
		lg 0 = 0
		lg x = 1 + lg ( x `div` 2 )

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

import Data.Bits

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	x <- readInt
	let
		res = solve 0 x
	print $ length res
	putStrLn $ unwords $ map show res

solve _ 0 = []
solve _ 1 = []
solve 1 x = solve 0 $ x + 1
solve 0 x = lg x : solve 1 ( x `xor` ( 2 ^ lg x - 1 ) )
	where
		lg 0 = 0
		lg x = 1 + lg ( x `div` 2 )

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

import Data.Bits

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	x <- readInt
	let
		res = solve x
	print $ length res
	putStrLn $ unwords $ map show res

solve 0 = []
solve 1 = []
solve x = lg x : solve ( x `xor` ( 2 ^ lg x - 1 ) + 1 )
	where
		lg 0 = 0
		lg x = 1 + lg ( x `div` 2 )


Polycarp is writing the prototype of a graphic editor. He has already made up his mind that the basic image transformations in his editor will be: rotate the image 90 degrees clockwise, flip the image horizontally (symmetry relative to the vertical line, that is, the right part of the image moves to the left, and vice versa) and zooming on the image. He is sure that that there is a large number of transformations that can be expressed through these three.He has recently stopped implementing all three transformations for monochrome images. To test this feature, he asked you to write a code that will consecutively perform three actions with a monochrome image: first it will rotate the image 90 degrees clockwise, then it will flip the image horizontally and finally, it will zoom in twice on the image (that is, it will double all the linear sizes).Implement this feature to help Polycarp test his editor.

The first line contains two integers, w and h (1 ≤ w, h ≤ 100) — the width and height of an image in pixels. The picture is given in h lines, each line contains w characters — each character encodes the color of the corresponding pixel of the image. The line consists only of characters "." and "*", as the image is monochrome.

Print 2w lines, each containing 2h characters — the result of consecutive implementing of the three transformations, described above.

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

main :: IO ()
main = do
  (_:h:_) <- map read . words <$> getLine
  s <- replicateM h $ getLine
  forM_ (transpose s) $
    replicateM_ 2 . putStrLn . double
  where
  double [] = []
  double (h:t) = h:h:double t

import Data.List
main = interact $ unlines . s . map s . t . tail . lines
s = foldr (\x acc-> x:x:acc) []
t = transpose

import Control.Applicative ((<$>))

main = do
	[w, h] <- map read . words <$> getLine
	a <- lines <$> getContents

	let b = [[a !! (y `div` 2) !! (x `div` 2) | y <- [0..2*h-1]] | x <- [0..2*w-1]]

	putStrLn $ unlines $ b

import Control.Applicative ((<$>))
import Data.List (transpose)

main = do
	-- [w, h] <- map read . words <$> getLine
	getLine
	a <- lines <$> getContents

	-- let b = [[a !! (y `div` 2) !! (x `div` 2) | y <- [0..2*h-1]] | x <- [0..2*w-1]]
	--

	let dup = concatMap (replicate 2)

	let b = dup . (map dup) $ transpose a

	putStrLn $ unlines $ b

module Main where
import Data.List
import Text.Read (read)
import System.IO

readArray:: Int->[String]->IO [String]
readArray 0 res = return res
readArray n res = do
                          s <-getLine
                          readArray (n-1) (res ++[s])

duplicate:: String->String
duplicate [] = []
duplicate (x:xs) = x:x:duplicate xs

duplicateV::[String]->[String]
duplicateV [] = []
duplicateV (cs:css) = cs:cs:duplicateV css

main = do
           mes <- getLine
           let w = read  (last . words $ mes)::Int
           --let h = read . last . words mes
           pic <- readArray w []
           putStrLn . (intercalate "\n") . duplicateV . (map  duplicate) . transpose $ pic

import Data.List
main = interact $ unlines . t . s . t . s . map r . t . r . tail . lines
s = concat . map (\x -> [x,x])
t = transpose
r = reverse

module Main where
import Data.List
import Text.Read (read)
import System.IO

readArray:: Int->[String]->IO [String]
readArray 0 res = return res
readArray n res = do
                          s <-getLine
                          readArray (n-1) (res ++[s])

duplicate:: String->String
duplicate [] = []
duplicate (x:xs) = x:x:duplicate xs
main = do
           mes <- getLine
           let w = read  (last . words $ mes)::Int
           --let h = read . last . words mes
           pic <- readArray w []
           putStrLn . (intercalate "\n") . (map  duplicate) . transpose $ pic


Let's denote a function You are given an array a consisting of n integers. You have to calculate the sum of d(ai, aj) over all pairs (i, j) such that 1 ≤ i ≤ j ≤ n.

The first line contains one integer n (1 ≤ n ≤ 200000) — the number of elements in a. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109) — elements of the array.

Print one integer — the sum of d(ai, aj) over all pairs (i, j) such that 1 ≤ i ≤ j ≤ n.

NoteIn the first example:  d(a1, a2) = 0;  d(a1, a3) = 2;  d(a1, a4) = 0;  d(a1, a5) = 2;  d(a2, a3) = 0;  d(a2, a4) = 0;  d(a2, a5) = 0;  d(a3, a4) =  - 2;  d(a3, a5) = 0;  d(a4, a5) = 2.

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.IntMap as M

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = sum $ zipWith3 (\p n x -> fromIntegral (p - n :: Int) * fromIntegral x) ps ns xs :: Integer
  where
  look = (maybe 0 id .) . M.lookup
  ps = snd $ mapAccumL (\m (l, x) -> (M.insertWith (+) x 1 m, l - look x m - look (x + 1) m - look (x - 1) m)) M.empty $ zip [0..] xs
  ns = snd $ mapAccumR (\(m, l) x -> ((M.insertWith (+) x 1 m, l + 1), l - look x m - look (x + 1) m - look (x - 1) m)) (M.empty, 0) xs

import Control.Arrow
import Control.Applicative
import qualified Data.Map as M

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

solve :: [Integer] -> Integer
solve =
    sum
    . (
        zipWith3
        (\i v (s, m) -> v * i - s + sum [i * M.findWithDefault 0 (v + i) m | i <- [1, -1]])
        [0 ..]
        <*> scanl (flip $ \x -> (x +) *** (M.insertWith (+) x 1)) (0, M.empty)
    )

import qualified Data.Map as M
import Control.Monad
import Data.List --(foldl')

--calc :: Integer -> [Integer] -> Integer
calc n dat = ans
    where
      (idx, m, ans) = foldl' (\(i, mm, aa) t ->
            (i+1, M.insertWith (+) t 1 mm,
             aa + t * (i - n + 1 + i) - M.findWithDefault 0 (t-1) mm + M.findWithDefault 0 (t+1) mm
            ))
            (fromIntegral 0, M.empty, fromIntegral 0) dat

main :: IO ()
main = do
  n:dat <- fmap (map read . words) getContents :: IO [Integer]
  print $ calc n dat

import Data.List
import qualified Data.IntMap as Map

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [_,ops'] = sol ops
  where
    ops = fn $ words ops'
    fn :: [String] -> [Integer]
    fn xs = map read xs

d x y
  | abs (x-y) <= 1 = 0
  | otherwise      = y - x

type MM = Map.IntMap Int

sol as = [ show $ sol' m 0 0 as ]
  where
    m = Map.empty :: MM

sol' _ _ _ [] = 0
sol' m ss n (y:xs) = res + sol' (m `inc` y) (ss+y) (n+1) xs
  where
    (x,z)   = (y-1, y+1)
    (a,b,c) = (m`look`x, m`look`y, m`look`z)
    res = (n-a-b-c)*y - (ss - (x*a + y*b + z*c))

look :: MM -> Integer -> Integer
look m k = toInteger $ case Map.lookup (fromInteger k) m of
             Just v  -> v
             Nothing -> 0

inc :: MM -> Integer -> MM
inc m k = let
            ik = fromInteger k
            old = case Map.lookup ik m of
                    Just v  -> v
                    Nothing -> 0
  in Map.insert ik (old+1) m

import qualified Data.Map as M
import Control.Monad
import Data.List --(foldl')

--calc :: Integer -> [Integer] -> Integer
calc n dat = ans
    where
      (idx, m, ans) = foldl' (\(i, mm, aa) t ->
            (i+1, M.insertWith (+) t 1 mm,
             aa + t * (i - n + 1 + i) - M.findWithDefault 0 (t-1) m + M.findWithDefault 0 (t+1) m
            ))
            (fromIntegral 0, M.empty, fromIntegral 0) dat

main :: IO ()
main = do
  n:dat <- fmap (map read . words) getContents :: IO [Integer]
  print $ calc n dat


There is a string $$$s$$$ of length $$$3$$$, consisting of uppercase and lowercase English letters. Check if it is equal to "YES" (without quotes), where each letter can be in any case. For example, "yES", "Yes", "yes" are all allowable.

The first line of the input contains an integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of testcases. The description of each test consists of one line containing one string $$$s$$$ consisting of three characters. Each character of $$$s$$$ is either an uppercase or lowercase English letter.

For each test case, output "YES" (without quotes) if $$$s$$$ satisfies the condition, and "NO" (without quotes) otherwise. You can output "YES" and "NO" in any case (for example, strings "yES", "yes" and "Yes" will be recognized as a positive response).

10

YES

yES

yes

Yes

YeS

Noo

orZ

yEz

Yas

XES

NoteThe first five test cases contain the strings "YES", "yES", "yes", "Yes", "YeS". All of these are equal to "YES", where each character is either uppercase or lowercase.

module Main (main) where
import Numeric (showFFloat)
import Data.Char (toUpper)
-- reset && stack build && echo "success" && stack exec haskell-codeforces-exe && echo finished
--  gen-hie > hie.yaml

strToInt a = read a :: Int
strToFloat a = read a :: Float

pshow x = putStr (show x)
pfshow x = putStr (showFFloat (Just 2) x "")

solve:: String -> String
solve str = do
  let x = map toUpper str
  if x == "YES" then "YES"
   else "NO"

fnMain :: String -> String
fnMain input = do
    let inputLines = lines input

    let n = strToInt $ head $ inputLines
    unlines $ map solve $ take n $ drop 1 $ inputLines

main :: IO ()
main = do
    interact fnMain

import Control.Arrow ((>>>))
import Data.Char (toLower)

main = interact $ lines >>> drop 1 >>> map processTest >>> unlines

processTest = map toLower >>> (== "yes") >>> (\ isYes -> if isYes then "YES" else "NO")

import Data.List
import Data.Text(toLower,pack,unpack)

testcase 0 = return ()
testcase t = do
    s <- getLine
    putStrLn (if (unpack $ toLower $ pack $ s) == "yes"
        then "YES" else "NO")
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.State
import qualified Data.ByteString.Char8 as C
import Data.Maybe

--
import Data.Bool
import Data.Char

solve :: C.ByteString -> Bool
solve = (== "yes") . C.map toLower

input = bstr

output :: Bool -> C.ByteString
output = bool "NO" "YES"

main :: IO ()
main = C.interact $ C.unlines . map (output . solve) . runScanner (numberOf input)

-- Scanner

type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith sp sc = evalState sc . sp

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> pure s

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&))

-- road map in reverse, and the number of cities, init pen state
type Domain = String
type CoDomain = String
type Solver  = Domain -> CoDomain

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

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

parse :: IO Domain
parse = do
  line <- getLine
  return line

solve :: Solver
solve =  (\x -> if x then "YES" else "NO") . (=="yes") . fmap toLower

main :: IO ()
main = do
  [n] <- readChar8
  replicateM n $ printAns =<< solve <$> parse
  return ()

import Control.Monad
import Data.Char

testCaseMain :: Int -> IO ()
testCaseMain _ = do s <- getLine
                    putStrLn (if map toLower s == "yes" then "YES" else "NO")

main :: IO ()
main = do n <- (readLn :: IO Int)
          forM_ [1 .. n] testCaseMain

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM)
import Data.Array ((!))
import Data.Array.ST (MArray (newArray), readArray, runSTArray, writeArray)
import qualified Data.ByteString.Char8 as C
import Data.Char (toLower)
import Data.Maybe (fromJust)

data TC = TC {s :: String}

solve TC {..} = case fmap toLower s == "yes" of
  True -> "YES"
  otherwise -> "NO"

main = C.interact $ runScanner scan >>> map solve >>> map (C.pack) >>> C.unlines

scan = numberOf $ TC <$> C.unpack <$> str

type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

str :: Scanner C.ByteString
str = get >>= \case s : ss -> put ss >> return s

int :: Scanner Int
int = fst . fromJust . C.readInt <$> str

integer :: Scanner Integer
integer = read . C.unpack <$> str

double :: Scanner Double
double = read . C.unpack <$> str

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t then return [] else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

import           Data.List
import qualified Data.Char as DC

isyes :: String -> Bool
isyes s = (map DC.toLower s == "yes")

solveCase :: IO ()
solveCase = do
    s <- getLine
    putStrLn $ if isyes s then "YES" else "NO"

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)


An African crossword is a rectangular table n × m in size. Each cell of the table contains exactly one letter. This table (it is also referred to as grid) contains some encrypted word that needs to be decoded.To solve the crossword you should cross out all repeated letters in rows and columns. In other words, a letter should only be crossed out if and only if the corresponding column or row contains at least one more letter that is exactly the same. Besides, all such letters are crossed out simultaneously.When all repeated letters have been crossed out, we should write the remaining letters in a string. The letters that occupy a higher position follow before the letters that occupy a lower position. If the letters are located in one row, then the letter to the left goes first. The resulting word is the answer to the problem.You are suggested to solve an African crossword and print the word encrypted there.

The first line contains two integers n and m (1 ≤ n, m ≤ 100). Next n lines contain m lowercase Latin letters each. That is the crossword grid.

Print the encrypted word on a single line. It is guaranteed that the answer consists of at least one letter.

module Main where

import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array.Unboxed
import Data.Array.ST

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

rowCrossMask :: [Char] -> [Bool]
rowCrossMask row =
    let mask = runSTUArray $ do
            mask <- newArray ('a','z') 0 :: ST s (STUArray s Char Int)
            forM row $ \ch -> modifyArray mask ch (+1)
            return mask
    in map (\ch -> if mask ! ch == 1 then True else False) row

main = do
    [h, w] <- ( map read . words ) `liftM` getLine
    board <- replicateM h getLine

    let rowCross = join $ map rowCrossMask board
        colCross = join $ transpose $ map rowCrossMask $ transpose board
        allCross = map snd $ filter fst $ zip (zipWith (&&) rowCross colCross) (join board)

    --putStrLn $ show rowCross
    --putStrLn $ show colCross
    putStrLn allCross

import Array

type Africa = Array (Int, Int) (Either Char Char)

bigTest :: [String]
bigTest = take 100 (repeat (take 100 (cycle "a")))

genAfrica :: (Int, Int) -> [String] -> Africa
genAfrica (n, m) lines = array ((1, 1), (n, m)) [((i, j), Right (lines !! (i-1) !! (j-1))) | i <- [1..n], j <- [1..m]]

getEither :: Either a a -> a
getEither (Left  a) = a
getEither (Right a) = a

getJust :: Maybe a -> a
getJust (Just a)  =  a
getJust Nothing   =  error "Nothing!"

findEqLeft :: (Int, Int) -> (Int, Int) -> Africa -> Maybe (Int, Int)
findEqLeft size (x, y) africa = findEqLeft' size (x, y) (x, y + 1) africa
  where
    findEqLeft' :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Africa -> Maybe (Int, Int)
    findEqLeft' (n, m) (x, y) (i, j) africa
      | j > m  =  Nothing
      | getEither (africa ! (x, y)) == getEither (africa ! (i, j))  =  Just (i, j)
      | otherwise  =  findEqLeft' (n, m) (x, y) (i, j + 1) africa

findEqDown :: (Int, Int) -> (Int, Int) -> Africa -> Maybe (Int, Int)
findEqDown size (x, y) africa = findEqDown' size (x, y) (x + 1, y) africa
  where
    findEqDown' :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Africa -> Maybe (Int, Int)
    findEqDown' (n, m) (x, y) (i, j) africa
      | i > n  =  Nothing
      | getEither (africa ! (x, y)) == getEither (africa ! (i, j))  =  Just (i, j)
      | otherwise  =  findEqDown' (n, m) (x, y) (i + 1, j) africa

filterAfrica :: (Int, Int) -> Africa -> Africa
filterAfrica (n, m) africa = foldl (\africa (x, y) -> filterAfrica' (n, m) (x, y) africa) africa [(i, j) | i <- [1..n], j <- [1..m]]
  where
    filterAfrica' :: (Int, Int) -> (Int, Int) -> Africa -> Africa
    filterAfrica' size cell africa
      | nextLeft == Nothing && nextDown == Nothing  =  africa
      | nextLeft /= Nothing && nextDown == Nothing  =  africa // [(cell, Left symbol), (getJust nextLeft, Left symbol)]
      | nextLeft == Nothing && nextDown /= Nothing  =  africa // [(cell, Left symbol), (getJust nextDown, Left symbol)]
      | nextLeft /= Nothing && nextDown /= Nothing  =  africa // [(cell, Left symbol), (getJust nextLeft, Left symbol), (getJust nextDown, Left symbol)]
      where
        nextLeft  =  findEqLeft size cell africa
        nextDown  =  findEqDown size cell africa
        symbol    =  getEither (africa ! cell)

getSymbols :: (Either Char Char) -> String
getSymbols (Left  _) = []
getSymbols (Right c) = [c]

printAfrica :: (Int, Int) -> Africa -> String
printAfrica (n, m) africa = concatMap (\cell -> getSymbols (africa ! cell))  [(i, j) | i <- [1..n], j <- [1..m]]

main = do
  line <- getLine
  let [n, m] = map read $ words line
  let size = (n, m)
  lines <- sequence (map (\x -> getLine) [1..n])
  putStrLn $ printAfrica size $ filterAfrica size $ genAfrica size lines

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

import Control.Applicative
import Control.Monad
import Data.Array.IO

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  buf   <- newArray  ((1, 1, 'a'), (n, m, 'z')) 0 :: IO (IOUArray (Int, Int, Char) Int)
  table <- newArray_ ((1, 1), (n, m))             :: IO (IOUArray (Int, Int) Char)
  forM_ [1 .. n] $ \y -> do
    s <- take m <$> getLine
    forM_ (zip [1 ..] s) $ \(x, c) -> do
      writeArray table (y, x) c
      forM_ [1 .. n] $ \y' -> do
        v <- readArray buf (y', x, c)
        writeArray buf (y', x, c) $ v + 1
      forM_ [1 .. m] $ \x' -> do
        v <- readArray buf (y, x', c)
        when (x' /= x) $
          writeArray buf (y, x', c) $ v + 1
  forM_ [1 .. n] $ \y ->
    forM_ [1 .. m] $ \x -> do
      c <- readArray table (y, x)
      v <- readArray buf (y, x, c)
      when (v == 1) $ putChar c
  putStrLn ""

import Data.List
import Data.Function (on)
f s = map head $ filter ((>1).length) $ group $ sort s
main = do
    [n, m] <- (map read . words) `fmap` getLine
    l <- concat `fmap` mapM (\i -> do
        l' <- getLine
        return $ map (\(c, j) -> (c, (i, j))) $ zip l' [1..]) [1..n]
    let l' = groupBy ((==) `on` fst) $ sort l
    let l2 = sortBy (\(c1, ab1) (c2, ab2) -> ab1 `compare` ab2) $ concatMap (\l -> let
            fl = f $ map (fst.snd) l
            sl = f $ map (snd.snd) l in
            filter (\(c, (a, b)) -> (a `notElem` fl) && (b `notElem` sl)) l) l'
    putStrLn $ map fst l2

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Char

main = do
   [n,m] <- map read . words <$> getLine
   cw <- listArray ((1,1),(n,m)) . filter isAlpha . concat <$> replicateM n getLine
   let wr = listArray ((1,1),(n,m)) [ not $ (or [ cw!(n',c) == cw!(r,c) | n' <- [1..n], n' /= r]) || (or [cw!(r,n') == cw!(r,c) | n' <- [1..m], n' /= c ])
                                             | r <- [1..n], c <- [1..m]]
   putStrLn $ map fst $ filter snd $ zip (elems cw) (elems wr)


Let's call a number k-good if it contains all digits not exceeding k (0, ..., k). You've got a number k and an array a containing n numbers. Find out how many k-good numbers are in a (count each number every time it occurs in array a).

The first line contains integers n and k (1 ≤ n ≤ 100, 0 ≤ k ≤ 9). The i-th of the following n lines contains integer ai without leading zeroes (1 ≤ ai ≤ 109).

Print a single integer — the number of k-good numbers in a.

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- replicateM n getLine

	let
		solve s = all ( ( `elem` s ) . intToDigit ) [ 0 .. k ]

	print . length . filter solve $ as

import Control.Applicative
main :: IO ()
main = do
    firstLine <- map read <$> words <$> getLine
    length <$> filter (isGood (firstLine !! 1)) <$> map (read :: String -> Int) <$> lines <$> getContents >>= print

isGood :: Int -> Int -> Bool
isGood k n
    | k == -1 = True
    | otherwise = k `elem` (map (read . (:[])) $ show n) && isGood (k-1) n

{-# 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
  [n, k] <- getInts

  ss <- replicateM n getLine

  let
    f s = (take (k+1) $ sort $ nub s) == ['0'..chr (48+k)]

  print $ length $ filter f ss

import Control.Monad (liftM, replicateM)
import Data.Char (ord, intToDigit)

solve :: Int -> [Int] -> Int
solve k as  =  length $ filter itsK as
  where
    itsK a  =  all (flip elem (show a)) ['0' .. intToDigit k]

main :: IO ()
main  =  do
    [n, k]  <-  reads
    as  <-  replicateM n readLn
    print $ solve k as

  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import Control.Applicative ((<$>), (<*>))
import Data.Char (digitToInt)

main :: IO ()
main = print =<< solve <$> (read . (!!1) . words <$> getLine) <*> (lines <$> getContents)

solve :: Int -> [String] -> Int
solve k xs = length [ x | x <- xs, all (`elem`map digitToInt x) [0..k] ]

import Control.Applicative ((<$>), (<*>))
import Data.Char (intToDigit)

main :: IO ()
main = print =<< solve <$> (read . (!!1) . words <$> getLine) <*> (lines <$> getContents)

solve :: Int -> [String] -> Int
solve k xs = length [ x | x <- xs, all (`elem`x) ['0'..intToDigit k] ]

module Main where

import Control.Monad
import Data.List

str2int = read :: String -> Int

uniq [] = []
uniq [x] = [x]
uniq (x:y:xs) = if x == y then uniq (y:xs) else x : uniq (y:xs)

how_many p = foldl (\n x -> if p x then n + 1 else n) 0

digits b n
    | n < b = [n]
    | otherwise = mod n b : digits b (div n b)

good k n = [0 .. k] == filter (<= k) (uniq . sort $ digits 10 n)

solve (n:k:_) = replicateM n getLine >>= \lines ->
    let numbers = map str2int lines
    in  return $ how_many (good k) numbers

main = getLine >>= \line ->
    solve (map str2int (words line)) >>= print

module Main where

import Control.Monad
import Data.List

str2int = read :: String -> Int

uniq [] = []
uniq [x] = [x]
uniq (x:y:xs) = if x == y then uniq (y:xs) else x : uniq (y:xs)

how_many p = foldl (\n x -> if p x then n + 1 else n) 0

digits b n
    | n < b = [n]
    | otherwise = mod n b : digits b (div n b)

good k n = [0 .. k] == filter (<= k) (uniq . sort $ digits 10 n)

solve (n:k:_) = do
    lines <- replicateM n getLine
    let numbers = map str2int lines
        in  return $ how_many (good k) numbers

main = do
    line <- getLine
    ans <- solve $ map str2int $ words line
    print ans

import Data.List
import Control.Monad

digs :: Integral a => a -> [a]
digs 0 = []
digs x = x `mod` 10 : digs (x `div` 10)

sol :: Integer -> [Integer] -> Integer
sol k xx = toInteger $ length $ filter (==True) (map (\v -> all (\i -> elem i (digs v)) [0..k]) xx)

main = do
  i <- getLine
  let [n, k] = map (\x -> read x :: Int) $ words i
  inputs <- replicateM n getLine
  let nums = map (\s -> read s :: Integer) inputs
  print $ sol (toInteger k) nums

import Control.Applicative ((<$>), (<*>))
import Data.Char (digitToInt)

main :: IO ()
main = print =<< solve <$> (read . (!!1) . words <$> getLine) <*> (lines <$> getContents)

solve :: Int -> [String] -> Int
solve k xs = length [ x | x <- xs, all (<=k) $ map digitToInt x ]

module Main where

import Control.Monad
import Data.List

str2int = read :: String -> Int

uniq [] = []
uniq [x] = [x]
uniq (x:y:xs) = if x == y then uniq (y:xs) else x : uniq (y:xs)

how_many p = foldl (\n x -> if p x then n + 1 else n) 0

digits b n
    | n < b = [n]
    | otherwise = mod n b : digits b (div n b)

good k n = [0 .. k] == (uniq . sort $ digits 10 n)

solve (n:k:_) = do
    lines <- replicateM n getLine
    let numbers = map str2int lines
        in  return $ how_many (good k) numbers

main = do
    line <- getLine
    ans <- solve $ map str2int $ words line
    print ans

import Data.List
import Control.Monad

main = do
  i <- getLine
  let [sn, sk] = words i
  let n = read sn :: Int
  let k = head sk
  inputs <- replicateM n getLine
  print $ length $ filter (\num -> foldl1 (&&) (map (\c -> c <= k) num)) inputs

import Data.List
import Control.Monad

digs :: Integral a => a -> [a]
digs 0 = []
digs x = x `mod` 10 : digs (x `div` 10)

sol :: Integer -> [Integer] -> Integer
sol k xx = toInteger $ length $ filter (\x -> (sort (nub (digs x))) == [0..k]) xx

main = do
  i <- getLine
  let [n, k] = map (\x -> read x :: Int) $ words i
  inputs <- replicateM n getLine
  let nums = map (\s -> read s :: Integer) inputs
  print $ sol (toInteger k) nums


You are given a non-empty string s consisting of lowercase English letters. You have to pick exactly one non-empty substring of s and shift all its letters 'z'  'y'  'x'  'b'  'a'  'z'. In other words, each character is replaced with the previous character of English alphabet and 'a' is replaced with 'z'.What is the lexicographically minimum string that can be obtained from s by performing this shift exactly once?

The only line of the input contains the string s (1 ≤ |s| ≤ 100 000) consisting of lowercase English letters.

Print the lexicographically minimum string that can be obtained from s by shifting letters of exactly one non-empty substring.

NoteString s is lexicographically smaller than some other string t of the same length if there exists some 1 ≤ i ≤ |s|, such that s1 = t1, s2 = t2, ..., si - 1 = ti - 1, and si < ti.

main :: IO()

main = do
	phrase <- getLine
	print (PlainString (minshift phrase))

newtype PlainString = PlainString String
instance Show PlainString where
  show (PlainString s) = s

swapSub :: [Char] -> [Char]
swapSub "" = "" -- correct
swapSub (l1:str)
	| l1 > 'a' = (pred l1) : (swapSub str)
	| otherwise = l1:str

minshift :: [Char] -> [Char]
minshift "" = "" -- correct
minshift ('a':[]) = "z" -- correct
minshift (l1:str)
	| l1 > 'a' = swapSub (l1:str)
	| otherwise = l1 : (minshift str)

import Data.Array

main = do
    let a = listArray ('a','z') $ 'z':['a'..'y']
        solve s = map (a!) b ++ c
            where (b,c) = span (/='a') s
    b <- getLine
    if head b /= 'a'
        then putStrLn $ solve b
        else do
            let (pre,suf) = span (=='a') b
            if suf == "" then putStrLn (init pre ++ "z") else putStrLn $ pre ++ (solve suf)

main = interact $ solve False . head . words
solve _ [] = []
solve True f@('a':t) = f
solve True (l:t) = (pred l) : (solve True t)
solve False ('a':[]) = "z"
solve False ('a':t) = 'a' : (solve False t)
solve False (l:t) = (pred l) : (solve True t)

import Data.Char

main = interact $ h.head.lines
f = map g
g x
  | x == 'a' = 'z'
  | otherwise = chr ((ord x) - 1)

h x
  | x == (take (length x) ['a', 'a'..]) = (take ((length x)-1) ['a', 'a' ..] ++ "z")
  |otherwise = (takeWhile (=='a') x) ++ (f (takeWhile (/='a') (dropWhile (=='a') x))) ++ (dropWhile (/='a') (dropWhile (=='a') x))

import Data.Char

f :: Bool -> String -> String
f _ [] = []
f False ['a'] = ['z']
f True  ['a'] = ['a']
f _ (x:[]) = [chr((ord x) - 1)]
f True ('a':xs) = ('a':xs)
f False ('a':xs) = ('a':(f False xs))
f _ (x:xs) = [chr((ord x) - 1)] ++ f True xs

main = do
	s <- getLine
	putStrLn (f False s)

import Data.Char

prev c = chr ((ord c) - 1)

solve True ""          = ""
solve False "a"        = "z"
solve True ('a':cs)    = 'a' : cs
solve True (c:cs)      = prev c : solve True cs
solve False ('a':cs)   = 'a' : solve False cs
solve False (c:cs)     = prev c : solve True cs

main = getLine >>= putStrLn . solve False

import Data.Char

ant :: Char -> Char
ant = chr . pred . ord

letter :: Char -> Bool
letter c = ord c >= ord 'a' && ord c <= ord 'z'

process :: Bool -> String -> String
process _ []             = []
process False "a"        = "z"
process False ('a':rest) = 'a'     : process False rest
process False (c:rest)   = (ant c) : process True rest
process True ('a':rest)  = 'a'     : rest
process True (c:rest)    = (ant c) : process True rest

main :: IO ()
main = interact (process False . filter letter)

main :: IO()

main = do
	phrase <- getLine
	print (minshift phrase)

swapSub :: [Char] -> [Char]
swapSub "" = "" -- correct
swapSub (l1:str)
	| l1 > 'a' = (pred l1) : (swapSub str)
	| otherwise = l1:str

minshift :: [Char] -> [Char]
minshift "" = "" -- correct
minshift ('a':[]) = "z" -- correct
minshift (l1:str)
	| l1 > 'a' = swapSub (l1:str)
	| otherwise = l1 : (minshift str)

import Data.Array

main = do
    let a = listArray ('a','z') $ 'z':['a'..'y']
        solve s = map (a!) b ++ c
            where (b,c) = span (/='a') s
    b <- getLine
    if head b /= 'a'
        then putStrLn $ solve b
        else do
            let (pre,suf) = span (=='a') b
            putStrLn $ pre ++ (solve suf)

import Data.Array

main = do
	let a = listArray ('a','z') $ 'z':['a'..'y']
	(b,c) <- fmap (span (/='a')) getLine
	putStrLn $ map (a!) b ++ c

main = interact $ solve False
solve _ [] = []
solve True f@('a':t) = f
solve True (l:t) = (pred l) : (solve True t)
solve False ('a':[]) = "z"
solve False ('a':t) = 'a' : (solve False t)
solve False (l:t) = (pred l) : (solve True t)

main = interact $ solve False
solve _ [] = []
solve True f@('a':t) = f
solve True (l:t) = (pred l) : (solve True t)
solve False ('a':t) = 'a' : (solve False t)
solve False (l:t) = (pred l) : (solve True t)

main = interact $ solve False
solve _ [] = []
solve False "a" = "z"
solve True f@('a':t) = f
solve True (l:t) = (pred l) : (solve True t)
solve False ('a':t) = 'a' : (solve False t)
solve False (l:t) = (pred l) : (solve True t)

import Data.Char

main = interact $ h.head.lines
f = map g
g x
  | x == 'a' = 'z'
  | otherwise = chr ((ord x) - 1)

h x = (takeWhile (=='a') x) ++ (f (takeWhile (/='a') (dropWhile (=='a') x))) ++ (dropWhile (/='a') (dropWhile (=='a') x))

import Data.Char

f :: Bool -> String -> String
f _ [] = []
f False ['a'] = ['z']
f True  ['a'] = ['a']
f _ (x:[]) = [chr((ord x) - 1)]
f b ('a':xs) = ['a'] ++ f b xs
f _ (x:xs) = [chr((ord x) - 1)] ++ f True xs

main = do
	s <- getLine
	putStrLn (f False s)

import Data.Char

ant :: Char -> Char
ant = chr . pred . ord

process :: Bool -> String -> String
process _ []             = []
process False "a"        = "z"
process False ('a':rest) = 'a'     : process False rest
process False (c:rest)   = (ant c) : process True rest
process True ('a':rest)  = 'a'     : rest
process True (c:rest)    = (ant c) : process True rest

main :: IO ()
main = interact (process False)

import Data.Char

ant :: Char -> Char
ant = chr . pred . ord

process :: Bool -> String -> String
process _ []             = []
process False ('a':rest) = 'a'     : process False rest
process False (c:rest)   = (ant c) : process True rest
process True ('a':rest)  = 'a'     : rest
process True (c:rest)    = (ant c) : process True rest

main :: IO ()
main = interact (process False)


You are given an array $$$a_1, a_2, \dots, a_n$$$, consisting of $$$n$$$ positive integers. Initially you are standing at index $$$1$$$ and have a score equal to $$$a_1$$$. You can perform two kinds of moves:   move right — go from your current index $$$x$$$ to $$$x+1$$$ and add $$$a_{x+1}$$$ to your score. This move can only be performed if $$$x<n$$$.  move left — go from your current index $$$x$$$ to $$$x-1$$$ and add $$$a_{x-1}$$$ to your score. This move can only be performed if $$$x>1$$$. Also, you can't perform two or more moves to the left in a row. You want to perform exactly $$$k$$$ moves. Also, there should be no more than $$$z$$$ moves to the left among them.What is the maximum score you can achieve?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. The first line of each testcase contains three integers $$$n, k$$$ and $$$z$$$ ($$$2 \le n \le 10^5$$$, $$$1 \le k \le n - 1$$$, $$$0 \le z \le min(5, k)$$$) — the number of elements in the array, the total number of moves you should perform and the maximum number of moves to the left you can perform. The second line of each testcase contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^4$$$) — the given array. The sum of $$$n$$$ over all testcases does not exceed $$$3 \cdot 10^5$$$.

Print $$$t$$$ integers — for each testcase output the maximum score you can achieve if you make exactly $$$k$$$ moves in total, no more than $$$z$$$ of them are to the left and there are no two or more moves to the left in a row.

NoteIn the first testcase you are not allowed to move left at all. So you make four moves to the right and obtain the score $$$a_1 + a_2 + a_3 + a_4 + a_5$$$.In the second example you can move one time to the left. So we can follow these moves: right, right, left, right. The score will be $$$a_1 + a_2 + a_3 + a_2 + a_3$$$.In the third example you can move four times to the left but it's not optimal anyway, you can just move four times to the right and obtain the score $$$a_1 + a_2 + a_3 + a_4 + a_5$$$.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k, z] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve k z as

solve k z as = maximum $ zipWith (!!) (iterate f (scanl1 (+) as)) (take (z + 1) $ takeWhile (>= 0) [k, k - 2 ..])
  where
    f vs = g (zipWith3 (\a b c -> a + b + c) as (tail as) vs) as 0
    g [] _ x = pure x
    g (v : vs) (a : as) x = let x' = max (x + a) v in x' : g vs as x'


You finally woke up after this crazy dream and decided to walk around to clear your head. Outside you saw your house's fence — so plain and boring, that you'd like to repaint it.  You have a fence consisting of $$$n$$$ planks, where the $$$i$$$-th plank has the color $$$a_i$$$. You want to repaint the fence in such a way that the $$$i$$$-th plank has the color $$$b_i$$$.You've invited $$$m$$$ painters for this purpose. The $$$j$$$-th painter will arrive at the moment $$$j$$$ and will recolor exactly one plank to color $$$c_j$$$. For each painter you can choose which plank to recolor, but you can't turn them down, i. e. each painter has to color exactly one plank.Can you get the coloring $$$b$$$ you want? If it's possible, print for each painter which plank he must paint.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^5$$$) — the number of planks in the fence and the number of painters. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the initial colors of the fence. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le n$$$) — the desired colors of the fence. The fourth line of each test case contains $$$m$$$ integers $$$c_1, c_2, \dots, c_m$$$ ($$$1 \le c_j \le n$$$) — the colors painters have. It's guaranteed that the sum of $$$n$$$ doesn't exceed $$$10^5$$$ and the sum of $$$m$$$ doesn't exceed $$$10^5$$$ over all test cases.

For each test case, output "NO" if it is impossible to achieve the coloring $$$b$$$. Otherwise, print "YES" and $$$m$$$ integers $$$x_1, x_2, \dots, x_m$$$, where $$$x_j$$$ is the index of plank the $$$j$$$-th painter should paint. You may print every letter in any case you want (so, for example, the strings "yEs", "yes", "Yes" and "YES" are all recognized as positive answer).

YES
1
YES
2 2
YES
1 1 1
YES
2 1 9 5 9
NO
NO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

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

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

prepAt :: STArray s Int [a] -> Int -> a -> ST s ()
prepAt arr ix val = do
  vals <- readArray arr ix
  writeArray arr ix (val : vals)

newSTArray :: (Int, Int) -> v -> ST s (STArray s Int v)
newSTArray = newArray

solve :: [Int] -> [Int] -> [Int] -> Maybe [Int]
solve a b c = runST $ do
  let
    n = length b
    lowPriority  = [(i, bi) | (i, ai, bi) <- zip3 [1..] a b, ai == bi]
    highPriority = [(i, bi) | (i, ai, bi) <- zip3 [1..] a b, ai /= bi]
  status <- newSTArray (0, n) []
  forM_ (lowPriority ++ highPriority) $ \(i, bi) -> prepAt status bi i
  positions <- forM (reverse c) $ \ci -> do
    cv <- readArray status ci
    case  cv  of
      [] -> do
        nulv <- readArray status 0
        pure $ case  nulv  of
          [] -> Nothing
          i : _ -> Just i
      (i : is) -> do
        writeArray status ci is
        prepAt status 0 i
        pure $ Just i
  case  sequence positions  of
    Nothing -> pure Nothing
    Just rpos -> do
      aopts <- getAssocs status
      patArr <- newSTArray (1, n) (error "missing ix")
      forM_ aopts $ \(ix, vals) ->
        forM_ vals $ \val ->
          writeArray patArr val $ case  ix  of
            0 -> Nothing
            _ -> Just ix
      pat <- getElems patArr
      pure $ if  and [ai == pi | (ai, Just pi) <- zip a pat]
        then  Just (reverse rpos)
        else  Nothing

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, _m] <- readInts
    a <- readInts
    b <- readInts
    c <- readInts
    lift $ case  solve a b c  of
      Nothing -> P.putStrLn $ P.pack "NO"
      Just ans -> do
        P.putStrLn $ P.pack "YES"
        P.putStrLn . P.pack . unwords $ map show ans


Kristina has two arrays $$$a$$$ and $$$b$$$, each containing $$$n$$$ non-negative integers. She can perform the following operation on array $$$a$$$ any number of times:   apply a decrement to each non-zero element of the array, that is, replace the value of each element $$$a_i$$$ such that $$$a_i > 0$$$ with the value $$$a_i - 1$$$ ($$$1 \le i \le n$$$). If $$$a_i$$$ was $$$0$$$, its value does not change. Determine whether Kristina can get an array $$$b$$$ from an array $$$a$$$ in some number of operations (probably zero). In other words, can she make $$$a_i = b_i$$$ after some number of operations for each $$$1 \le i \le n$$$?For example, let $$$n = 4$$$, $$$a = [3, 5, 4, 1]$$$ and $$$b = [1, 3, 2, 0]$$$. In this case, she can apply the operation twice:   after the first application of the operation she gets $$$a = [2, 4, 3, 0]$$$;  after the second use of the operation she gets $$$a = [1, 3, 2, 0]$$$. Thus, in two operations, she can get an array $$$b$$$ from an array $$$a$$$.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases in the test. The descriptions of the test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 5 \cdot 10^4$$$). The second line of each test case contains exactly $$$n$$$ non-negative integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^9$$$). The third line of each test case contains exactly $$$n$$$ non-negative integers $$$b_1, b_2, \dots, b_n$$$ ($$$0 \le b_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ values over all test cases in the test does not exceed $$$2 \cdot 10^5$$$.

For each test case, output on a separate line:   YES, if by doing some number of operations it is possible to get an array $$$b$$$ from an array $$$a$$$;  NO otherwise.  You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive response).

NoteThe first test case is analyzed in the statement.In the second test case, it is enough to apply the operation to array $$$a$$$ once.In the third test case, it is impossible to get array $$$b$$$ from array $$$a$$$.

module Main where

import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep (_:x:y:xs) = (x,y):(sep xs)

parse (x,y) = zip (phi x) (phi y)
  where phi = (map read) . words

format b
  | b = "YES"
  | otherwise = "NO"

solve ps = solve' False (-1) ps

solve' :: Bool -> Int -> [(Int, Int)] -> Bool
solve' _ _ [] = True
solve' _ _ ((a,b):_)
  | a < b = False
solve' False c ((a,b):xs)
  | b == 0 = solve' False (max a c) xs
  | otherwise = a-b >= c && solve' True (a-b) xs
solve' True c ((a,b):xs) =
  (a-b == c || (b == 0 && a <= c)) && solve' True c xs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.State
import qualified Data.ByteString.Char8 as C
import Data.Maybe

--
import Data.Bool

solve :: ([Integer], [Integer]) -> Bool
solve (as, bs) = isJust $foldM g (0, False) $ zipWith f as bs
 where
  f a 0 = (a, False)
  f a b = (a - b, True)

  g (x, False) (y, False) = Just (max x y, False)
  g (x, False) (y, True)
    | x <= y = Just (y, True)
    | otherwise = Nothing
  g (x, True) (y, True)
    | x == y = Just (x, True)
    | otherwise = Nothing
  g a b = g b a

input :: Scanner ([Integer], [Integer])
input = do
  n <- int
  as <- n >< integer
  bs <- n >< integer
  pure (as, bs)

output :: Bool -> C.ByteString
output = bool "NO" "YES"

main :: IO ()
main = C.interact $ C.unlines . map (output . solve) . runScanner (numberOf input)

-- Scanner

type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith sp sc = evalState sc . sp

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> pure s

read' :: (C.ByteString -> Maybe (a, C.ByteString)) -> Scanner a
read' q = fst . fromJust . q <$> bstr

int :: Scanner Int
int = read' C.readInt

integer :: Scanner Integer
integer = read' C.readInteger

(><) :: Int -> Scanner a -> Scanner [a]
(><) = replicateM

numberOf :: Scanner a -> Scanner [a]
numberOf = (int >>=) . flip (><)

-- boilerplate {{{1
-- vim: foldmethod=marker
-- pragmas {{{2
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module Main where -- {{{2

import Control.Applicative
import Control.Arrow ( (|||), (&&&) )
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Foldable hiding ( sum, product )
import Data.Function
import Data.Functor
import Data.IntMap ( IntMap )
import Data.IntSet ( IntSet )
import Data.List hiding ( sum, product )
import Data.Map ( Map )
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup ( Min(..), Max(..) )
import Data.Sequence ( Seq )
import Data.Set ( Set )
import Data.Text ( Text )
import Data.Traversable
import Data.Tuple
import Debug.Trace
import Prelude hiding ( sum, product )
import System.IO
-- import System.Random
import Text.Printf
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap           as IM
import qualified Data.IntSet           as IS
import qualified Data.Map              as LM
import qualified Data.Map.Strict       as M
import qualified Data.Sequence         as Q
import qualified Data.Set              as S
import qualified Data.Text             as T
import qualified Data.Text.IO          as T

-- utilites {{{2
readInt s = let Just (i,_) = C.readInt s in i :: Int
getInt = readInt <$> C.getLine
getInts = map readInt . C.words <$> C.getLine
putShows :: Show a => [a] -> IO ()
putShows = putStrLn . unwords . map show
ynq = putStrLn . bool "NO" "YES"
gcount g@(x:_) = (x, length g)
modulus = 10^9 + 7 :: Int
mod' x = rem x modulus
tri n = quot (n * n + n) 2
sum t     = foldl' (+) 0 t
product t = foldl' (*) 1 t
mprint :: Show a => String -> Maybe a -> IO ()
mprint s = maybe (putStrLn s) print
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t e = b >>= bool e t
whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())

-- }}}1

main = getInt >>= flip replicateM_ docase

docase = do
    [n] <- getInts
    aa  <- getInts
    bb  <- getInts
    let x = maximum $ zipWith (-) aa bb
    let f a 0 = a <= x
        f a b | a < b = False
        f a b = a - b == x
    let cc = zipWith f aa bb
    -- traceShowM (x,aa,bb,cc)
    ynq $ and cc


You are given a permutation $$$p_1, p_2, \dots, p_n$$$. Recall that sequence of $$$n$$$ integers is called a permutation if it contains all integers from $$$1$$$ to $$$n$$$ exactly once.Find three indices $$$i$$$, $$$j$$$ and $$$k$$$ such that:   $$$1 \le i < j < k \le n$$$;  $$$p_i < p_j$$$ and $$$p_j > p_k$$$.  Or say that there are no such indices.

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 200$$$) — the number of test cases. Next $$$2T$$$ lines contain test cases — two lines per test case. The first line of each test case contains the single integer $$$n$$$ ($$$3 \le n \le 1000$$$) — the length of the permutation $$$p$$$. The second line contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$; $$$p_i \neq p_j$$$ if $$$i \neq j$$$) — the permutation $$$p$$$.

For each test case:    if there are such indices $$$i$$$, $$$j$$$ and $$$k$$$, print YES (case insensitive) and the indices themselves;  if there are no such indices, print NO (case insensitive).  If there are multiple valid triples of indices, print any of them.

{-# LANGUAGE Strict #-}
module Main where
import qualified Data.Sequence as S
import System.IO

main :: IO ()
main = do
  hSetBuffering stdin LineBuffering
  interact $ unlines . solve . take2Nl . lines

take2Nl :: [String] -> [String]
take2Nl (n : xs) = take (2* (read n)) xs

solve :: [String] -> [String]
solve xs = let
             n = div (Prelude.length xs) 2
             go :: Int -> [String] -> [S.Seq Int] -> [S.Seq Int]
             go 0 _ sq = sq
             go nn (s:ss) sq = case even nn of
                            True -> go (nn-1) ss sq
                            False -> go (nn-1) ss ((f s):sq)
                              where f :: String -> S.Seq Int
                                    f st = S.fromList (map read $ words st)
             lsq = go (2 * n) xs []
             f :: S.Seq Int -> String
             f = func
           in
             reverse (f <$> lsq)

func :: S.Seq Int -> String
func sq = let (a,b,c,suc) = S.foldlWithIndex (\(i, j, k, b) ind a->
                        case b of
                          0 ->
                            case compare a (S.index sq i) of
                              GT -> (ind, 0, 0, b+1)
                              EQ -> (ind, 0, 0, b+1)
                              LT -> (ind, 0, 0, b)

                          1 ->
                            case compare a (S.index sq i) of
                              GT -> (i, ind, k, b+1)
                              EQ -> (i, ind, k, b+1)
                              LT -> (ind, j, k, b)

                          2 ->
                            case compare a (S.index sq j) of
                              GT -> (j, ind, k, b)
                              EQ -> (j, ind, k, b)
                              LT -> (i, j, ind, b+1)

                          3 -> (i, j, k, 3)
                                                        ) (0,0,0,0)  sq

          in case suc of
             3 -> "YES\n" ++ show (a+1) ++ " " ++ show (b+1) ++ " " ++ show (c+1)
             _ -> "NO\n"

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> map (words >>> map read) >>> process >>> unlines

process :: [[Int]] -> [String]
process [] = []
process ([_] : xs : rest) = solve xs 1 : process rest

solve :: [Int] -> Int -> String
solve (z:y:x:xs) i | (z < y && y > x) = (++) "YES\n" $ concat $ intersperse " " $ map show [i, i+1, i+2]
                   | otherwise = solve (y:x:xs) (i+1)
solve _ _ = "NO\n"

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  ps <- map read . words <$> getLine :: IO [Integer]
  case solve $ zip [1 ..] ps of
    Just is -> putStrLn "YES" >> putStrLn (unwords $ map show is)
    Nothing -> putStrLn "NO"

solve ((i, a) : ps@((j, b) : (k, c) : _))
  | a < b && b > c = Just [i, j, k]
  | otherwise = solve ps
solve _ = Nothing

{-# LANGUAGE Strict #-}
module Main where
import qualified Data.Sequence as S
import System.IO

main :: IO ()
main = do
  hSetBuffering stdin LineBuffering
  interact $ unlines . solve . take2Nl . lines

take2Nl :: [String] -> [String]
take2Nl (n : xs) = take (2* (read n)) xs

solve :: [String] -> [String]
solve xs = let
             n = div (Prelude.length xs) 2
             go :: Int -> [String] -> [S.Seq Int] -> [S.Seq Int]
             go 0 _ sq = sq
             go nn (s:ss) sq = case even nn of
                            True -> go (nn-1) ss sq
                            False -> go (nn-1) ss ((f s):sq)
                              where f :: String -> S.Seq Int
                                    f st = S.fromList (map read $ words st)
             lsq = go (2 * n) xs []
             f :: S.Seq Int -> String
             f = func
           in
             reverse (f <$> lsq)

func :: S.Seq Int -> String
func sq = let (a,b,c,suc) = S.foldrWithIndex (\ind a (i, j, k, b) ->
                        case b of
                          0 ->
                            case compare a (S.index sq i) of
                              GT -> (ind, 0, 0, b+1)
                              EQ -> (ind, 0, 0, b+1)
                              LT -> (ind, 0, 0, b)

                          1 ->
                            case compare a (S.index sq i) of
                              GT -> (i, ind, k, b+1)
                              EQ -> (i, ind, k, b+1)
                              LT -> (ind, j, k, b)

                          2 ->
                            case compare a (S.index sq j) of
                              GT -> (j, ind, k, b)
                              EQ -> (j, ind, k, b)
                              LT -> (i, j, ind, b+1)

                          3 -> (i, j, k, 3)
                                                        ) (0,0,0,0)  sq

          in case suc of
             3 -> "YES\n" ++ show (c+1) ++ " " ++ show (b+1) ++ " " ++ show (a+1)
             _ -> "NO\n"

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> map (words >>> map read) >>> process >>> unlines

process :: [[Int]] -> [String]
process [] = []
process ([_] : xs : rest) = solve xs : process rest

solve :: [Int] -> String
solve (x1:x2:x3:xs) | (x1 < x2 && x2 > x3) = "YES\n" ++ (concat $ intersperse " " $ map show [x1, x2, x3])
                    | otherwise = solve (x2:x3:xs)
solve _ = "NO\n"


Edogawa Conan got tired of solving cases, and invited his friend, Professor Agasa, over. They decided to play a game of cards. Conan has n cards, and the i-th card has a number ai written on it.They take turns playing, starting with Conan. In each turn, the player chooses a card and removes it. Also, he removes all cards having a number strictly lesser than the number on the chosen card. Formally, if the player chooses the i-th card, he removes that card and removes the j-th card for all j such that aj < ai.A player loses if he cannot make a move on his turn, that is, he loses if there are no cards left. Predict the outcome of the game, assuming both players play optimally.

The first line contains an integer n (1 ≤ n ≤ 105) — the number of cards Conan has.  The next line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 105), where ai is the number on the i-th card.

If Conan wins, print "Conan" (without quotes), otherwise print "Agasa" (without quotes).

NoteIn the first example, Conan can just choose the card having number 7 on it and hence remove all the cards. After that, there are no cards left on Agasa's turn.In the second example, no matter which card Conan chooses, there will be one one card left, which Agasa can choose. After that, there are no cards left when it becomes Conan's turn again.

import Data.Bool
import Data.List
main = putStr . bool "Agasa" "Conan" . or . map (odd . length) . group . sortBy (flip compare) . map (read :: String -> Int) . tail . words =<< getContents

import Data.List

main = getLine >> getLine >>= putStrLn . solve . words

solve xs
    | all (even . length) $ group $ sort xs = "Agasa"
    | otherwise = "Conan"

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Maybe
-- import Debug.Trace

-- debug = flip trace

getCount :: Int -> Int -> [Int] -> Bool
getCount p c (a:[])
    | p == a = (c + 1) `mod` 2 == 0 -- `debug` ("first pass p = " ++ show p ++ ", c = " ++ show a)
    | otherwise = False -- `debug` ("second pass p = " ++ show p ++ ", c = " ++ show a)
getCount p c (a : as)
    | (p /= a) && (c `mod` 2 /= 0) = False -- `debug` ("third pass p = " ++ show p ++ ", c = " ++ show a)
    | p /= a = getCount a 1 as -- `debug` ("fourth pass p = " ++ show p ++ ", c = " ++ show a)
    | otherwise = getCount p (c + 1) as -- `debug` ("fifth pass p = " ++ show p ++ ", c = " ++ show a)

solve :: [Int] -> String
solve as
    | countBool == True = "Agasa"
    | otherwise = "Conan"
    where countBool = getCount (-1) 0 as

main :: IO ()
main = do
    n <- fst . fromJust . B.readInt <$> B.getLine
    tas <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    let as = sort tas
    putStrLn $ solve as

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getCount :: Int -> Int -> [Int] -> Bool
getCount p c (a:[])
    | p == a = (c + 1) `mod` 2 == 0 -- `debug` ("first pass p = " ++ show p ++ ", c = " ++ show a)
    | otherwise = False -- `debug` ("second pass p = " ++ show p ++ ", c = " ++ show a)
getCount p c (a : as)
    | (p /= a) && (c `mod` 2 /= 0) = False -- `debug` ("third pass p = " ++ show p ++ ", c = " ++ show a)
    | p /= a = getCount a 1 as -- `debug` ("fourth pass p = " ++ show p ++ ", c = " ++ show a)
    | otherwise = getCount p (c + 1) as -- `debug` ("fifth pass p = " ++ show p ++ ", c = " ++ show a)

solve :: [Int] -> String
solve as
    | countBool == True = "Agasa"
    | otherwise = "Conan"
    where countBool = getCount (-1) (0) as

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    tas <- map (read :: String -> Int) . words <$> getLine
    let as = sort tas
    putStrLn $ solve as

module Main where

import Data.List

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn s ss = reverse $ splitOn' [] s (reverse ss) where
  splitOn' xs y []     = [xs]
  splitOn' xs y (z:zs) =
    if y == z
      then xs : splitOn' [] y zs
      else splitOn' (z:xs) y zs

counter :: Eq a => [a] -> [(Integer, a)]
counter list = counter' 1 (head list) (tail list) where
  counter' :: Eq a => Integer -> a -> [a] -> [(Integer, a)]
  counter' n x []     = [(n, x)]
  counter' n x (y:ys) =
    if x /= y
      then (n,x) : counter' 1 y ys
      else counter' (n + 1) y ys

answer :: (Ord a, Eq a) => [a] -> Bool
answer list = null . (filter odd) . (map fst) $ (counter . sort) list

main :: IO ()
main = do
  n <- getLine
  elemsLine <- getLine
  let
    elemsStrs = splitOn ' ' elemsLine
    elems :: [Int]
    elems = map read elemsStrs
  putStrLn $ if answer elems then "Agasa" else "Conan"

import Data.Bool
import Data.List
main = putStr . bool "Agasa" "Conan" . (\(ys, zs) -> odd (length ys) || odd (length zs)) . (\xs -> partition (== maximum xs) xs)  . map (read :: String -> Int) . tail . words =<< getContents

import Data.Bool
main = putStr . bool "Agasa" "Conan" . odd . length . (\xs -> filter (== maximum xs) xs)  . map (read :: String -> Int) . tail . words =<< getContents

import Control.Applicative
import Data.List

getHighestCount :: [Int] -> Int -> Int
getHighestCount [] m = 0
getHighestCount (x:xs) m
    | m == x = 1 + rem
    | otherwise = rem
    where rem = getHighestCount xs m

solve :: Int -> [Int] -> String
solve n as
    | (n == hiCount) && (n `mod` 2 == 0) = "Agasa"
    | otherwise = "Conan"
    where hiCount = getHighestCount as $ maximum as

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    tas <- map (read :: String -> Int) . words <$> getLine
    let as = sort tas
    putStrLn $ solve n as


Xenia has a set of weights and pan scales. Each weight has an integer weight from 1 to 10 kilos. Xenia is going to play with scales and weights a little. For this, she puts weights on the scalepans, one by one. The first weight goes on the left scalepan, the second weight goes on the right scalepan, the third one goes on the left scalepan, the fourth one goes on the right scalepan and so on. Xenia wants to put the total of m weights on the scalepans.Simply putting weights on the scales is not interesting, so Xenia has set some rules. First, she does not put on the scales two consecutive weights of the same weight. That is, the weight that goes i-th should be different from the (i + 1)-th weight for any i (1 ≤ i < m). Second, every time Xenia puts a weight on some scalepan, she wants this scalepan to outweigh the other one. That is, the sum of the weights on the corresponding scalepan must be strictly greater than the sum on the other pan.You are given all types of weights available for Xenia. You can assume that the girl has an infinite number of weights of each specified type. Your task is to help Xenia lay m weights on the scales or to say that it can't be done.

The first line contains a string consisting of exactly ten zeroes and ones: the i-th (i ≥ 1) character in the line equals "1" if Xenia has i kilo weights, otherwise the character equals "0". The second line contains integer m (1 ≤ m ≤ 1000).

In the first line print "YES", if there is a way to put m weights on the scales by all rules. Otherwise, print in the first line "NO". If you can put m weights on the scales, then print in the next line m integers — the weights' weights in the order you put them on the scales. If there are multiple solutions, you can print any of them.

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

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

assertNull :: [a] -> Assertion
assertNull  =  assertTrue . null

assertNotNull :: [a] -> Assertion
assertNotNull  =  assertFalse . null

checkerTests :: Test
checkerTests  =  TestList "Checker tests"
  [
    Test "#1" $ assertNotNull $ solve 3 [8, 10],
    Test "#2" $ assertNull $ solve 2 [1],
    Test "#3" $ assertNotNull $ solve 1 [1],
    Test "#4" $ assertNotNull $ solve 1000 [1..10],
    Test "#5" $ assertNull $ solve 11 [1, 4, 5],
    Test "#6" $ assertNull $ solve 10 [2, 10],
    Test "#7" $ assertNotNull $ solve 12 [2, 3, 5, 6],
    Test "#8" $ assertNotNull $ solve 494 [1, 2, 5, 9, 10],
    Test "#9" $ assertNotNull $ solve 494 [1, 2, 5, 9, 10],
    Test "#10" $ assertNotNull $ solve 642 [1, 2, 3, 7, 10],
    Test "#11" $ assertNotNull $ solve 229 [1, 2, 4, 6, 7, 9, 10],
    Test "#12" $ assertNotNull $ solve 273 [1, 2, 3, 5, 6, 7, 9],
    Test "#13" $ assertNotNull $ solve 861 [4, 6, 9, 10],
    Test "#14" $ assertNotNull $ solve 32 [2, 3, 4, 5, 8, 9, 10],
    Test "#15" $ assertNull $ solve 52 [7, 8],
    Test "#16" $ assertNotNull $ solve 483 [1, 2, 3, 7, 10],
    Test "#17" $ assertNotNull $ solve 498 [1, 2, 4, 5],
    Test "#18" $ assertNotNull $ solve 905 [1, 3, 5, 6, 8],
    Test "#19" $ assertNotNull $ solve 919 [1, 2, 7, 9, 10],
    Test "#20" $ assertNotNull $ solve 1000 [4, 5, 6, 9],
    Test "#21" $ assertNotNull $ solve 1000 [3, 6, 9, 10],
    Test "#22" $ assertNull $ solve 1 [],
    Test "#23" $ assertEq [10] $ solve 1 [10],
    Test "#24" $ assertNull $ solve 2 [6],
    Test "#25" $ assertNull $ solve 3 [1, 2],
    Test "#26" $ assertNull $ solve 1000 [1, 2, 3, 6],
    Test "#27" $ assertNotNull $ solve 1000 [1, 2, 5, 6],
    Test "#28" $ assertNotNull $ solve 1000 [1, 2, 4, 6],
    Test "#29" $ assertNull $ solve 1000 [1, 2, 4, 10],
    Test "#30" $ assertNotNull $ solve 1000 [1, 2, 4, 9, 10],
    Test "#31" $ assertNotNull $ solve 1000 [1, 2, 9, 10],
    Test "#32" $ assertNotNull $ solve 1000 [1..10],
    Test "#33" $ assertNotNull $ solve 1000 [2, 3, 4, 5, 6, 8, 9, 10],
    Test "#34" $ assertNotNull $ solve 4 [1, 2, 3]
  ]

myTests :: Test
myTests  =  TestList "My tests"
  [
    Test "#1" $ assertNotNull $ solve 6 [2, 3, 5],
    Test "#1" $ assertNull $ solve 7 [2, 3, 5]
  ]

test :: IO ()
test  =  mapM_ run
  [
    checkerTests,
    myTests
  ]
-}
--------------------------------------------------------------------------------

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> [Int]
solve m as
  | not (null ans)  =  ans
  | not (null otherAnswers)  =  head otherAnswers
  | otherwise  =  []
  where
    ans  =  solve' m as 1 0 []
    otherAnswers  =  filter (not . null) $ map (\a -> solve' (m-1) as (-1) a [a]) as

    solve' 0 _ _ _ ans  =  reverse ans
    solve' m' [] _ _ _  =  []
    solve' m' (a:as') k s ans
      | (not (null ans)) && a == head ans  =  solve' m' as' k s ans
      | (s + k * a) * k > 0  =  solve' (m' - 1) as (-k) (s + k * a) (a:ans)
      | otherwise  =  solve' m' as' k s ans

main' :: IO ()
main'  =  do
    s  <-  getLine
    m  <-  readLn
    let ans  =  solve m $ map snd $ filter ((== '1') . fst) $ zip s [1..10]
    if null ans
        then putStrLn "NO"
        else putStrLn "YES" >> putStrLn (Data.List.intercalate " " (map show ans))

main :: IO ()
main  =  main'

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> [Int]
solve m as  =  solve' m as 1 0 []
  where
    solve' 0 _ _ _ ans  =  reverse ans
    solve' m' [] _ _ _  =  []
    solve' m' (a:as') k s ans
      | (not (null ans)) && a == head ans  =  solve' m' as' k s ans
      | (s + k * a) * k > 0  =  solve' (m' - 1) as (-k) (s + k * a) (a:ans)
      | otherwise  =  solve' m' as' k s ans

main :: IO ()
main  =  do
    s  <-  getLine
    m  <-  readLn
    let ans  =  solve m $ map snd $ filter ((== '1') . fst) $ zip s [1..10]
    if null ans
        then putStrLn "NO"
        else putStrLn "YES" >> putStrLn (Data.List.intercalate " " (map show ans))


Programmer Vasya is studying a new programming language &K*. The &K* language resembles the languages of the C family in its syntax. However, it is more powerful, which is why the rules of the actual C-like languages are unapplicable to it. To fully understand the statement, please read the language's description below carefully and follow it and not the similar rules in real programming languages.There is a very powerful system of pointers on &K* — you can add an asterisk to the right of the existing type X — that will result in new type X * . That is called pointer-definition operation. Also, there is the operation that does the opposite — to any type of X, which is a pointer, you can add an ampersand — that will result in a type &X, to which refers X. That is called a dereference operation.The &K* language has only two basic data types — void and errtype. Also, the language has operators typedef and typeof. The operator "typedef A B" defines a new data type B, which is equivalent to A. A can have asterisks and ampersands, and B cannot have them. For example, the operator typedef void** ptptvoid will create a new type ptptvoid, that can be used as void**. The operator "typeof A" returns type of A, brought to void, that is, returns the type void**...*, equivalent to it with the necessary number of asterisks (the number can possibly be zero). That is, having defined the ptptvoid type, as shown above, the typeof ptptvoid operator will return void**.An attempt of dereferencing of the void type will lead to an error: to a special data type errtype. For errtype the following equation holds true: errtype* = &errtype = errtype. An attempt to use the data type that hasn't been defined before that will also lead to the errtype.Using typedef, we can define one type several times. Of all the definitions only the last one is valid. However, all the types that have been defined earlier using this type do not change.Let us also note that the dereference operation has the lower priority that the pointer operation, in other words &T *  is always equal to T.Note, that the operators are executed consecutively one by one. If we have two operators "typedef &void a" and "typedef a* b", then at first a becomes errtype, and after that b becomes errtype* = errtype, but not &void* = void (see sample 2).Vasya does not yet fully understand this powerful technology, that's why he asked you to help him. Write a program that analyzes these operators.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of operators. Then follow n lines with operators. Each operator is of one of two types: either "typedef A B", or "typeof A". In the first case the B type differs from void and errtype types, and besides, doesn't have any asterisks and ampersands. All the data type names are non-empty lines of no more than 20 lowercase Latin letters. The number of asterisks and ampersands separately in one type in any operator does not exceed 10, however if we bring some types to void with several asterisks, their number may exceed 10.

For every typeof operator print on the single line the answer to that operator — the type that the given operator returned.

5
typedef void* ptv
typeof ptv
typedef &&ptv node
typeof node
typeof &ptv

17
typedef void* b
typedef b* c
typeof b
typeof c
typedef &b b
typeof b
typeof c
typedef &&b* c
typeof c
typedef &b* c
typeof c
typedef &void b
typeof b
typedef b******* c
typeof c
typedef &&b* c
typeof c

void*
void**
void
void**
errtype
void
errtype
errtype
errtype

NoteLet's look at the second sample.After the first two queries typedef the b type is equivalent to void*, and с — to void**.The next query typedef redefines b — it is now equal to &b = &void* = void. At that, the с type doesn't change.After that the с type is defined as &&b* = &&void* = &void = errtype. It doesn't influence the b type, that's why the next typedef defines c as &void* = void.Then the b type is again redefined as &void = errtype. Please note that the c type in the next query is defined exactly as errtype******* = errtype, and not &void******* = void******. The same happens in the last typedef.

import Data.Map hiding (map)

main = interact $ unlines . solve . tail . map words . lines

solve es = reverse $ snd $ foldl parse (singleton "void" (Just 0), []) es

parse (types,result) (s:d:x) = case x of
  [type1] -> (insert type1 value1 types, result)
  _       -> (types, toString value1 : result)
  where
  (amps, bs)    = span (== '&') d
  (type0, asts) = span (/= '*') bs
  value0 = findWithDefault Nothing type0 types
  value1 = typedef value0 (length amps) (length asts)

typedef (Just n) a b
  | n+b-a >= 0 = Just (n+b-a)
typedef _ _ _ = Nothing

toString (Just n) = "void" ++ replicate n '*'
toString Nothing  = "errtype"

module Main where
import Data.List
import qualified Data.Map as Map
import Control.Monad

parseT[]=(0,"")
parseT(h:t)=case h of
    '*' -> (c+1,n)
    '&' -> (c-1,n)
    ch -> (c,ch:n)
 where
  (c,n)=parseT t

m!k = join$Map.lookup k m

newt c n | r>=0 = Just r
 | otherwise = Nothing
 where r = c+n

mkt state t= state!n >>= newt c
 where(c, n)=parseT t

type Type = Maybe Int
type State = Map.Map String Type
process :: State -> [String] -> (State, [Type])
process state ["typedef",t,name] = (Map.insert name (mkt state t) state, [])
process state ["typeof",t] = (state,[mkt state t])

pv n="void"++replicate n '*'
pp :: Type -> String
pp=maybe "errtype" pv

main=interact$unlines.map pp.concat.snd.mapAccumL process(Map.singleton "void"$Just 0).map words.tail.lines

module Main where

import Control.Monad
import Data.List
import qualified Data.Map as Map

main = do
    n <- read `liftM` getLine
    foldM_ (\table _ -> do
            cmd <- words `liftM` getLine
            let ref = cmd !! 1
                name = cmd !! 2
                refName = filter (\ch -> ch /= '*' && ch /= '&') ref
                incCount = length $ filter (=='*') ref
                decCount = length $ filter (=='&') ref
                refCount = maybe (-1) id $ Map.lookup refName table
                count = if refCount < 0 then (-1) else max (-1) (refCount+incCount-decCount)
            if head cmd == "typedef"
                then return $ Map.insert name count table
                else ( putStrLn $ if count < 0 then "errtype" else "void" ++ replicate count '*' ) >>
                    return table
        ) (Map.singleton "void" 0) [1..n]

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n (BS.unpack <$> readLine)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStr . unlines =<< solve . evalState parseInput <$> BS.getContents

type Type = Maybe Int -- Nothing = ErrType
                      -- Just x  = VoidType (* times x)

type TypeMapping = Map String Type

modifyType :: Int -> Type -> Type
modifyType _ Nothing = Nothing
modifyType delta (Just x)
    | x + delta >= 0 = Just (x + delta)
    | otherwise      = Nothing

solve :: [String] -> [String]
solve program = evalState (solving program) $ Map.fromList [("void", Just 0), ("errtype", Nothing)]

parseType :: String -> (String, Int)
parseType str = (mid, length hi - length lo)
  where
    (lo, midHi) = span (=='&') str
    (mid, hi) = span isAlpha midHi

getType :: TypeMapping -> (String, Int) -> Type
getType mapping (typeName, typeDelta) = modifyType typeDelta $ Map.findWithDefault Nothing typeName mapping

showType :: Type -> String
showType Nothing = "errtype"
showType (Just x) = "void" ++ replicate x '*'

solving :: [String] -> State TypeMapping [String]
solving [] = return []
solving (op:ops)
    | opName == "typedef" = do
        mapping <- get
        put $ Map.insert y (getType mapping $ parseType x) mapping
        solving ops
    | otherwise           = do
        mapping <- get
        (showType (getType mapping $ parseType z):) <$> solving ops
  where
    (opName:leftPart) = words op

    [x, y] = leftPart

    [z] = leftPart

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

module Main where

import Control.Monad
import Data.List
import qualified Data.Map as Map

main = do
    n <- read `liftM` getLine
    foldM_ (\table _ -> do
            cmd <- words `liftM` getLine
            let ref = cmd !! 1
                name = cmd !! 2
                refName = filter (\ch -> ch /= '*' && ch /= '&') ref
                incCount = length $ filter (=='*') ref
                decCount = length $ filter (=='&') ref
                refCount = maybe (-1) id $ Map.lookup refName table
                count = max (-1) (refCount+incCount-decCount)
            if head cmd == "typedef"
                then return $ Map.insert name count table
                else ( putStrLn $ if count < 0 then "errtype" else "void" ++ replicate count '*' ) >>
                    return table
        ) (Map.singleton "void" 0) [1..n]