Vasya's birthday is approaching and Lena decided to sew a patterned handkerchief to him as a present. Lena chose digits from 0 to n as the pattern. The digits will form a rhombus. The largest digit n should be located in the centre. The digits should decrease as they approach the edges. For example, for n = 5 the handkerchief pattern should look like that:           0        0 1 0      0 1 2 1 0    0 1 2 3 2 1 0  0 1 2 3 4 3 2 1 00 1 2 3 4 5 4 3 2 1 0  0 1 2 3 4 3 2 1 0    0 1 2 3 2 1 0      0 1 2 1 0        0 1 0          0Your task is to determine the way the handkerchief will look like by the given n.

main = do
	n<-getLine
	let res1 = solve (read n) 0
	let res2 = init $ unlines $reverse $ init $ lines res1
	putStr $ res1
	putStrLn res2

solve n l | l <=n = spaces ((n-l)) ++ printer (generator l) ++ "\n" ++ solve n (l+1)
          | otherwise = ""

generator n = [0,1..n-1] ++ [n,n-1..0]

spaces n = replicate (2*n) ' '

printer s = init $ concat $  map (\x-> show x ++ " ") s

join _ [] = []
join c [x] = x
join c (x:xs) = x ++ [c] ++ join c xs

solve n = map tostr a
	where
		tostr lst = (take (n * 2 + 1 - length lst) $ repeat ' ') ++ (join ' ' $ map show lst)
		a = [ [0..i-1] ++ [i,i-1..0] | i <- [0..n-1] ++ [n,n-1..0] ]

main = getLine >>= putStrLn . join '\n' . solve . read

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  n <- readLn

  let
    s = [[f i j | j <- [1..2*n+1]] | i <- [1..2*n+1]]
    f i j = if d <= n then intToDigit (n-d) else ' '
      where
        d = abs (i-n-1) + abs (j-n-1)

  putStr $ unlines $ map (dropWhileEnd isSpace . intersperse ' ') s

main = do
	io <- getLine
	let n = read io
	putStr $ work 0 (2*n)

work :: Int -> Int -> [Char]
work x 0 = pl 0 x ++ ['\n']
work x sp = pre ++ work (x+1) (sp-2) ++ pre
		where pre = replicate sp ' ' ++ pl 0 x ++ ['\n']

pl :: Int -> Int -> [Char]
pl x y
	| x == y = show x
	| otherwise = show x ++ [' '] ++ pl (x+1) y ++ [' '] ++ show x

import Data.List

printline n x = intersperse ' ' $ take (n - x) (repeat ' ') ++ concatMap show ( [0..x] ++ drop 1 ( reverse [0 .. x] ))
printthing x = mapM_ (putStrLn.(printline x)) ((\x-> x ++ (drop 1 $ reverse x)) [0..x])
main = getLine >>= return.read >>= printthing

import Monad
import Data.Char
import Debug.Trace

doSolve :: Int -> IO ()
doSolve n = doSolve' 0
    where
      with :: a -> [a] -> [a]
      with s (x:y:xs)  = x : s : (with s (y:xs))
      with s xs@(x:[]) = xs

      adjust :: [Int] -> String
      adjust lst = let len = length lst
                       tmp = (with ' ' $ map (chr . (+ ord '0')) lst)
                       ret =  replicate (2 * (n - len)) ' ' ++
                              tmp ++ (tail $ reverse tmp)
                   in ret

      doSolve' :: Int -> IO ()
      doSolve' i | i == n    = return ()
                 | otherwise = let lst = [0..i]
                               in do putStrLn $ adjust lst
                                     doSolve' $ i + 1
                                     when (n - 1 /= i) $ putStrLn $ adjust lst

main :: IO ()
main = do cs <- getContents
          let n = read cs :: Int
          doSolve $ n + 1

{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}

module Main where

import           Control.Applicative
import           Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.Function
import           Data.List
import           Data.Maybe
import           System.Environment
import           System.IO

type BString = B.ByteString

solve :: Int -> [String]
solve n = map make_line $ make_seq n
  where
    make_line :: Int -> String
    make_line n' = replicate (2 * (n - n')) ' ' ++ unwords (map show $ make_seq n')
    make_seq :: Int -> [Int]
    make_seq n = [0 .. n - 1] ++ [n, n - 1 .. 0]

process :: State Reader [String]
process = solve <$> parse

main :: IO ()
main = do
    args <- getArgs
    reader <- if not (null args) && head args == "MINE"
              then B.lines <$> (openFile "input.txt" ReadMode >>= B.hGetContents)
              else B.lines <$> B.getContents
    say $ evalState process reader

say :: Display a => a -> IO ()
say = putStrLn . display

toNum :: Num a => Bool -> a
toNum False = 0
toNum True  = 1

type Reader = [BString]

class EIO a where
    parse :: State Reader a

instance EIO Int where
    parse = state $ \(line:rest) -> (fst $ fromJust $ B.readInt line, rest)

instance EIO [Int] where
    parse = state $ \(line:rest) -> (map fst . mapMaybe B.readInt . B.words $ line, rest)

instance EIO BString where
    parse = state $ \(line:rest) -> (line, rest)

class Show a => Display a where
    display :: a -> String
    display = show

instance Display String where
    display = id

instance Display [a] => Display [[a]] where
    display = unlines . map display

instance Display a => Display [a] where
    display = unwords . map display

instance Display Int
instance Display Double

main = getLine >>= putStrLn . unlines .  func' . read

func' :: Integer -> [String]
func' n = cteateSector n ++  tail ( reverse ( cteateSector n ))

cteateSector :: Integer -> [String]
cteateSector n = map insertSpaces $ reverse [strCreate kk n ++ takeWhile(/=' ') (tail (reverse (strCreate kk n))) | kk <- [0..n]]
			where strCreate k n = concat [if (nn < k) then " " else show (nn-k )  | nn<-[0..n]]

insertSpaces :: String -> String
insertSpaces [h] = [h]
insertSpaces (h:str) = h : ' ' : insertSpaces str

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
someFunc::IO()
someFunc = (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve [x]  = forM_ (map (\b-> unwords $ map (\a-> if a<0 then " " else show a) $ slv1 b x)  $ slv1 x x) $ \i -> putStrLn $ dropWhileEnd (==' ') i
slv1 x y =  [x-y..x]++[x-1,x-2..x-y]

import Control.Monad
import Data.List
solve n = let a = scanl' (flip (:)) [0] [1..n]
              b = zipWith (++) (map (reverse . tail) a) a
              c = b ++ (reverse $ init b)
              pad n x = (replicate (1+(4*n - length x)`div`2) ' ') ++ x
          in map (pad n. concat . intersperse " " . map show) c
main =  (readLn :: IO Int) >>= \x -> mapM  putStrLn $ solve x

str = unwords . map show . nums
nums n = [0..n] ++ [n-1,n-2..0]
main = do
  n <- read `fmap` getLine
  let sol = map f $ nums n
      f k = replicate ((n-k)*2) ' ' ++ str k
  putStr . unlines $ sol

import Data.List
f n = [0 .. n] ++ [n - 1, n - 2 .. 0]
g n x = (replicate (2 * (n - x)) ' ') ++ (intersperse ' ' $ concatMap show $ f x)
main = interact $ unlines.(\n -> map (g n) (f n)).read

{-# 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
    readInt
  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 =<< solve . evalState parseInput <$> BS.getContents

solve n = unlines [ replicate (abs i * 2) ' ' ++ unwords (map show row')
                  | i <- [-n..n]
                  , let row = [0..n - abs i]
                  , let row' = row ++ tail (reverse row)
                  ]

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

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

main :: IO ()
main = readLn >>= mapM_ putStrLn . solve

solve :: Int -> [String]
solve n = [ replicate (2 * (n - i)) ' ' ++ unwords (map show $ [0..i-1] ++ [i,i-1..0]) | i <- [0..n] ++ [n-1, n-2 .. 0] ]

import Data.List
import Control.Monad
main = do
  n <- readLn
  forM_ [-n.. -1] $ \i -> putStrLn $ str n (-i)
  forM_ [0..n] $ \i -> putStrLn $ str n i
str n i = replicate (2*i) ' ' ++
          unwords (map show $ [0..n-i] ++ [n-i-1,n-i-2..0])

import Data.List

-- createLine :: Int -> [Int]
-- createLine n =
--   r ++ tail (reverse r)
--   where r = take n [0..]

-- createTriangle :: Int -> [[Int]]
-- createTriangle n
--   | n == 0 = []
--   | otherwise = createLine n : createTriangle (n-1)

-- createDiamond :: Int -> [[Int]]
-- createDiamond n =
--   reverse (tail t) ++ t
--   where t = createTriangle n

-- spaces :: Int -> String
-- spaces n
--   | n == 0 = []
--   | otherwise = ' ' : spaces (n-1)

-- drawLine :: Int -> [Int] -> String
-- drawLine r l =
--   spaces ((length l)*2-1) ++ correctLine l ++ spaces ((length l)*2-1)
--   where
--     correctLine :: [Int] -> String
--     correctLine [] = ""
--     correctLine (n:ns) =

f n = [0..n] ++ [n-1, n-2..0]
g n x = (replicate (2 * (n - x)) ' ') ++ (intersperse ' ' $ concatMap show $ f x)
main = interact $ unlines . (\n -> map (g n) (f n)) . read

import Data.List
line n = intercalate " " . map show $ [0..n] ++ [n-1, n-2..0]
spacesLine m n = replicate (2*m-2*n) ' ' ++ line n
solve n = map (spacesLine n) $ [0..n] ++ [n-1, n-2..0]
main = fmap read getLine >>= mapM putStrLn . solve

import Data.List
main = do
    n <- read `fmap` getLine
    let s1 = reverse $ scanl (\s _ -> ' ':s) [] [1..n]
        s2 = scanl (\l i -> i:l) ['0'] $ take n ['1'..]
        s3 = zipWith (\a b@(_:bs) -> a ++ reverse bs ++ b) s1 s2
        s4 = s3 ++ tail (reverse s3)
    mapM_ (putStrLn . unwords . map (:[])) s4

r = read::String->Int
main=interact$stripLast.mirror.build.r
listToStr = unwords.map show
build n = f' n 0
  where f' n d
          | n < d = ""
          | otherwise = (replicate (2*(n-d)) ' ')
                        ++ listToStr [0..d]
                        ++ (if d == 0 then "" else " ")
                        ++ listToStr [(d-1),(d-2)..0]
                        ++ "\n"
                        ++ f' n (d+1)
mirror s = s ++ m' s
  where m' = unlines.tail.reverse.lines
stripLast s = take (length s - 1) s

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

solve :: Int -> String
solve n = rec $ [0..n]++[n-1,n-2..0]
    where
      rec [] = ""
      rec (x:xs) = now++(rec xs)
          where
            now = (take ((n-x)*2) (repeat ' '))++(intersperse ' ' (foldl (\st -> \i -> st++(show i)) "" $ [0..x]++[x-1,x-2..0]))++"\n"
main = do puts.init.solve =<< (scan :: IO Int)

import Data.List
import Control.Monad

main :: IO ()
main = do
    line <- getLine
    let n = read line :: Int
    let result = let list = forLine n n in (reverse $ tail list) ++ list
    mapM_ putStrLn result

forLine :: Int -> Int -> [String]
forLine n 0 = [replicate (n*2) ' ' ++ "0"]
forLine n x = let before = [0..(x-1)]; after = [(x-1), (x-2)..0] in [replicate ((n-x)*2) ' ' ++ (intersperse ' ' . concatMap (show)) (before ++ [x] ++ after)] ++ forLine n (x-1)

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

makeList :: Int -> [[(Int,Int)]]
makeList n = [ [(x,y) | x <- [-n .. n]] | y <- [-n .. n]]

trim :: String -> String
trim = reverse . (dropWhile (`elem` " ")) . reverse

toString ::  [[(Int,Int)]] -> [String]
toString array = map convert array
         where
           n = (length (head array)) `div` 2
           convert list = trim$concatMap (\(x,y) -> [toChar (n - (abs x) - (abs y)) , ' ']) list
           toChar num = if num >= 0 then (head (show num)) else ' '

solve :: Int -> [String]
solve = toString.makeList

main = interact$unlines.solve.read.head.words

import Control.Applicative
import Data.List

main= do
	n<-  read<$> getLine ::IO Int
	let s = tail $ take (n+2) $ inits [0..n]
	let t = zipWith (++) s ([]: (map reverse s))
	let u = t++  tail (reverse t)
	let sp = ([replicate (i+i) ' '|i<-[0..n]]):: [[Char]]
	let sp1 = ((reverse sp ) ++ (tail sp) )::[[Char]]
 	let x= intercalate "\n" $ zipWith (++) sp1 (map (intercalate " " . map show) u)
	putStrLn x

{-
B. Present from Lena
=====================
time limit per test: 2 seconds
memory limit per test: 256 megabytes
input: standard input
output: standard output

Vasya's birthday is approaching and Lena decided to sew a patterned handkerchief to him as a present. Lena chose digits from 0 to n as the pattern. The digits will form a rhombus. The largest digit n should be located in the centre. The digits should decrease as they approach the edges. For example, for n = 5 the handkerchief pattern should look like that:

          0
        0 1 0
      0 1 2 1 0
    0 1 2 3 2 1 0
  0 1 2 3 4 3 2 1 0
0 1 2 3 4 5 4 3 2 1 0
  0 1 2 3 4 3 2 1 0
    0 1 2 3 2 1 0
      0 1 2 1 0
        0 1 0
          0

Your task is to determine the way the handkerchief will look like by the given n.

Input
------
The first line contains the single integer n (2 ≤ n ≤ 9).

Output
------
Print a picture for the given n. You should strictly observe the number of spaces before the first digit on each line. Every two adjacent digits in the same line should be separated by exactly one space. There should be no spaces after the last digit at the end of each line.

Sample test(s)
---------------
input
2
output
    0
  0 1 0
0 1 2 1 0
  0 1 0
    0

input
3
output
      0
    0 1 0
  0 1 2 1 0
0 1 2 3 2 1 0
  0 1 2 1 0
    0 1 0
      0

-}
import Data.List (intercalate)

pattern :: Int -> [String]
pattern n = map helper (upAndDown n)
  where helper k = replicate (2 * (n - k)) ' ' ++ (intercalate " " . map show) (upAndDown k)

upAndDown :: Int -> [Int]
upAndDown 0 = [0]
upAndDown n = tmp ++ (tail . reverse) tmp
  where tmp = [0 .. n]

main = do
  input <- getLine
  let n = read input
  mapM_ putStrLn (pattern n)

import Data.List
import Data.Char
main = getLine >>= putStr.unlines.solve.read

abses m  = map ((m-).abs.(m-)) [0..2 * m]

line n m = intersperse ' ' $ concat [replicate (n - m) ' ', map intToDigit $ abses m]

solve n = map (line n) $ abses n

import Data.Char
import Data.List

toInt :: String -> Int
toInt = read

strSeq :: Int -> [ [Char] ]
strSeq n 	= 	[ prefix ++ ( intersperse ' ' ( x ++  (reverse . init ) x ) ) |
					let ls = ( enumFromTo 0 n ),
					y <- ls ++ ( reverse . init ) ls,
					let x = map intToDigit (enumFromTo 0 y),
					let prefix = replicate ( 2*(n - y) ) ' '
				]

main = do
	strN 	<- getLine
	putStr $ ( unlines . strSeq . toInt ) strN

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List
import Data.Char
-- Meat

solve :: Int -> [String]
solve n = fmap (buildLine n) ([0..n]++reverse[0 .. n - 1])

buildLine :: Int -> Int -> String
buildLine total i = doublePad total $ innerString i

doublePad :: Int -> String -> String
doublePad n inner = spaces ++ inner
    where spaceLen = (4 * n + 1 - length inner) `quot` 2
          spaces = replicate spaceLen ' '

innerString :: Int -> String
innerString 0 = "0"
innerString maxDig = intersperse ' ' (['0'..c]++ reverse [ '0' .. pred c])
    where c = intToDigit maxDig

-- Shit
main :: IO ()
main = do
        [n] <- readShit
        printShitV $ solve n

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

make_row 0 = [0]
make_row x = [0..x] ++ [x-1, x-2 .. 0]

pprint :: Int -> ([[Int]] -> String)
pprint n = unlines . (map fl)
           where
             fl = fill . unwords . map show
             fill x = (spaces x) ++ x
             spaces:: String -> String
             spaces x = take ((2*n+1 - length x) `div` 2) (repeat ' ')

solve :: Int->String
solve x = pprint (2*x) [make_row x | x <- [0..x] ++ [x-1, x-2 .. 0]]

parse = (read::String->Int)

main = interact (solve . parse)

main = do
	n<-getLine
	let res1 = solve (read n) 0
	let res2 = reverse $ init $ unlines $ init $ lines res1
	putStr $ res1
	putStrLn res2

solve n l | l <=n = spaces ((n-l)) ++ printer (generator l) ++ "\n" ++ solve n (l+1)
          | otherwise = ""

generator n = [0,1..n-1] ++ [n,n-1..0]

spaces n = replicate (2*n) ' '

printer s = init $ concat $  map (\x-> show x ++ " ") s

main = do
	n<-getLine
	let res1 = solve (read n) 0
	let res2 = reverse $ init $ unlines $ init $ lines res1
	putStr $ res1
	putStrLn res2

solve n l | l <=n = spaces ((n-l)) ++ printer (generator l) ++ spaces ((n-l))++ "\n" ++ solve n (l+1)
          | otherwise = ""

generator n = [0,1..n-1] ++ [n,n-1..0]

spaces n = replicate (2*n) ' '

printer s = init $ concat $  map (\x-> show x ++ " ") s

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  n <- readLn

  let
    s = [[f i j | j <- [1..2*n+1]] | i <- [1..2*n+1]]
    f i j = if d <= n then intToDigit (n-d) else ' '
      where
        d = abs (i-n-1) + abs (j-n-1)

  putStr $ unlines $ map (intersperse ' ') s

main = getLine >>= putStrLn . unlines .  func' . read

func' :: Integer -> [String]
func' n = cteateSector n ++  tail ( reverse ( cteateSector n ))

cteateSector :: Integer -> [String]
cteateSector n = reverse [strCreate kk n ++ tail (reverse (strCreate kk n)) | kk <- [0..n]]
			where strCreate k n = unwords [if (nn < k) then " " else show (nn-k )  | nn<-[0..n]]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
someFunc::IO()
someFunc = (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve [x]  = forM_ (map (\b-> unwords $ map (\a-> if a<0 then " " else show a) $ slv1 b x)  $ slv1 x x) $ \i -> putStrLn i
slv1 x y =  [x-y..x]++[x-1,x-2..x-y]

import Data.List
import Control.Monad

main :: IO ()
main = do
    line <- getLine
    let n = read line :: Int
    let result = let list = forLine n n in (reverse $ tail list) ++ list
    mapM_ print result

forLine :: Int -> Int -> [String]
forLine n 0 = [replicate (n*2) ' ' ++ "0"]
forLine n x = let before = [0..(x-1)]; after = [(x-1), (x-2)..0] in [replicate (n-x) ' ' ++ (intersperse ' ' . concatMap (show)) (before ++ [x] ++ after)] ++ forLine n (x-1)

import Data.List
import Control.Monad

main :: IO ()
main = do
    line <- getLine
    let n = read line :: Int
    let result = let list = forLine n n in (reverse $ tail list) ++ list
    mapM_ putStrLn result

forLine :: Int -> Int -> [String]
forLine n 0 = [replicate (n*2) ' ' ++ "0"]
forLine n x = let before = [0..(x-1)]; after = [(x-1), (x-2)..0] in [replicate (n-x) ' ' ++ (intersperse ' ' . concatMap (show)) (before ++ [x] ++ after)] ++ forLine n (x-1)

import Data.Char
import Data.List

toInt :: String -> Int
toInt = read

strSeq :: Int -> [ [Char] ]
strSeq n 	= 	[ prefix ++ ( intersperse ' ' ( x ++  (reverse . init ) x ) ) ++ prefix |
					let ls = ( enumFromTo 0 n ),
					y <- ls ++ ( reverse . init ) ls,
					let x = map intToDigit (enumFromTo 0 y),
					let prefix = replicate ( 2*(n - y) ) ' '
				]

main = do
	strN 	<- getLine
	putStr $ ( unlines . strSeq . toInt ) strN

import Data.Char
import Data.List

toInt :: String -> Int
toInt = read

strSeq :: Int -> [ [Char] ]
strSeq n 	= 	[ prefix ++ ( intersperse ' ' ( x ++  (reverse . init ) x ) ) ++ prefix |
					let ls = ( enumFromTo 0 n ),
					y <- ls ++ ( reverse . init ) ls,
					let x = map intToDigit (enumFromTo 0 y),
					let prefix = replicate ( 2*(n - y) ) ' '
				]

main = do
	strN 	<- getLine
	putStrLn $ ( unlines . strSeq . toInt ) strN

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
import Data.List
import Data.Char
-- Meat

solve :: Int -> [String]
solve n = fmap (buildLine n) ([0..n]++reverse[0 .. n - 1])

buildLine :: Int -> Int -> String
buildLine total i = doublePad total $ innerString i

doublePad :: Int -> String -> String
doublePad n inner = spaces ++ inner ++ spaces
    where spaceLen = (4 * n + 1 - length inner) `quot` 2
          spaces = replicate spaceLen ' '

innerString :: Int -> String
innerString 0 = "0"
innerString maxDig = intersperse ' ' (['0'..c]++ reverse [ '0' .. pred c])
    where c = intToDigit maxDig

-- Shit
main :: IO ()
main = do
        [n] <- readShit
        printShitV $ solve n

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

make_row 0 = [0]
make_row x = [0..x] ++ [x-1, x-2 .. 0]

pprint :: Int -> ([[Int]] -> String)
pprint n = unlines . (map fl)
           where
             fl = fill . unwords . map show
             fill x = (spaces x) ++ x ++ (spaces x)
             spaces:: String -> String
             spaces x = take ((2*n+1 - length x) `div` 2) (repeat ' ')

solve :: Int->String
solve x = pprint (2*x) [make_row x | x <- [0..x] ++ [x-1, x-2 .. 0]]

parse = (read::String->Int)

main = interact (solve . parse)

r = read::String->Int
main=interact$stripLast.mirror.build.r
listToStr = unwords.map show
build n = f' n 0
  where f' n d
          | n < d = ""
          | otherwise = (replicate (2*(n-d)) ' ')
                        ++ listToStr [0..d]
                        ++ " "
                        ++ listToStr [(d-1),(d-2)..0]
                        ++ "\n"
                        ++ f' n (d+1)
mirror s = s ++ m' s
  where m' = unlines.tail.reverse.lines
stripLast s = take (length s - 1) s

r = read::String->Int
main=interact$stripLast.mirror.build.r
listToStr = unwords.map show
build n = f' n 0
  where f' n d
          | n < d = ""
          | otherwise = (replicate (2*(n-d)) ' ')
                        ++ listToStr [0..d]
                        ++ " "
                        ++ listToStr [(d-1),(d-2)..0]
                        ++ ['\n']
                        ++ f' n (d+1)
mirror s = s ++ m' s
  where m' = unlines.tail.reverse.lines
stripLast s = take (length s - 1) s

r = read::String->Int
main=interact$stripLast.mirror.build.r
listToStr = unwords.map show
build n = f' n 0
  where f' n d
          | n < d = ""
          | otherwise = (replicate (2*(n-d)) ' ')
                        ++ listToStr [0..d]
                        ++ " "
                        ++ listToStr [(d-1),(d-2)..0]
                        ++ " \n"
                        ++ f' n (d+1)
mirror s = s ++ m' s
  where m' = unlines.tail.reverse.lines
stripLast s = take (length s - 1) s


You are given $$$n$$$ strings $$$s_1, s_2, \ldots, s_n$$$ consisting of lowercase Latin letters.In one operation you can remove a character from a string $$$s_i$$$ and insert it to an arbitrary position in a string $$$s_j$$$ ($$$j$$$ may be equal to $$$i$$$). You may perform this operation any number of times. Is it possible to make all $$$n$$$ strings equal?

The first line contains $$$t$$$ ($$$1 \le t \le 10$$$): the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$): the number of strings. $$$n$$$ lines follow, the $$$i$$$-th line contains $$$s_i$$$ ($$$1 \le \lvert s_i \rvert \le 1000$$$). The sum of lengths of all strings in all test cases does not exceed $$$1000$$$.

If it is possible to make the strings equal, print "YES" (without quotes). Otherwise, print "NO" (without quotes). You can output each character in either lowercase or uppercase.

4
2
caa
cbb
3
cba
cba
cbb
4
ccab
cbac
bca
acbcc
4
acb
caf
c
cbafc

NoteIn the first test case, you can do the following:   Remove the third character of the first string and insert it after the second character of the second string, making the two strings "ca" and "cbab" respectively. Remove the second character of the second string and insert it after the second character of the first string, making both strings equal to "cab". In the second test case, it is impossible to make all $$$n$$$ strings equal.

import qualified Data.Map as M

main = do
    t <- getInt
    sequence $ replicate t (do
        n <- getInt
        strings <- sequence $ replicate n getLine
        let concated = foldl (++) [] strings
            cnt = countLetters concated
            corrects = (map (\x -> (x `mod` n) == 0) cnt) :: [Bool]
        putStrLn (if foldl (&&) True corrects then "YES" else "NO")
        )

countLetters :: String -> [Int]
countLetters [] = []
countLetters str@(ch:_) = (length [x | x <- str, x == ch]):countLetters [x | x <- str, x /= ch]

getInt :: IO Int
getInt = do
    val <- getLine
    return $ read val

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  s <- concat <$> replicateM n getLine
  putStrLn $ bool "NO" "YES" $ all (\c -> length (filter (== c) s) `mod` n == 0) ['a' .. 'z']

import Data.List ( sort, group )
import Control.Monad ( replicateM_, replicateM )

solve :: Int -> [String] -> Bool
solve n strs = all (\c -> mod (length c) n == 0) . group . sort $ concat strs

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    strs <- replicateM n getLine
    putStrLn (if  solve n strs  then  "YES"  else  "NO")

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  s <- concat <$> replicateM n getLine
  print $ bool "NO" "YES" $ all (\c -> length (filter (== c) s) `mod` n == 0) ['a' .. 'z']


There is a matrix A of size x × y filled with integers. For every ,  Ai, j = y(i - 1) + j. Obviously, every integer from [1..xy] occurs exactly once in this matrix. You have traversed some path in this matrix. Your path can be described as a sequence of visited cells a1, a2, ..., an denoting that you started in the cell containing the number a1, then moved to the cell with the number a2, and so on.From the cell located in i-th line and j-th column (we denote this cell as (i, j)) you can move into one of the following cells: (i + 1, j) — only if i < x;  (i, j + 1) — only if j < y;  (i - 1, j) — only if i > 1;  (i, j - 1) — only if j > 1.Notice that making a move requires you to go to an adjacent cell. It is not allowed to stay in the same cell. You don't know x and y exactly, but you have to find any possible values for these numbers such that you could start in the cell containing the integer a1, then move to the cell containing a2 (in one step), then move to the cell containing a3 (also in one step) and so on. Can you choose x and y so that they don't contradict with your sequence of moves?

The first line contains one integer number n (1 ≤ n ≤ 200000) — the number of cells you visited on your path (if some cell is visited twice, then it's listed twice). The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109) — the integers in the cells on your path.

If all possible values of x and y such that 1 ≤ x, y ≤ 109 contradict with the information about your path, print NO. Otherwise, print YES in the first line, and in the second line print the values x and y such that your path was possible with such number of lines and columns in the matrix. Remember that they must be positive integers not exceeding 109.

NoteThe matrix and the path on it in the first test looks like this:  Also there exist multiple correct answers for both the first and the third examples.

{-# LANGUAGE LambdaCase #-}
import Data.List
import qualified Data.ByteString.Char8 as B

main = B.interact exec
exec = B.pack . maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map (maybe undefined fst . B.readInt) . tail . B.words
hi = 10^(9 :: Int) :: Int
fn xs = (\case { [] -> Just (hi, hi); [1] -> Just (1, hi); [y] | y > 0 -> Just (hi, y); [1, y] | and $ snd $ mapAccumL (\p x -> (x, abs (x - p) /= 1 || (x - 1) `quot` y == (p - 1) `quot` y)) (head xs) (tail xs) -> Just (hi, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail) $ xs

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | length moves == 2 && head moves /= 1 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then (if moves !! 0 == 1 then 1000000000 else moves !! 0) else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) ((head xs - 1) `mod` ud + 1, (head xs - 1) `div` ud + 1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

{-# LANGUAGE LambdaCase #-}
import Data.List

main = interact exec
exec = maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map read . tail . words
fn = (\case { [1] -> Just (1 :: Int, 10^9 :: Int); [y] -> Just (10^9, y); [1, y] -> Just (10^9, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail)

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

{-# LANGUAGE LambdaCase #-}
import Data.List

main = interact exec
exec = maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map read . tail . words
hi = 10^(9 :: Int) :: Int
fn = (\case { [] -> Just (hi, hi); [1] -> Just (1, hi); [y] -> Just (hi, y); [1, y] -> Just (hi, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail)

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

{-# LANGUAGE LambdaCase #-}
import Data.List
import qualified Data.ByteString.Char8 as B

main = B.interact exec
exec = B.pack . maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map (maybe undefined fst . B.readInt) . tail . B.words
hi = 10^(9 :: Int) :: Int
fn xs = (\case { [] -> Just (hi, hi); [1] -> Just (1, hi); [y] -> Just (hi, y); [1, y] | and $ snd $ mapAccumL (\p x -> (x, abs (x - p) /= 1 || x `quot` (y + 1) == p `quot` (y + 1) )) (head xs) (tail xs) -> Just (hi, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail) $ xs

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

{-# LANGUAGE LambdaCase #-}
import Data.List

main = interact exec
exec = maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map read . tail . words
hi = 10^(9 :: Int) :: Int
fn xs = (\case { [] -> Just (hi, hi); [1] -> Just (1, hi); [y] -> Just (hi, y); [1, y] | and $ snd $ mapAccumL (\p x -> (x, abs (x - p) /= 1 || x <= y)) (head xs) (tail xs) -> Just (hi, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail) $ xs

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

{-# LANGUAGE LambdaCase #-}
import Data.List
import qualified Data.ByteString.Char8 as B

main = B.interact exec
exec = B.pack . maybe "NO" (\(a, b) -> unlines ["YES", show a, show b]) . fn . map (maybe undefined fst . B.readInt) . tail . B.words
hi = 10^(9 :: Int) :: Int
fn xs = (\case { [] -> Just (hi, hi); [1] -> Just (1, hi); [y] | y > 0 -> Just (hi, y); [1, y] | and $ snd $ mapAccumL (\p x -> (x, abs (x - p) /= 1 || x `quot` (y + 1) == p `quot` (y + 1) )) (head xs) (tail xs) -> Just (hi, y); _ -> Nothing; } ) . snub . sort . map abs . (zipWith (-) =<< tail) $ xs

snub [] = []
snub (x:xs) = x:go x xs
  where
  go _ [] = []
  go x (y:ys)
     | x < y = y:go y ys
     | otherwise = go x ys

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then (if moves !! 0 == 1 then 1000000000 else moves !! 0) else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (head xs `mod` ud, (head xs - 1) `div` ud + 1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | head moves /= 1 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then (if moves !! 0 == 1 then 1000000000 else moves !! 0) else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) ((head xs - 1) `mod` ud + 1, (head xs - 1) `div` ud + 1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (10000000000, 10000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 10000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then moves !! 0 else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (1,1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show a) ++ " " ++ (show b))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then (if moves !! 0 == 1 then 1000000000 else moves !! 0) else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (1,1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (10000000000, 10000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 10000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then moves !! 0 else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (1,1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then 1000000000 else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (1,1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then (if moves !! 0 == 1 then 1000000000 else moves !! 0) else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) ((head xs - 1) `mod` ud + 1, (head xs - 1) `div` ud + 1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

solve :: [Int] -> Maybe (Int, Int)
solve xs
    | length xs == 1 = Just (1000000000, 1000000000)
    | length moves > 2 = Nothing
    | head moves == 0 = Nothing
    | otherwise = if valid then Just (ud, 1000000000) else Nothing
    where gap = zipWith (-) xs (tail xs)
          moves = map head $ group $ sort $ map abs gap
          ud = if length moves == 1 then moves !! 0 else moves !! 1
          history = scanl (\(x,y) g-> if g == 1 || g == -1 then (x-g,y) else (x,y-g `div` ud)) (1,1) gap
          valid = length (filter (\(x,y) -> x < 1 || y < 1 || x > ud) history) == 0

printAns :: Maybe (Int, Int) -> IO ()
printAns Nothing = putStrLn "NO"
printAns (Just (a,b)) = putStrLn "YES" >> putStrLn ((show b) ++ " " ++ (show a))

main :: IO ()
main = getLine >> getInts >>= printAns . solve


The Berland Armed Forces System consists of n ranks that are numbered using natural numbers from 1 to n, where 1 is the lowest rank and n is the highest rank.One needs exactly di years to rise from rank i to rank i + 1. Reaching a certain rank i having not reached all the previous i - 1 ranks is impossible.Vasya has just reached a new rank of a, but he dreams of holding the rank of b. Find for how many more years Vasya should serve in the army until he can finally realize his dream.

The first input line contains an integer n (2 ≤ n ≤ 100). The second line contains n - 1 integers di (1 ≤ di ≤ 100). The third input line contains two integers a and b (1 ≤ a < b ≤ n). The numbers on the lines are space-separated.

Print the single number which is the number of years that Vasya needs to rise from rank a to rank b.

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine :: IO Int
    ds <- ( map read . words ) `liftM` getLine
    [a, b] <- ( map read . words ) `liftM` getLine

    putStrLn $ show $ sum $ take (b-a) $ drop (a-1) ds

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

solve :: [Int] -> Int
solve (n:d) = let a = d !! (n - 1)
                  b = d !! n
              in solve' 1 a b d
              where solve' :: Int -> Int -> Int -> [Int] -> Int
                    solve' _ _ _ []    = 0
                    solve' i a b (d:x) | a <= i && i < b = d + solve' (i + 1) a b x
                                       | otherwise       = solve' (i + 1) a b x

main = do
    n<-readLn :: IO Int
    arr <- fmap (map (\x -> read x::Int) . words) getLine
    [a,b] <- fmap (map (\x -> read x::Int) . words) getLine
    print $solve a b arr

solve a b arr = sum $drop (a-1) (take (b-1) (arr))

main = do
    n <- getLine
    s <- getLine
    ab <- getLine
    let [a, b] = map read (words ab)
    print (f (map read (words s)) (a - 1) (b - 2))
f :: [Int] -> Int -> Int -> Int
f x a b
    | a == b = x !! a
    | a == 0 = head x + (f (tail x) a (b - 1))
    | otherwise = f (tail x) (a - 1) (b - 1)

myInput :: Int -> IO String
myInput n = return (["11", "1 2 3 4 5 6 7 8 9 10", "1 11"] !! n)

solve :: Int -> Int -> [Int] -> Int
solve _ 1 _ = 0
solve 1 m (a:as) = a + solve 1 (m - 1) as
solve n m (a:as) = solve (n - 1) (m - 1) as

main = do
    s <- getLine
    s <- getLine
    let as = map (read::(String -> Int)) (words s)
    s <- getLine
    let [a, b] = map (read::(String -> Int)) (words s)
    print (solve a b as)

solve [xs, [a, b]] = sum $ map fst $ takeWhile (f b) $ dropWhile (f a) $ zip xs [1..]
    where f v = (/=v).snd

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

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

solve :: [[Int]] -> Int
solve [_, ds, [a, b]] = sum (drop (a - 1) $ take (b - 1) ds)
solve _ = undefined

main = do
  getLine
  ds <- fmap (map read . words) getLine
  [a,b] <- fmap (map read . words) getLine
  print $ sum $ take (b-a) $ drop (a-1) ds

import Prelude
import List
import Char

main = interact q

q = func.tail.lines

func::[String]->String
func = toString.solve.map (map (toInt).words)

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[[Int]]->Int
solve a = sum$take (c2-c1)$drop c1 b
    where
      b = a!!0
      c1 = (a!!1)!!0-1
      c2 = (a!!1)!!1-1

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

main = do
    line <- getLine
    num <- getnum
    [a,b] <- getnum
    print . sum . take (b-a) . drop (a-1) $ num

main = interact f
f input = output where
  [[n],d,[a,b]] = map (map (read::String->Int)) $ map words $ lines input
  output = show $ sum $ take (b-a) $ drop (a-1) d

import Control.Applicative
import Data.List

main= do
	getLine
	s<- map read. words <$> getLine ::IO [Int]
	[a,b]<- map read. words <$> getLine ::IO [Int]
	print $ sum $ drop (a-1) $ take (b-1) s

main = do
  n <- readLn :: IO Int
  v <- fmap ((map (\x -> read x::Int)) . words) getLine
  [a,b] <- fmap ((map (\x -> read x::Int)) . words) getLine
  print $ sum $ (drop (a - 1)) $ take (b - 1) v

main = do
    n<-readLn :: IO Int
    arr <- fmap (map (\x -> read x::Int) . words) getLine
    [a,b] <- fmap (map (\x -> read x::Int) . words) getLine
    print $solve a b arr

solve a b arr = sum $take (b-1) (drop (a-1) arr)


Once Bob took a paper stripe of n squares (the height of the stripe is 1 square). In each square he wrote an integer number, possibly negative. He became interested in how many ways exist to cut this stripe into two pieces so that the sum of numbers from one piece is equal to the sum of numbers from the other piece, and each piece contains positive integer amount of squares. Would you help Bob solve this problem?

The first input line contains integer n (1 ≤ n ≤ 105) — amount of squares in the stripe. The second line contains n space-separated numbers — they are the numbers written in the squares of the stripe. These numbers are integer and do not exceed 10000 in absolute value.

Output the amount of ways to cut the stripe into two non-empty pieces so that the sum of numbers from one piece is equal to the sum of numbers from the other piece. Don't forget that it's allowed to cut the stripe along the squares' borders only.

import Data.Int
import IO

main = do
	hSetBuffering stdin $ BlockBuffering (Just 1000000)
	hGetContents stdin >>= putStrLn . show . gao . map read . tail . words where
		gao :: [Int32] -> Int
		gao a = let (s:b) = scanr1 (+) a in length $ filter (\i -> i + i == s) b

import Data.Int

main = do interact $ show . gao . map read . tail . words where
	gao :: [Int32] -> Int
	gao a = let (s:b) = scanr1 (+) a in length $ filter (\i -> i + i == s) b

import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

solve :: [Int] -> Int
solve xs  =  sum $ solve' (head xs, sum xs - head xs) $ tail xs
  where
    solve' _ []  =  []
    solve' (l, r) (x:xs)  =  (if l == r then 1 else 0) : solve' (l + x, r - x) xs

main :: IO ()
main  =  getLine >> reads >>= print . solve

countS :: [Int] -> [Int]
countS [x] = [x]
countS (x : xs) = (x + head ss) : ss
        where ss = countS xs

countWays [] _ = 0
countWays (s : ss) sum = if 2 * s == sum then ret + 1 else ret
        where ret = countWays ss sum

solve xs = countWays (drop 1 (countS xs)) (sum xs)

main = do
    n <- getLine
    line <- getLine
    let xs = map read $ words $ line
    putStrLn $ show $ solve xs

main = do getLine; getLine >>= putStrLn . show . length . gao . map read . words where
	gao a = let (s:b) = scanr1 (+) a in filter (\i -> True) b

main = do getLine; getLine >>= putStrLn . show . length . gao . map read . words where
	gao a = let b = scanr1 (+) a in filter ((==last b) . (*2)) $ init b


Bajtek, known for his unusual gifts, recently got an integer array $$$x_0, x_1, \ldots, x_{k-1}$$$.Unfortunately, after a huge array-party with his extraordinary friends, he realized that he'd lost it. After hours spent on searching for a new toy, Bajtek found on the arrays producer's website another array $$$a$$$ of length $$$n + 1$$$. As a formal description of $$$a$$$ says, $$$a_0 = 0$$$ and for all other $$$i$$$ ($$$1 \le i \le n$$$) $$$a_i = x_{(i-1)\bmod k} + a_{i-1}$$$, where $$$p \bmod q$$$ denotes the remainder of division $$$p$$$ by $$$q$$$.For example, if the $$$x = [1, 2, 3]$$$ and $$$n = 5$$$, then:  $$$a_0 = 0$$$,  $$$a_1 = x_{0\bmod 3}+a_0=x_0+0=1$$$,  $$$a_2 = x_{1\bmod 3}+a_1=x_1+1=3$$$,  $$$a_3 = x_{2\bmod 3}+a_2=x_2+3=6$$$,  $$$a_4 = x_{3\bmod 3}+a_3=x_0+6=7$$$,  $$$a_5 = x_{4\bmod 3}+a_4=x_1+7=9$$$. So, if the $$$x = [1, 2, 3]$$$ and $$$n = 5$$$, then $$$a = [0, 1, 3, 6, 7, 9]$$$.Now the boy hopes that he will be able to restore $$$x$$$ from $$$a$$$! Knowing that $$$1 \le k \le n$$$, help him and find all possible values of $$$k$$$ — possible lengths of the lost array.

The first line contains exactly one integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the length of the array $$$a$$$, excluding the element $$$a_0$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^6$$$). Note that $$$a_0$$$ is always $$$0$$$ and is not given in the input.

The first line of the output should contain one integer $$$l$$$ denoting the number of correct lengths of the lost array. The second line of the output should contain $$$l$$$ integers — possible lengths of the lost array in increasing order.

NoteIn the first example, any $$$k$$$ is suitable, since $$$a$$$ is an arithmetic progression.Possible arrays $$$x$$$:  $$$[1]$$$ $$$[1, 1]$$$ $$$[1, 1, 1]$$$ $$$[1, 1, 1, 1]$$$  $$$[1, 1, 1, 1, 1]$$$In the second example, Bajtek's array can have three or five elements.Possible arrays $$$x$$$:  $$$[1, 2, 2]$$$ $$$[1, 2, 2, 1, 2]$$$For example, $$$k = 4$$$ is bad, since it leads to $$$6 + x_0 = 8$$$ and $$$0 + x_0 = 1$$$, which is an obvious contradiction.In the third example, only $$$k = n$$$ is good.Array $$$[1, 4, -2]$$$ satisfies the requirements.Note that $$$x_i$$$ may be negative.

-- Codeforces 1043 B
import Data.List
findXs :: [Int] -> [Int]
findXs as = zipWith (-) as (0:as)

findLoop :: [Int] -> Int -> [Int]
findLoop xs len = map fst $ foldl filterHead lists xs
    where numbers = [1..len]
          lists = map (\n -> (n, cycle (take n xs))) numbers

filterHead :: [(Int, [Int])] -> Int -> [(Int, [Int])]
filterHead lists x = [(n, ls) | (n, (l:ls)) <- lists, l == x]

main :: IO ()
main = do
    num <- getLine
    list <- getLine
    let n = read num
    let xs = findXs $ map (read :: String -> Int) (words list)
    let loops = findLoop xs n
    putStrLn $ show $ length loops
    putStrLn $ unwords $ map show loops

import Data.List

modfn 0 _ _ _ as = tail $ reverse as
modfn n i  k x as = modfn (n-1) ((i+1)`mod`k) k x ((x!!i) + head as:as)

main = do
  n <- readLn :: IO Int
  as <- getLine >>= return . map (read :: String -> Int ) . words
  let x = zipWith (-) as $ 0:as
      l = filter (\a -> let b = take n $ modfn n 0 a x [0] in b == as ) [1..n]
  print $ length l
  putStrLn $ concat $ intersperse " " $ map show l

    import Data.List
    import Control.Monad
    import Data.Maybe ( fromJust )
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Char8 as BS8

    fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

    citesc_nr :: String -> Int
    citesc_nr s = read s

    check :: [Int] -> Int -> Int -> Int -> Bool
    check l i n d
                | (i+d) == n = True
                | (l!!i) == (l!!(i+d)) = check l (i+1) n d
                | otherwise = False

    brut :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
    brut _ d 0 _ list = reverse list
    brut i d n l list = brut (mod (i+1) d) d (n-1) l ((head list + l!!i ):list)

    main = do
        x <- getLine
        let n = citesc_nr x
        a <- fast_read_Int
        let b = zipWith (-) a $ 0:a
        let l = filter (\i -> brut 0 i n b [0] == (0:a) ) [1..n]
        --print b
        --print $ brut 0 1 n b [0]
        print $ length l
        putStr $ join $ intersperse " " $ map show l

    {--
    main = do
        n <- readLn :: IO Int
        a <- fast_read_Int
        let b = zipWith (-) a $ 0:a
        let l = filter (\i -> check b 0 n i == True ) [1..n]
        print $ length l
        putStrLn $ join $ intersperse " " $ map show l
    --}

import Data.List
import Control.Monad
import Data.Maybe ( fromJust )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]

citesc_nr :: String -> Int
citesc_nr s = read s

check :: [Int] -> Int -> Int -> Int -> Bool
check l i n d
            | (i+d) == n = True
            | (l!!i) == (l!!(i+d)) = check l (i+1) n d
            | otherwise = False

brut :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
brut _ d 0 _ list = reverse list
brut i d n l list = brut (mod (i+1) d) d (n-1) l ((head list + list!!i ):list)

main = do
    x <- getLine
    let n = citesc_nr x
    a <- fast_read_Int
    let b = zipWith (-) a $ 0:a
    let l = filter (\i -> brut 0 i n b [0] == 0:b ) [1..n]
    putStr $ join $ intersperse " " $ map show l

{--
main = do
    n <- readLn :: IO Int
    a <- fast_read_Int
    let b = zipWith (-) a $ 0:a
    let l = filter (\i -> check b 0 n i == True ) [1..n]
    print $ length l
    putStrLn $ join $ intersperse " " $ map show l
--}


Polycarp is practicing his problem solving skill. He has a list of $$$n$$$ problems with difficulties $$$a_1, a_2, \dots, a_n$$$, respectively. His plan is to practice for exactly $$$k$$$ days. Each day he has to solve at least one problem from his list. Polycarp solves the problems in the order they are given in his list, he cannot skip any problem from his list. He has to solve all $$$n$$$ problems in exactly $$$k$$$ days.Thus, each day Polycarp solves a contiguous sequence of (consecutive) problems from the start of the list. He can't skip problems or solve them multiple times. As a result, in $$$k$$$ days he will solve all the $$$n$$$ problems.The profit of the $$$j$$$-th day of Polycarp's practice is the maximum among all the difficulties of problems Polycarp solves during the $$$j$$$-th day (i.e. if he solves problems with indices from $$$l$$$ to $$$r$$$ during a day, then the profit of the day is $$$\max\limits_{l \le i \le r}a_i$$$). The total profit of his practice is the sum of the profits over all $$$k$$$ days of his practice.You want to help Polycarp to get the maximum possible total profit over all valid ways to solve problems. Your task is to distribute all $$$n$$$ problems between $$$k$$$ days satisfying the conditions above in such a way, that the total profit is maximum.For example, if $$$n = 8, k = 3$$$ and $$$a = [5, 4, 2, 6, 5, 1, 9, 2]$$$, one of the possible distributions with maximum total profit is: $$$[5, 4, 2], [6, 5], [1, 9, 2]$$$. Here the total profit equals $$$5 + 6 + 9 = 20$$$.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2000$$$) — the number of problems and the number of days, respectively. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 2000$$$) — difficulties of problems in Polycarp's list, in the order they are placed in the list (i.e. in the order Polycarp will solve them).

In the first line of the output print the maximum possible total profit. In the second line print exactly $$$k$$$ positive integers $$$t_1, t_2, \dots, t_k$$$ ($$$t_1 + t_2 + \dots + t_k$$$ must equal $$$n$$$), where $$$t_j$$$ means the number of problems Polycarp will solve during the $$$j$$$-th day in order to achieve the maximum possible total profit of his practice. If there are many possible answers, you may print any of them.

NoteThe first example is described in the problem statement.In the second example there is only one possible distribution.In the third example the best answer is to distribute problems in the following way: $$$[1, 2000], [2000, 2]$$$. The total profit of this distribution is $$$2000 + 2000 = 4000$$$.

import Data.List
import Data.Functor

main = do
        [n, k] <- map read . words <$> getLine :: IO [Int]
        xs    <- map read . words <$> getLine :: IO [Int]
        let bestK = sortBy (\x y -> compare (snd x) (snd y)) $ take k . sortBy (flip compare) $ zip xs [0..]
        print . sum $ map fst bestK
        let ((_, x):gosho) = zip (map snd bestK) (tail $ map snd bestK ++ [n])
        putStrLn . unwords $  map (\(a, b) -> show $ b - a) ((0, x):gosho)


Recently, on a programming lesson little Petya showed how quickly he can create files and folders on the computer. But he got soon fed up with this activity, and he decided to do a much more useful thing. He decided to calculate what folder contains most subfolders (including nested folders, nested folders of nested folders, and so on) and what folder contains most files (including the files in the subfolders).More formally, the subfolders of the folder are all its directly nested folders and the subfolders of these nested folders. The given folder is not considered the subfolder of itself. A file is regarded as lying in a folder, if and only if it either lies directly in this folder, or lies in some subfolder of the folder.For a better understanding of how to count subfolders and files for calculating the answer, see notes and answers to the samples.You are given a few files that Petya has managed to create. The path to each file looks as follows:diskName:\folder1\folder2\...\ foldern\fileName  diskName is single capital letter from the set {C,D,E,F,G}. folder1, ..., foldern are folder names. Each folder name is nonempty sequence of lowercase Latin letters and digits from 0 to 9. (n ≥ 1) fileName is a file name in the form of name.extension, where the name and the extension are nonempty sequences of lowercase Latin letters and digits from 0 to 9. It is also known that there is no file whose path looks like diskName:\fileName. That is, each file is stored in some folder, but there are no files directly in the root. Also let us assume that the disk root is not a folder.Help Petya to find the largest number of subfolders, which can be in some folder, and the largest number of files that can be in some folder, counting all its subfolders.

Each line of input data contains the description of one file path. The length of each line does not exceed 100, and overall there are no more than 100 lines. It is guaranteed, that all the paths are correct and meet the above rules. It is also guaranteed, that there are no two completely equal lines. That is, each file is described exactly once. There is at least one line in the input data.

Print two space-separated numbers. The first one is the maximal number of possible subfolders in a folder (including nested folders, nested folders of nested folders, and so on). The second one is the maximal number of files in a folder (including nested files in subfolders). Note that the disks are not regarded as folders.

C:
\
folder1
\
folder2
\
folder3
\
file1.txt
C:
\
folder1
\
folder2
\
folder4
\
file1.txt
D:
\
folder1
\
file1.txt

C:
\
file
\
file
\
file
\
file
\
file.txt
C:
\
file
\
file
\
file
\
file2
\
file.txt

NoteIn the first sample we have one folder on the "C" disk. It has no subfolders, which is why the first number in the answer is 0. But this folder contains one file, so the second number of the answer is 1.In the second sample we have several different folders. Consider the "folder1" folder on the "C" disk. This folder directly contains one folder, "folder2". The "folder2" folder contains two more folders — "folder3" and "folder4". Thus, the "folder1" folder on the "C" drive has exactly 3 subfolders. Also this folder contains two files, even though they do not lie directly in the folder, but they are located in subfolders of "folder1".In the third example we see that the names of some folders and some subfolders are identical. Consider the "file" folder, which lies directly on the "C" disk. That folder contains another "file" folder, which in turn contains another "file" folder, which contains two more folders, "file" and "file2". Thus, the "file" folder, which lies directly on the "C" disk, contains 4 subfolders.

import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set

split l =
    let (first, second) = break (\x -> x == '\\') l in
    case second of
        h:t -> first : (split t)
        _   -> [first]

toPairs [] = []
toPairs (h:t)
    | null t = []
    | otherwise = (h, head t) : (toPairs t)

upd k v m =
    case Map.lookup k m of
        Just s  -> Map.update (\x -> Just (Set.insert v s)) k m
        Nothing -> Map.insert k (Set.singleton v) m

dfs1 m k =
    case Map.lookup k m of
        Just s  -> foldl' (+) 1 (map (dfs1 m) (Set.elems s))
        Nothing -> 0

dfs2 m k =
    case Map.lookup k m of
        Just s  -> foldl' (+) 0 (map (dfs2 m) (Set.elems s))
        Nothing -> 1

solve input =
    let list = concat (map (toPairs.drop 1.inits.split) (map (\x -> "/\\" ++ x) (lines input))) in
    let mp = foldl' (\m (first, second) -> upd first second m) (Map.empty) list in
    case Map.lookup ["/"] mp of
        Just s  -> let disks = Set.elems s in
            let rootFolders = concat (map (\x -> case Map.lookup x mp of Just y -> Set.elems y; Nothing -> []) disks) in
            let one = show (foldl' (max) 0 (map (\x -> (dfs1 mp x) - 1) rootFolders)) in
            let two = show (foldl' (max) 0 (map (dfs2 mp) rootFolders)) in
            one ++ " " ++ two
        Nothing -> "Nothing"

main = interact(solve)

import qualified Data.Set as Set
import qualified Data.List as List
splitPath s = let
    sP (r:rs) (s:ss)
        | s == '\\' = sP ([]:r:rs) ss
        | otherwise = sP ((s:r):rs) ss
    sP r [] = r in
    map reverse $ reverse $ sP [reverse $ take 3 s] $ drop 3 s
f (dirs, files, maxdirs, maxfiles, curDir) l@((d:ds):ls)
    | curDir /= d = f (Set.empty, 0, max maxdirs (Set.size dirs),
            max maxfiles files, d) l
    | otherwise = f (f1 dirs [] ds, files+1, maxdirs, maxfiles, curDir) ls
f (dirs, files, maxdirs, maxfiles, curDir) [] =
            (max maxdirs (Set.size dirs), max maxfiles files)
f1 dirs _ [_] = dirs
f1 dirs h (d:ds) = f1 (Set.insert (d:h) dirs) (d:h) ds

main = do
    l <- (map splitPath . List.sort . lines) `fmap` getContents
    let (maxdirs, maxfiles) = f (Set.empty, 0, 0, 0, "") l
    putStrLn $ unwords $ map show [maxdirs, maxfiles]

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              , "abc\\def\\ij"
              , "abc\\jk\\lm","de"
              ]
pathList1   = [ "C:\\folder1\\file1.txt" ]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]

pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]
pathList4 = [ "F:\\g\\a\\f\\i\\k\\i\\f\\f\\f\\h\\c\\c\\f\\i\\c\\f\\b\\b\\d\\j\\a\\e\\g\\d\\d\\f\\c\\k\\i\\f\\g\\f\\e\\d\\b\\b\\e\\f\\g\\h\\b\\f\\h\\i\\chv.27"
            ,"C:\\i\\f\\j\\h\\g\\f\\i\\h\\c\\b\\c\\e\\a\\f\\k\\h\\b\\j\\g\\j\\b\\f\\j\\a\\b\\k\\d\\d\\a\\d\\b\\f\\c\\d\\h\\e\\j\\f\\f\\e\\d\\h\\i\\k\\x.vq"
            ,"E:\\i\\d\\h\\c\\a\\g\\d\\h\\i\\e\\i\\a\\e\\c\\d\\a\\a\\i\\i\\e\\e\\b\\g\\g\\d\\g\\j\\b\\..."
            ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map length) . (map $ filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map f . map split . sort)

f (x1:x2:xs) = (x1++x2) :xs

--maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)
maxSubDirNum = maximum . (map length ) . (map tail) . (map (filter (not . elem '.'))) .  (map T.flatten . map buildDir . groupPath . map f . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))
buildTree = (map T.flatten . map buildDir . groupPath . map f . map split . sort)

maxFileNum = (maximum) . (map length) . (map $ filter (elem '.')) . buildTree

f (x1:x2:xs) = (x1++x2) :xs

maxSubDirNum = maximum . (map length ) . (map tail) . (map (filter (not . elem '.'))) .  buildTree

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))
pathList    = ["abc\\def","abc\\def\\gh","abc\\def\\ij","abc\\jk\\lm","de"]

main :: IO ()
main = do { ns <- lines <$> getContents
          ; print ((map buildDir . groupPath . map split . sort) ns)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              , "abc\\def\\ij"
              , "abc\\jk\\lm","de"
              ]
pathList1   = [ "C:\\folder1\\file1.txt" ]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]

pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]
pathList4 = [ "F:\\g\\a\\f\\i\\k\\i\\f\\f\\f\\h\\c\\c\\f\\i\\c\\f\\b\\b\\d\\j\\a\\e\\g\\d\\d\\f\\c\\k\\i\\f\\g\\f\\e\\d\\b\\b\\e\\f\\g\\h\\b\\f\\h\\i\\chv.27"
            ,"C:\\i\\f\\j\\h\\g\\f\\i\\h\\c\\b\\c\\e\\a\\f\\k\\h\\b\\j\\g\\j\\b\\f\\j\\a\\b\\k\\d\\d\\a\\d\\b\\f\\c\\d\\h\\e\\j\\f\\f\\e\\d\\h\\i\\k\\x.vq"
            ,"E:\\i\\d\\h\\c\\a\\g\\d\\h\\i\\e\\i\\a\\e\\c\\d\\a\\a\\i\\i\\e\\e\\b\\g\\g\\d\\g\\j\\b\\..."
            ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

--maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)
maxSubDirNum = maximum . (map length ).  (map (filter (not . elem '.'))) .  (map T.flatten . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum-2) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              ,"abc\\def\\ij"
              ,"abc\\jk\\lm","de"
              ]
pathList1   = ["C:\\folder1\\file1.txt"]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]
pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

maxSubDirNum = sum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" dirNum fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              , "abc\\def\\ij"
              , "abc\\jk\\lm","de"
              ]
pathList1   = [ "C:\\folder1\\file1.txt" ]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]

pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]
pathList4 = [ "F:\\g\\a\\f\\i\\k\\i\\f\\f\\f\\h\\c\\c\\f\\i\\c\\f\\b\\b\\d\\j\\a\\e\\g\\d\\d\\f\\c\\k\\i\\f\\g\\f\\e\\d\\b\\b\\e\\f\\g\\h\\b\\f\\h\\i\\chv.27"
            ,"C:\\i\\f\\j\\h\\g\\f\\i\\h\\c\\b\\c\\e\\a\\f\\k\\h\\b\\j\\g\\j\\b\\f\\j\\a\\b\\k\\d\\d\\a\\d\\b\\f\\c\\d\\h\\e\\j\\f\\f\\e\\d\\h\\i\\k\\x.vq"
            ,"E:\\i\\d\\h\\c\\a\\g\\d\\h\\i\\e\\i\\a\\e\\c\\d\\a\\a\\i\\i\\e\\e\\b\\g\\g\\d\\g\\j\\b\\..."
            ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

--maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)
maxSubDirNum = n
    where n = maximum . (map length) .  (map  (concatMap $(filter $ not . null) . (filter (not . elem '.'))) ) .  (map T.levels . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum-2) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Data.Maybe
-- import Data.Tree
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

main :: IO ()
main = do { ns <- lines <$> getContents
          ; print  (map (f . split) ns)
          }

module Main where
import Control.Applicative
import Data.List
import Data.Maybe

main :: IO ()
main = do { ns <- lines <$> getContents
          ; print ns
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              , "abc\\def\\ij"
              , "abc\\jk\\lm","de"
              ]
pathList1   = [ "C:\\folder1\\file1.txt" ]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]

pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]
pathList4 = [ "F:\\g\\a\\f\\i\\k\\i\\f\\f\\f\\h\\c\\c\\f\\i\\c\\f\\b\\b\\d\\j\\a\\e\\g\\d\\d\\f\\c\\k\\i\\f\\g\\f\\e\\d\\b\\b\\e\\f\\g\\h\\b\\f\\h\\i\\chv.27"
            ,"C:\\i\\f\\j\\h\\g\\f\\i\\h\\c\\b\\c\\e\\a\\f\\k\\h\\b\\j\\g\\j\\b\\f\\j\\a\\b\\k\\d\\d\\a\\d\\b\\f\\c\\d\\h\\e\\j\\f\\f\\e\\d\\h\\i\\k\\x.vq"
            ,"E:\\i\\d\\h\\c\\a\\g\\d\\h\\i\\e\\i\\a\\e\\c\\d\\a\\a\\i\\i\\e\\e\\b\\g\\g\\d\\g\\j\\b\\..."
            ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

--maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)
maxSubDirNum = maximum . (map length ).  (map $ tail . tail) . (map (filter (not . elem '.'))) .  (map T.flatten . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              , "abc\\def\\ij"
              , "abc\\jk\\lm","de"
              ]
pathList1   = [ "C:\\folder1\\file1.txt" ]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]

pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]
pathList4 = [ "F:\\g\\a\\f\\i\\k\\i\\f\\f\\f\\h\\c\\c\\f\\i\\c\\f\\b\\b\\d\\j\\a\\e\\g\\d\\d\\f\\c\\k\\i\\f\\g\\f\\e\\d\\b\\b\\e\\f\\g\\h\\b\\f\\h\\i\\chv.27"
            ,"C:\\i\\f\\j\\h\\g\\f\\i\\h\\c\\b\\c\\e\\a\\f\\k\\h\\b\\j\\g\\j\\b\\f\\j\\a\\b\\k\\d\\d\\a\\d\\b\\f\\c\\d\\h\\e\\j\\f\\f\\e\\d\\h\\i\\k\\x.vq"
            ,"E:\\i\\d\\h\\c\\a\\g\\d\\h\\i\\e\\i\\a\\e\\c\\d\\a\\a\\i\\i\\e\\e\\b\\g\\g\\d\\g\\j\\b\\..."
            ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

--maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)
maxSubDirNum = maximum . (map length ).  (map $ tail . tail) . (map (filter (not . elem '.'))) .  (map T.flatten . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" (dirNum-2) fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf

import Data.Function (on)
import Data.Maybe
import qualified Data.Tree  as T
import qualified Data.Map as M

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

f xs = ((init xs),(last xs))
g (x,a) (ys,bs) = (([x] `union` ys), ([a] `union` bs))

buildDir = T.unfoldTree phi
    where phi (n,ps) = (delete '\\' n, groupPath $ filter (not . null) ps)

-- binapp o f x y = f x `o` f y
groupPath   = map grouping . groupBy (on eqpath head)
grouping ss = (head . head $ ss, map tail ss)
eqpath      = on (==) (fst . (break ('\\'==)))

pathList    = [ "abc\\def"
              , "abc\\def\\gh"
              ,"abc\\def\\ij"
              ,"abc\\jk\\lm","de"
              ]
pathList1   = ["C:\\folder1\\file1.txt"]
pathList2   = [ "C:\\folder1\\folder2\\folder3\\file1.txt"
              , "C:\\folder1\\folder2\\folder4\\file1.txt"
              , "D:\\folder1\\file1.txt"
              ]
pathList3   = [ "C:\\file\\file\\file\\file\\file.txt"
              , "C:\\file\\file\\file\\file2\\file.txt"
              ]

z = map (filter (not . elem '.'))

maxFileNum = (maximum) . (map $ length . filter (elem '.')) . (map T.flatten . map buildDir . groupPath . map split . sort)

maxSubDirNum = maximum . (map $ sum . map length) . (map  (map (filter (not . elem '.')) . tail . tail) .map T.levels . map buildDir . groupPath . map split . sort)

main :: IO ()
main = do { ns <- lines <$> getContents
          ; let dirNum = maxSubDirNum ns in
            let fileNum = maxFileNum ns in
            (printf "%d %d\n" dirNum fileNum)
          }

module Main where
import Control.Applicative
import Data.List
import Data.Maybe

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (=='\\')

main :: IO ()
main = do { ns <- lines <$> getContents
          ; print (map split ns)
          }


There are n problems prepared for the next Codeforces round. They are arranged in ascending order by their difficulty, and no two problems have the same difficulty. Moreover, there are m pairs of similar problems. Authors want to split problems between two division according to the following rules:   Problemset of each division should be non-empty.  Each problem should be used in exactly one division (yes, it is unusual requirement).  Each problem used in division 1 should be harder than any problem used in division 2.  If two problems are similar, they should be used in different divisions. Your goal is count the number of ways to split problem between two divisions and satisfy all the rules. Two ways to split problems are considered to be different if there is at least one problem that belongs to division 1 in one of them and to division 2 in the other.Note, that the relation of similarity is not transitive. That is, if problem i is similar to problem j and problem j is similar to problem k, it doesn't follow that i is similar to k.

The first line of the input contains two integers n and m (2 ≤ n ≤ 100 000, 0 ≤ m ≤ 100 000) — the number of problems prepared for the round and the number of pairs of similar problems, respectively. Each of the following m lines contains a pair of similar problems ui and vi (1 ≤ ui, vi ≤ n, ui ≠ vi). It's guaranteed, that no pair of problems meets twice in the input.

Print one integer — the number of ways to split problems in two divisions.

NoteIn the first sample, problems 1 and 2 should be used in division 2, while problems 4 and 5 in division 1. Problem 3 may be used either in division 1 or in division 2.In the second sample, all pairs of problems are similar and there is no way to split problem between two divisions without breaking any rules.Third sample reminds you that the similarity relation is not transitive. Problem 3 is similar to both 1 and 2, but 1 is not similar to 2, so they may be used together.

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

solve :: [Int] -> Int
solve (n:m:s) = let (a, b) = range s 1 n
                in max 0 (b - a)

range :: [Int] -> Int -> Int -> (Int, Int)
range []      a b = (a, b)
range (x:y:s) a b | x > y = range (y:x:s) a b
                  | otherwise = range s (max a x) (min b y)


This is the easy version of the problem. The difference between the versions is the constraint on $$$n$$$ and the required number of operations. You can make hacks only if all versions of the problem are solved.There are two binary strings $$$a$$$ and $$$b$$$ of length $$$n$$$ (a binary string is a string consisting of symbols $$$0$$$ and $$$1$$$). In an operation, you select a prefix of $$$a$$$, and simultaneously invert the bits in the prefix ($$$0$$$ changes to $$$1$$$ and $$$1$$$ changes to $$$0$$$) and reverse the order of the bits in the prefix.For example, if $$$a=001011$$$ and you select the prefix of length $$$3$$$, it becomes $$$011011$$$. Then if you select the entire string, it becomes $$$001001$$$.Your task is to transform the string $$$a$$$ into $$$b$$$ in at most $$$3n$$$ operations. It can be proved that it is always possible.

The first line contains a single integer $$$t$$$ ($$$1\le t\le 1000$$$)  — the number of test cases. Next $$$3t$$$ lines contain descriptions of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 1000$$$)  — the length of the binary strings. The next two lines contain two binary strings $$$a$$$ and $$$b$$$ of length $$$n$$$. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$1000$$$.

For each test case, output an integer $$$k$$$ ($$$0\le k\le 3n$$$), followed by $$$k$$$ integers $$$p_1,\ldots,p_k$$$ ($$$1\le p_i\le n$$$). Here $$$k$$$ is the number of operations you use and $$$p_i$$$ is the length of the prefix you flip in the $$$i$$$-th operation.

NoteIn the first test case, we have $$$01\to 11\to 00\to 10$$$.In the second test case, we have $$$01011\to 00101\to 11101\to 01000\to 10100\to 00100\to 11100$$$.In the third test case, the strings are already the same. Another solution is to flip the prefix of length $$$2$$$, which will leave $$$a$$$ unchanged.

import Data.List
import Control.Monad

solve :: (String, String) -> [Int]
solve (xs, ts) = length sol : sol
  where
    sol = go xs ts []
    go [] [] ps = reverse ps
    go xs ts ps
      | x == t = go (init xs) (init ts) ps
      | head xs /= t = go (init $ flipB xs) (init ts) (n : ps)
      | otherwise = go xs' ts (m:ps)
      where
        x = last xs
        t = last ts

        n = length xs

        xs' = flipB start ++ end
        m = length start
        (start, end) = (reverse start', reverse end')
        (end', start') = span (== bitflip t) (reverse xs)

bitflip :: Char -> Char
bitflip '0' = '1'
bitflip '1' = '0'

flipB :: String -> String
flipB = reverse . map bitflip

flipB' :: String -> Int -> String
flipB' xs i = flipB start ++ end
  where
    (start, end) = splitAt i xs

printS :: [Int] -> IO ()
printS = putStrLn . unwords . map show

getTest :: IO (String, String)
getTest = do
  _ <- getLine
  xs <- getLine
  ys <- getLine
  return (xs, ys)

main :: IO ()
main = do
  t <- read <$> getLine
  tests <- replicateM t getTest
  mapM_ (printS . solve) tests


We all know that a superhero can transform to certain other superheroes. But not all Superheroes can transform to any other superhero. A superhero with name $$$s$$$ can transform to another superhero with name $$$t$$$ if $$$s$$$ can be made equal to $$$t$$$ by changing any vowel in $$$s$$$ to any other vowel and any consonant in $$$s$$$ to any other consonant. Multiple changes can be made.In this problem, we consider the letters 'a', 'e', 'i', 'o' and 'u' to be vowels and all the other letters to be consonants.Given the names of two superheroes, determine if the superhero with name $$$s$$$ can be transformed to the Superhero with name $$$t$$$.

The first line contains the string $$$s$$$ having length between $$$1$$$ and $$$1000$$$, inclusive. The second line contains the string $$$t$$$ having length between $$$1$$$ and $$$1000$$$, inclusive. Both strings $$$s$$$ and $$$t$$$ are guaranteed to be different and consist of lowercase English letters only.

Output "Yes" (without quotes) if the superhero with name $$$s$$$ can be transformed to the superhero with name $$$t$$$ and "No" (without quotes) otherwise. You can print each letter in any case (upper or lower).

NoteIn the first sample, since both 'a' and 'u' are vowels, it is possible to convert string $$$s$$$ to $$$t$$$.In the third sample, 'k' is a consonant, whereas 'a' is a vowel, so it is not possible to convert string $$$s$$$ to $$$t$$$.

import qualified Data.ByteString.Char8 as B
import Data.List

trim = B.filter (/='\r')
aeiou = "aeiou"
aeiou' = ['a'..'z'] \\ aeiou
main = ((\x y ->
    if  (B.length x == B.length y) && (all (== True) $
            B.zipWith
                (\x y ->
                    (x `elem` aeiou  && y `elem` aeiou) ||
                    (x `elem` aeiou' && y `elem` aeiou')
                ) x y )
        then "YES"
        else "NO"
    ) <$> (trim <$> B.getLine) <*> (trim <$> B.getLine) ) >>= putStrLn

main = interact $ format . solve . lines
solve [a,b] = map vowel a == map vowel b
vowel = (`elem` "aeiou")
format True = "Yes"
format False= "No"

import qualified Data.ByteString.Char8 as B
import Data.List

trim = B.filter (/=' ')
aeiou = "aeiou"
aeiou' = ['a'..'z']\\aeiou
main = ((\x y ->
    if all (== (B.length x == B.length y)) $ B.zipWith (\x y -> (x `elem` aeiou && y `elem` aeiou) || (x `elem` aeiou' && y `elem` aeiou')) x y
        then "YES"
        else "NO"
    ) <$> (trim <$> B.getLine) <*> (trim <$> B.getLine) ) >>= putStrLn

import qualified Data.ByteString.Char8 as B
import Data.List

aeiou = "aeiou"
aeiou' = ['a'..'z']\\aeiou
main = ((\x y ->
    if all (== (B.length x == B.length y)) $ B.zipWith (\x y -> (x `elem` aeiou && y `elem` aeiou) || (x `elem` aeiou' && y `elem` aeiou')) x y
        then "YES"
        else "NO"
    ) <$> B.getLine <*> B.getLine ) >>= putStrLn