Find an n × n matrix with different numbers from 1 to n2, so the sum in each row, column and both main diagonals are odd.

The only line contains odd integer n (1 ≤ n ≤ 49).

Print n lines with n integers. All the integers should be different and from 1 to n2. The sum in each row, column and both main diagonals should be odd.

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + y * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

main = interact $ z.y.f.read

y ans = map (\x -> (map show x)) ans
z ans = unlines (map (\x -> unwords x) ans)

ev = [2, 4 ..]
od = [1, 3 ..]
f :: Int -> [[Int]]
f x = (g x x ev od (x `div` 2) 1 [])

g :: Int -> Int -> [Int] -> [Int] -> Int -> Int -> [[Int]] -> [[Int]]
g n 0 tempe tempo st md ans = ans
g n rw tempe tempo st md ans
  | rw > ((n `div` 2) + 1) = g n
                             (rw-1)
                             (drop (2*st) tempe)
                             (drop md tempo)
                             (st-1)
                             (md+2)
                             (((take st tempe) ++ (take md tempo) ++ (take st (drop st tempe))):ans)
  | otherwise = g n
                  (rw-1)
                  (drop (2*st) tempe)
                  (drop md tempo)
                  (st+1)
                  (md-2)
                  (((take st tempe) ++ (take md tempo) ++ (take st (drop st tempe))):ans)

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareodd size) size size

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + (y - 1) * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

--makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
--makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> show (f x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

magisquareoddn :: Int -> Int -> Int -> Int
magisquareoddn size x y
	| size `mod` 2 == 0 = -1 -- undefied for even square
	| size == 1 = 1 -- the one in center
	| x > 0 && x < (size - 1) && y > 0 && y < (size - 1) = magisquareoddn (size - 2) (x - 1) (y - 1)
	| x == 0 && y == 0 = startInd + 1 -- even values in corners
	| x == 0 && y == (size - 1) = startInd + 3
	| x == (size - 1) && y == 0 = startInd + 5
	| x == (size - 1) && y == (size - 1) = startInd + 7
	| y == 0 = startInd + x * 2
	| y == (size - 1) = startInd + x * 2 + (size - 2) * 2
	| x == 0 && y < (size - 2) = startInd + 7 + (y - 1) * 2
	| x == 0 && y == (size - 2) = startInd + (size - 2) * 4 + 2
	| x == (size - 1) && y < (size - 2) = startInd + 7 + (y - 1) * 2 + (size - 2) * 2
	| x == (size - 1) && y == (size - 2) = startInd + (size - 2) * 4 + 4
	where 	startInd = (size - 2) * (size - 2)

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareoddn size) size size
	--print foldl [magisquareodd size x 0 | x <- [0 .. size - 1]]

import Data.List (intercalate)

maxLineLength :: (Int -> Int) -> Int -> Int -> Int
maxLineLength f from to = maximum (map (intLen . f) [from .. to])

maxLineLengthShort :: (Int -> Int) -> Int -> Int
maxLineLengthShort f size = maxLineLength f 0 $ size - 1

padToLengthLeft :: a -> [a] -> Int -> [a]
padToLengthLeft padding list n = (replicate (n - length list) padding) ++ list

intLen :: Int -> Int
intLen val = (length . show) val

makeLineString :: (Int -> Int) -> (Int -> Int) -> Int -> Int -> String
makeLineString f mdf x1 x2 = intercalate " " $ map (\x -> padToLengthLeft ' ' (show (f x)) (mdf x)) [x1..x2]

makeMatrString :: (Int -> Int -> Int) -> Int -> Int -> Int -> Int -> String
makeMatrString f x1 x2 y1 y2 = intercalate "\n" $ map (\y -> makeLineString (\x -> f x y) (\x -> maxLineLength (f x) y1 y2) x1 x2) [y1..y2]

makeMatrStringShort :: (Int -> Int -> Int) -> Int -> Int -> String
makeMatrStringShort f width height = makeMatrString f 0 (width - 1) 0 (height - 1)

magisquareodd :: Int -> Int -> Int -> Int
magisquareodd size x y
	| size `mod` 2 == 0 = -1 -- fuck this is not odd
	| otherwise = magisquareoddhelp size x y 1

magisquareoddhelp :: Int -> Int -> Int -> Int -> Int
magisquareoddhelp size x y start
	| size == 1 = start -- the square of size 1 is trivial
	| x > 0 && y > 0 = magisquareoddhelp (size - 1) (x - 1) (y - 1) (start + 2 * size - 1)
	| x == 0 && y == 0 = start
	| x > 0 = start + x * 2 + md - 1
	| y > 0 = start + y * 2 - md
	where 	md = size `mod` 2

main :: IO()
main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        let size = firstVals !! 0
	putStrLn $ makeMatrStringShort (magisquareodd size) size size

import qualified Data.Char as Char

main = interact $ z.y.f.read

y ans = map (\x -> (map show x)) ans
z ans = unlines (map (\x -> unwords x) ans)

h n [] fans = fans
h n ans fans = h n (drop n ans) ((take n ans):fans)

f x = h x (g x x x 2 1 [] ) []
g n 0 cl tempe tempo ans = ans
g n rw 0 tempe tempo ans = g n (rw-1) n tempe tempo ans
g n rw cl tempe tempo ans
  | rw == ((n `div` 2) + 1) = g n rw (cl-1) tempe (tempo+2) (tempo:ans)
  | (rw == n || rw == 1) && cl == ((n `div` 2) + 1) = g n rw (cl-1) tempe (tempo+2) (tempo:ans)
  | (rw == n || rw == 1) && cl /= ((n `div` 2) + 1) = g n rw (cl-1) (2+tempe) tempo (tempe:ans)
  | (cl == n || cl == 1) = g n rw (cl-1) (tempe+2) tempo (tempe:ans)
  | otherwise = g n rw (cl-1) tempe (tempo+2) (tempo:ans)


Arkady invited Anna for a dinner to a sushi restaurant. The restaurant is a bit unusual: it offers $$$n$$$ pieces of sushi aligned in a row, and a customer has to choose a continuous subsegment of these sushi to buy.The pieces of sushi are of two types: either with tuna or with eel. Let's denote the type of the $$$i$$$-th from the left sushi as $$$t_i$$$, where $$$t_i = 1$$$ means it is with tuna, and $$$t_i = 2$$$ means it is with eel.Arkady does not like tuna, Anna does not like eel. Arkady wants to choose such a continuous subsegment of sushi that it has equal number of sushi of each type and each half of the subsegment has only sushi of one type. For example, subsegment $$$[2, 2, 2, 1, 1, 1]$$$ is valid, but subsegment $$$[1, 2, 1, 2, 1, 2]$$$ is not, because both halves contain both types of sushi.Find the length of the longest continuous subsegment of sushi Arkady can buy.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 100\,000$$$) — the number of pieces of sushi. The second line contains $$$n$$$ integers $$$t_1$$$, $$$t_2$$$, ..., $$$t_n$$$ ($$$t_i = 1$$$, denoting a sushi with tuna or $$$t_i = 2$$$, denoting a sushi with eel), representing the types of sushi from left to right. It is guaranteed that there is at least one piece of sushi of each type. Note that it means that there is at least one valid continuous segment.

Print a single integer — the maximum length of a valid continuous segment.

NoteIn the first example Arkady can choose the subsegment $$$[2, 2, 1, 1]$$$ or the subsegment $$$[1, 1, 2, 2]$$$ with length $$$4$$$.In the second example there is no way but to choose one of the subsegments $$$[2, 1]$$$ or $$$[1, 2]$$$ with length $$$2$$$.In the third example Arkady's best choice is the subsegment $$$[1, 1, 1, 2, 2, 2]$$$.

import Data.List
import Control.Monad
main :: IO ()
main = do
    _ <- getLine
    routine

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

solve :: [Int] -> Int
solve xs = (2 *) $ maximum $ zipWith min g (tail g)
  where
    g = ((map length).group) xs

module Main where
import Data.List

main = do
    getLine
    ts <- map length . group . filter (/= ' ') <$> getLine
    print $ (2*) $ maximum $ zipWith (\x y -> min x y) ts $ tail ts

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  xs <- map (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  print $ 2 * query xs

query :: [Bool] -> Int
query (x:xs) = loop 0 x 1 0 xs
  where
    loop !maxi !prev !prevlen !prevprevlen (x:xs)
      | x == prev = loop maxi x (prevlen +1) prevprevlen xs
      | otherwise = loop (max maxi (min prevlen prevprevlen)) x 1 prevlen xs
    loop !maxi !prev !prevlen !prevprevlen []
      = max maxi $ min prevlen prevprevlen

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

rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

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

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

import Control.Monad
import Data.List
import Data.Maybe
-- import Data.List.HT (mapAdjacent)
import qualified Data.ByteString.Char8 as B

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

mapAdjacent f = map (uncurry f) . (zip <*> tail)

solve :: [Int] -> Int
solve = (*2)
      . maximum
      . mapAdjacent min
      . map length
      . group

main :: IO ()
main = do
    _ <- getLine
    v <- readInts
    print $ solve v

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

process :: [Int] -> Int
process sushis = maximum combinations where
    combinations = combine . map length . group $ sushis
    combine (x:y:xs) = 2 * min x y : combine (y:xs)
    combine _        = []

main = do
    n <- getInt
    sushis <- getInts
    print $ process sushis

import Data.List
main = interact $ show . (*2) . process . map read . tail . words
process :: [Int] -> Int
process ns = maximum $ zipWith min ll $ tail ll
  where ll = map length $ group ns


You have a permutation: an array $$$a = [a_1, a_2, \ldots, a_n]$$$ of distinct integers from $$$1$$$ to $$$n$$$. The length of the permutation $$$n$$$ is odd.Consider the following algorithm of sorting the permutation in increasing order.A helper procedure of the algorithm, $$$f(i)$$$, takes a single argument $$$i$$$ ($$$1 \le i \le n-1$$$) and does the following. If $$$a_i > a_{i+1}$$$, the values of $$$a_i$$$ and $$$a_{i+1}$$$ are exchanged. Otherwise, the permutation doesn't change.The algorithm consists of iterations, numbered with consecutive integers starting with $$$1$$$. On the $$$i$$$-th iteration, the algorithm does the following:   if $$$i$$$ is odd, call $$$f(1), f(3), \ldots, f(n - 2)$$$;  if $$$i$$$ is even, call $$$f(2), f(4), \ldots, f(n - 1)$$$. It can be proven that after a finite number of iterations the permutation will be sorted in increasing order.After how many iterations will this happen for the first time?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 999$$$; $$$n$$$ is odd) — the length of the permutation. The second line contains $$$n$$$ distinct integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$) — the permutation itself.  It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$999$$$.

For each test case print the number of iterations after which the permutation will become sorted in increasing order for the first time. If the given permutation is already sorted, print $$$0$$$.

NoteIn the first test case, the permutation will be changing as follows:   after the $$$1$$$-st iteration: $$$[2, 3, 1]$$$;  after the $$$2$$$-nd iteration: $$$[2, 1, 3]$$$;  after the $$$3$$$-rd iteration: $$$[1, 2, 3]$$$. In the second test case, the permutation will be changing as follows:   after the $$$1$$$-st iteration: $$$[4, 5, 1, 7, 2, 3, 6]$$$;  after the $$$2$$$-nd iteration: $$$[4, 1, 5, 2, 7, 3, 6]$$$;  after the $$$3$$$-rd iteration: $$$[1, 4, 2, 5, 3, 7, 6]$$$;  after the $$$4$$$-th iteration: $$$[1, 2, 4, 3, 5, 6, 7]$$$;  after the $$$5$$$-th iteration: $$$[1, 2, 3, 4, 5, 6, 7]$$$. In the third test case, the permutation is already sorted and the answer is $$$0$$$.

{-# LANGUAGE BangPatterns #-}

module Main where

import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)
import           Data.List
import           Data.Array
import           Control.Monad.State

main = do
  t <- fst . fromJust . C.readInt <$> C.getLine
  replicateM_ t
    $ do
      n <- fst . fromJust . C.readInt <$> C.getLine
      ps <- map (fst . fromJust . C.readInt) . C.words <$> C.getLine
      print $ solve n ps

solve :: Int -> [Int] -> Int
solve n ps = go arr 0
  where
    arr = listArray (1, n) ps

    go !a x = if isSorted a
             then x
             else go (swap a n (x+1)) (x + 1)

isSorted :: Array Int Int -> Bool
isSorted ys = snd $ foldl op (0, True) ys
  where
    op (acc, !st) x = (x, acc < x && st)

swap :: Array Int Int -> Int -> Int -> Array Int Int
swap !arr n i =
  if even i
  then arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [2, 4 .. n - 1]
      , arr ! i > arr ! (i + 1)]
  else arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [1, 3 .. n - 2]
      , arr ! i > arr ! (i + 1)]
{-
>>>solve 3 [3,2,1]
3

-}

{-# LANGUAGE BangPatterns #-}

module Main where

import           Control.Monad
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)
import           Data.List
import           Data.Array
import           Control.Monad.State

main = do
  t <- fst . fromJust . C.readInt <$> C.getLine
  replicateM_ t
    $ do
      n <- fst . fromJust . C.readInt <$> C.getLine
      ps <- map (fst . fromJust . C.readInt) . C.words <$> C.getLine
      print $ solve n ps

solve :: Int -> [Int] -> Int
solve n ps = go arr 0
  where
    arr = listArray (1, n) ps

    go a x = if isSorted a
             then x
             else go (swap a n (x+1)) (x + 1)

isSorted :: Array Int Int -> Bool
isSorted ys = snd $ foldl op (0, True) ys
  where
    op (acc, !st) x = (x, acc < x && st)

swap :: Array Int Int -> Int -> Int -> Array Int Int
swap arr n i =
  if even i
  then arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [2, 4 .. n - 1]
      , arr ! i > arr ! (i + 1)]
  else arr
    // concat
      [[(i, arr ! (i + 1)), (i + 1, arr ! i)]
      | i <- [1, 3 .. n - 2]
      , arr ! i > arr ! (i + 1)]
{-
>>>solve 3 [3,2,1]
3

-}

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List(sort)

main :: IO ()
main = C.interact $ runScanner (numberOf testCase) >>> map (solve >>> showB) >>> C.unlines

testCase :: Scanner [Int]
testCase = numberOf int

solve :: [Int] -> Int
solve xs = iter False xs
  where
    iter _ xs | sorted xs = 0
    iter False xs = 1 + iter True (rec xs)
    iter True (x:xs) = 1 + iter False (x : rec xs)

    rec (x:x':xs) = min x x' : max x x' : rec xs
    rec xs = xs

    sorted xs = xs == sort xs

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

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

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

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

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


Mike decided to teach programming to children in an elementary school. He knows that it is not an easy task to interest children in that age to code. That is why he decided to give each child two sweets.Mike has $$$n$$$ sweets with sizes $$$a_1, a_2, \ldots, a_n$$$. All his sweets have different sizes. That is, there is no such pair $$$(i, j)$$$ ($$$1 \leq i, j \leq n$$$) such that $$$i \ne j$$$ and $$$a_i = a_j$$$.Since Mike has taught for many years, he knows that if he gives two sweets with sizes $$$a_i$$$ and $$$a_j$$$ to one child and $$$a_k$$$ and $$$a_p$$$ to another, where $$$(a_i + a_j) \neq (a_k + a_p)$$$, then a child who has a smaller sum of sizes will be upset. That is, if there are two children who have different sums of sweets, then one of them will be upset. Apparently, Mike does not want somebody to be upset. Mike wants to invite children giving each of them two sweets. Obviously, he can't give one sweet to two or more children. His goal is to invite as many children as he can. Since Mike is busy preparing to his first lecture in the elementary school, he is asking you to find the maximum number of children he can invite giving each of them two sweets in such way that nobody will be upset.

The first line contains one integer $$$n$$$ ($$$2 \leq n \leq 1\,000$$$) — the number of sweets Mike has. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^5$$$) — the sizes of the sweets. It is guaranteed that all integers are distinct.

Print one integer — the maximum number of children Mike can invite giving each of them two sweets in such way that nobody will be upset.

NoteIn the first example, Mike can give $$$9+2=11$$$ to one child, $$$8+3=11$$$ to another one, and $$$7+4=11$$$ to the third child. Therefore, Mike can invite three children. Note that it is not the only solution.In the second example, Mike can give $$$3+9=12$$$ to one child and $$$1+11$$$ to another one. Therefore, Mike can invite two children. Note that it is not the only solution.

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  as <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  let sums = IM.fromListWith (+) $ map (,1::Int)
             $ [x+y | x:xs <- tails as, y <- xs]
  print $ F.maximum sums

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

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

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


Mark has just purchased a rack of $$$n$$$ lightbulbs. The state of the lightbulbs can be described with binary string $$$s = s_1s_2\dots s_n$$$, where $$$s_i=\texttt{1}$$$ means that the $$$i$$$-th lightbulb is turned on, while $$$s_i=\texttt{0}$$$ means that the $$$i$$$-th lightbulb is turned off.Unfortunately, the lightbulbs are broken, and the only operation he can perform to change the state of the lightbulbs is the following:  Select an index $$$i$$$ from $$$2,3,\dots,n-1$$$ such that $$$s_{i-1}\ne s_{i+1}$$$.  Toggle $$$s_i$$$. Namely, if $$$s_i$$$ is $$$\texttt{0}$$$, set $$$s_i$$$ to $$$\texttt{1}$$$ or vice versa. Mark wants the state of the lightbulbs to be another binary string $$$t$$$. Help Mark determine the minimum number of operations to do so.

The first line of the input contains a single integer $$$q$$$ ($$$1\leq q\leq 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$3\leq n\leq 2\cdot 10^5$$$) — the number of lightbulbs. The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$ — the initial state of the lightbulbs. The third line of each test case contains a binary string $$$t$$$ of length $$$n$$$ — the final state of the lightbulbs. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print a line containing the minimum number of operations Mark needs to perform to transform $$$s$$$ to $$$t$$$. If there is no such sequence of operations, print $$$-1$$$.

NoteIn the first test case, one sequence of operations that achieves the minimum number of operations is the following.   Select $$$i=3$$$, changing $$$\texttt{01}\color{red}{\texttt{0}}\texttt{0}$$$ to $$$\texttt{01}\color{red}{\texttt{1}}\texttt{0}$$$.  Select $$$i=2$$$, changing $$$\texttt{0}\color{red}{\texttt{1}}\texttt{10}$$$ to $$$\texttt{0}\color{red}{\texttt{0}}\texttt{10}$$$.  In the second test case, there is no sequence of operations because one cannot change the first digit or the last digit of $$$s$$$.In the third test case, even though the first digits of $$$s$$$ and $$$t$$$ are the same and the last digits of $$$s$$$ and $$$t$$$ are the same, it can be shown that there is no sequence of operations that satisfies the condition.In the fourth test case, one sequence that achieves the minimum number of operations is the following:   Select $$$i=3$$$, changing $$$\texttt{00}\color{red}{\texttt{0}}\texttt{101}$$$ to $$$\texttt{00}\color{red}{\texttt{1}}\texttt{101}$$$.  Select $$$i=2$$$, changing $$$\texttt{0}\color{red}{\texttt{0}}\texttt{1101}$$$ to $$$\texttt{0}\color{red}{\texttt{1}}\texttt{1101}$$$.  Select $$$i=4$$$, changing $$$\texttt{011}\color{red}{\texttt{1}}\texttt{01}$$$ to $$$\texttt{011}\color{red}{\texttt{0}}\texttt{01}$$$.  Select $$$i=5$$$, changing $$$\texttt{0110}\color{red}{\texttt{0}}\texttt{1}$$$ to $$$\texttt{0110}\color{red}{\texttt{1}}\texttt{1}$$$.  Select $$$i=3$$$, changing $$$\texttt{01}\color{red}{\texttt{1}}\texttt{011}$$$ to $$$\texttt{01}\color{red}{\texttt{0}}\texttt{011}$$$.

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Char8 as SBS
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SBS = State BS.ByteString
type S = StateT BS.ByteString

str = string7

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

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

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

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

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

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

solve :: SBS Builder
solve = do
  n <- getInt
  s <- getNext
  t <- getNext
  let
    base = BS.toStrict s
    getS x = if BS.length x == 0 then [] else let
      (pre, suf) = BS.span ((==) (BS.head x)) x
      in (BS.length pre, BS.head x) : getS suf

    (sLens, sVals) = unzip $ getS s
    (tLens, tVals) = unzip $ getS t
    cond = sVals == tVals
    sLenPre = scanl1 (+) sLens
    tLenPre = scanl1 (+) tLens
    res = sum . map abs $ zipWith (-) sLenPre tLenPre
  pure $ if not cond then putInts [-1] else putInts [fromIntegral res]


There are $$$n$$$ piles of sand where the $$$i$$$-th pile has $$$a_i$$$ blocks of sand. The $$$i$$$-th pile is called too tall if $$$1 < i < n$$$ and $$$a_i > a_{i-1} + a_{i+1}$$$. That is, a pile is too tall if it has more sand than its two neighbours combined. (Note that piles on the ends of the array cannot be too tall.)You are given an integer $$$k$$$. An operation consists of picking $$$k$$$ consecutive piles of sand and adding one unit of sand to them all. Formally, pick $$$1 \leq l,r \leq n$$$ such that $$$r-l+1=k$$$. Then for all $$$l \leq i \leq r$$$, update $$$a_i \gets a_i+1$$$.What is the maximum number of piles that can simultaneously be too tall after some (possibly zero) operations?

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$3 \leq n \leq 2 \cdot 10^5$$$; $$$1 \leq k \leq n$$$) — the number of piles of sand and the size of the operation, respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the sizes of the piles. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the maximum number of piles that are simultaneously too tall after some (possibly zero) operations.

NoteIn the first test case, we can perform the following three operations:   Add one unit of sand to piles $$$1$$$ and $$$2$$$: $$$[\color{red}{3}, \color{red}{10}, 2, 4, 1]$$$.  Add one unit of sand to piles $$$4$$$ and $$$5$$$: $$$[3, 10, 2, \color{red}{5}, \color{red}{2}]$$$.  Add one unit of sand to piles $$$3$$$ and $$$4$$$: $$$[3, 10, \color{red}{3}, \color{red}{6}, 2]$$$.  Now piles $$$2$$$ and $$$4$$$ are too tall, so in this case the answer is $$$2$$$. It can be shown that it is impossible to make more than $$$2$$$ piles too tall.In the second test case, any operation will increase all piles by $$$1$$$ unit, so the number of too tall piles will always be $$$0$$$.In the third test case, we can increase any pile by $$$1$$$ unit of sand. It can be shown that the maximum number of too tall piles is $$$1$$$.

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

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

data TC = TC {n :: Int, k :: Int, xs :: [Int]}
type Output = Int

input :: Scanner TC
input = do
  n <- int
  k <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | k == 1 = (n - 1) `div` 2
  | otherwise = length . filter id $ zipWith3 (\x y z -> y - x - z > 0) xs (tail xs) (drop 2 xs)

output :: Output -> C.ByteString
output = showB

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

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

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

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

str = string7

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

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

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

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

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

solve :: SP Builder
solve = do
  n <- getInt
  k <- getInt
  a <- replicateM n getInt

  let
    prefixes = filter (\x -> length x >= 3) . map (take 3) $ tails a
    cost (x1:x2:x3:[]) = if x2 > x1 + x3 then 1 else 0
    cost x = trace (show prefixes) 0
    ansbig = sum $ map cost prefixes
    ans = if k == 1 then (n - 1) `div` 2 else ansbig
  pure $ putInts [ans]

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> Int -> [Int] -> Int
solve n k as
    | k == 1 = (n - 1) `div` 2
    | otherwise = L.sum $ L.zipWith3 (\a_ a ap -> if a > (a_ + ap) then 1 else 0) as (drop 1 as) (drop 2 as)

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        [n, k] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntB8s
        let answer = solve n k as
        printf "%d\n" answer

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

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

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

data TC = TC {n :: Int, k :: Int, xs :: [Int]}
type Output = Int

input :: Scanner TC
input = do
  n <- int
  k <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | k == 1 = (n - 1) `div` 2
  | otherwise = length $ zipWith3 (\x y z -> y - x - z > 0) xs (tail xs) (drop 2 xs)

output :: Output -> C.ByteString
output = showB

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


Pasha is participating in a contest on one well-known website. This time he wants to win the contest and will do anything to get to the first place!This contest consists of n problems, and Pasha solves ith problem in ai time units (his solutions are always correct). At any moment of time he can be thinking about a solution to only one of the problems (that is, he cannot be solving two problems at the same time). The time Pasha spends to send his solutions is negligible. Pasha can send any number of solutions at the same moment.Unfortunately, there are too many participants, and the website is not always working. Pasha received the information that the website will be working only during m time periods, jth period is represented by its starting moment lj and ending moment rj. Of course, Pasha can send his solution only when the website is working. In other words, Pasha can send his solution at some moment T iff there exists a period x such that lx ≤ T ≤ rx.Pasha wants to know his best possible result. We need to tell him the minimal moment of time by which he is able to have solutions to all problems submitted, if he acts optimally, or say that it's impossible no matter how Pasha solves the problems.

The first line contains one integer n (1 ≤ n ≤ 1000) — the number of problems. The second line contains n integers ai (1 ≤ ai ≤ 105) — the time Pasha needs to solve ith problem. The third line contains one integer m (0 ≤ m ≤ 1000) — the number of periods of time when the website is working. Next m lines represent these periods. jth line contains two numbers lj and rj (1 ≤ lj < rj ≤ 105) — the starting and the ending moment of jth period. It is guaranteed that the periods are not intersecting and are given in chronological order, so for every j > 1 the condition lj > rj - 1 is met.

If Pasha can solve and submit all the problems before the end of the contest, print the minimal moment of time by which he can have all the solutions submitted. Otherwise print "-1" (without brackets).

NoteIn the first example Pasha can act like this: he solves the second problem in 4 units of time and sends it immediately. Then he spends 3 time units to solve the first problem and sends it 7 time units after the contest starts, because at this moment the website starts working again.In the second example Pasha invents the solution only after the website stops working for the last time.In the third example Pasha sends the solution exactly at the end of the first period.

import Control.Monad
import Data.List

parse s = let n:xs = map read . words $ s
              (as, (m:ms)) = splitAt n xs
              rs = splitPairs ms
          in (as, rs)
  where
    splitPairs [] = []
    splitPairs (a:b:xs) = (a,b):(splitPairs xs)
solve ps xs = (\(a,b) -> Just $ max x a) =<< find (\(a,b) -> x <= b) xs
  where x = sum ps
display :: Maybe Int -> String
display = (++"\n") . maybe "-1" show
main = interact (display . uncurry solve . parse)

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE TypeOperators #-}

module Main where

import Data.List
import Data.Char
import Data.Maybe
-- import Control.Applicative
import Control.Monad
import System.IO

main :: IO ()
main = do
  -- handle <- openFile "input.txt" ReadMode
  -- contents <- hGetContents handle
  contents <- getContents
  let linesOfFile = lines contents
  let a = map (\x-> read x :: Int) $ words $ (linesOfFile !! 1)
  let m = read $ (linesOfFile !! 2) :: Int
  let l = map (\x -> let k = words x; i = read (k!!0); j = read (k!!1) in (i,j)) $ drop 3 linesOfFile
  let res = solve a l
  putStrLn $ show $ res
  -- let d = initData s
  -- forM_ [1..n] $ \a0 -> do
  --   let l = words $ linesOfFile !! (2 + a0)
  --   let k = read (l!!0) :: Int
  --   let c = ord (l!!1!!0) - ord 'a'
  --   putStrLn $ show $ d!!c!!(k - 1)
  -- ii <- getLine
  -- aa <- getLine
  -- bb <- getLine
  -- let

solve a l =
  let
    s = sum a
    i = findIndex (\x-> snd x >= s) l
    e = l!!(fromJust i)
    t = fst e
  in
    if i == Nothing then -1 else maximum [s,t]

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.List

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

solve as ps = case dropWhile ((< s) . snd) ps of
  (l, _):_ -> max l s
  otherwise -> -1
  where s = sum as

main = do
  n <- readInt <$> B.getLine
  as <- readInts <$> B.getLine
  m <- readInt <$> B.getLine
  ps <- replicateM m ((\(l:r:_) -> (l, r)) . readInts <$> B.getLine)
  print $ solve as ps


You are given a positive decimal number x.Your task is to convert it to the "simple exponential notation".Let x = a·10b, where 1 ≤ a < 10, then in general case the "simple exponential notation" looks like "aEb". If b equals to zero, the part "Eb" should be skipped. If a is an integer, it should be written without decimal point. Also there should not be extra zeroes in a and b.

The only line contains the positive decimal number x. The length of the line will not exceed 106. Note that you are given too large number, so you can't use standard built-in data types "float", "double" and other.

Print the only line — the "simple exponential notation" of the given number x.

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = reverse $ dropWhile (=='0') $ reverse $ dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case (nums, nonZeros) of
               ([], _)  -> "0"
               (x, [])   -> [n] ++ "E-" ++ lz
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = reverse $ dropWhile (=='0') $ reverse $ tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s, fs) of
               (True, _, _:nonEmpty) -> solve $ '.':fs
               (_, True, _:nonEmpty) -> solve is
               (False, False, _:nonEmpty) -> (hi:'.':hfs) ++ lz
               (_, _, []) -> solve is
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ dropWhile (=='0') $ reverse ns
          ePos = length ns
          in case (nums, ePos, valueds) of
               ([], _, _)    -> "0"
               (_, 0, _)     -> n:[]
               (_, _, [])    -> n:'E':(show ePos)
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = reverse $ dropWhile (=='0') $ reverse $ dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case (nums, eMin) of
               ([], _)  -> "0"
               (x, 0)   -> [n] ++ "E-" ++ lz
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = reverse $ dropWhile (=='0') $ reverse $ tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s, fs) of
               (True, _, _:nonEmpty) -> solve $ '.':fs
               (_, True, _:nonEmpty) -> solve is
               (False, False, _:nonEmpty) -> (hi:'.':hfs) ++ lz
               (_, _, []) -> solve is
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ dropWhile (=='0') $ reverse ns
          ePos = length ns
          in case (nums, ePos, valueds) of
               ([], _, _)    -> "0"
               (_, 0, _)     -> n:[]
               (_, _, [])    -> n:'E':(show ePos)
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = reverse $ dropWhile (=='0') $ reverse $ dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case (nums, eMin) of
               ([], _)  -> "0"
               (x, 0)   -> [n] ++ "E-" ++ lz
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = reverse $ dropWhile (=='0') $ reverse $ tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s, fs) of
               (_, _, []) -> solve is
               (True, _, _) -> solve $ '.':fs
               (_, True, _) -> solve is
               (False, False, _) -> (hi:'.':hfs) ++ lz
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ dropWhile (=='0') $ reverse ns
          ePos = length ns
          in case (nums, ePos, valueds) of
               (_, _, [])    -> n:'E':(show ePos)
               ([], _, _)    -> "0"
               (_, 0, _)     -> show n
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case nums of
               [] -> "0"
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s) of
               (True, _) -> solve $ '.':fs
               (_, True) -> solve is
               (False, False) -> (hi:'.':hfs) ++ lz
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ reverse $ dropWhile (=='0') ns
          ePos = length ns
          in case (nums, ePos) of
               ([], _)    -> "0"
               (_, 0)     -> show n
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case nums of
               [] -> "0"
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = reverse $ dropWhile (=='0') $ reverse $ tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s) of
               (True, _) -> solve $ '.':fs
               (_, True) -> solve is
               (False, False) -> (hi:'.':hfs) ++ lz
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ dropWhile (=='0') $ reverse ns
          ePos = length ns
          in case (nums, ePos) of
               ([], _)    -> "0"
               (_, 0)     -> show n
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  data Number = Number {
                       i :: Int,
                       f :: Float,
                       e :: Int
                       }

  -- instance Show Number where

  solve :: String -> String
  solve (x:xs)
    | x == '.'        =
      let zeros = takeWhile (=='0') xs
          nums = reverse $ dropWhile (=='0') $ reverse $ dropWhile (=='0') xs
          (n:nonZeros) = nums
          eMin = length zeros
          lz   = show (eMin + 1)
          in case (nums, eMin) of
               ([], _)  -> "0"
               (x, 0)   -> [n] ++ "E-" ++ lz
               otherwise -> [n] ++ "." ++ nonZeros ++ "E-" ++ lz
    | any (=='.') xs  =
      let nums = dropWhile (=='0') (x:xs)
          is = takeWhile (/='.') nums
          fs = reverse $ dropWhile (=='0') $ reverse $ tail $ dropWhile (/='.') nums
          i0s = all (=='0') is
          f0s = all (=='0') fs
          (hi:his) = is
          hfs = his ++ fs
          ePos = length his
          lz = case ePos of
                 0 -> ""
                 _ -> 'E':(show ePos)
          in case (i0s, f0s) of
               (True, _) -> solve $ '.':fs
               (_, True) -> solve is
               (False, False) -> (hi:'.':hfs) ++ lz
    | otherwise       =
      let nums = dropWhile (=='0') (x:xs)
          (n:ns) = nums
          valueds = reverse $ dropWhile (=='0') $ reverse ns
          ePos = length ns
          in case (nums, ePos) of
               ([], _)    -> "0"
               (_, 0)     -> show n
               otherwise  -> [n,'.'] ++ valueds ++ "E" ++ show ePos

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


Alice and Bob are playing a game. Initially, they are given a non-empty string $$$s$$$, consisting of lowercase Latin letters. The length of the string is even. Each player also has a string of their own, initially empty.Alice starts, then they alternate moves. In one move, a player takes either the first or the last letter of the string $$$s$$$, removes it from $$$s$$$ and prepends (adds to the beginning) it to their own string.The game ends when the string $$$s$$$ becomes empty. The winner is the player with a lexicographically smaller string. If the players' strings are equal, then it's a draw.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if there exists such position $$$i$$$ that $$$a_j = b_j$$$ for all $$$j < i$$$ and $$$a_i < b_i$$$.What is the result of the game if both players play optimally (e. g. both players try to win; if they can't, then try to draw)?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. Each testcase consists of a single line — a non-empty string $$$s$$$, consisting of lowercase Latin letters. The length of the string $$$s$$$ is even. The total length of the strings over all testcases doesn't exceed $$$2000$$$.

For each testcase, print the result of the game if both players play optimally. If Alice wins, print "Alice". If Bob wins, print "Bob". If it's a draw, print "Draw".

NoteOne of the possible games Alice and Bob can play in the first testcase:   Alice picks the first letter in $$$s$$$: $$$s=$$$"orces", $$$a=$$$"f", $$$b=$$$"";  Bob picks the last letter in $$$s$$$: $$$s=$$$"orce", $$$a=$$$"f", $$$b=$$$"s";  Alice picks the last letter in $$$s$$$: $$$s=$$$"orc", $$$a=$$$"ef", $$$b=$$$"s";  Bob picks the first letter in $$$s$$$: $$$s=$$$"rc", $$$a=$$$"ef", $$$b=$$$"os";  Alice picks the last letter in $$$s$$$: $$$s=$$$"r", $$$a=$$$"cef", $$$b=$$$"os";  Bob picks the remaining letter in $$$s$$$: $$$s=$$$"", $$$a=$$$"cef", $$$b=$$$"ros". Alice wins because "cef" < "ros". Neither of the players follows any strategy in this particular example game, so it doesn't show that Alice wins if both play optimally.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}

module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Tuple
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.List (group, sort, intercalate)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Function (on)
import Data.Array.IO (IOArray, getElems, newArray, readArray, writeArray, newListArray, getBounds)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = (IOArray Int Char, IOArray (Int, Int) Ans)
type Solver = Domain -> IO ()
data Player = Alice | Bob deriving (Eq, Show, Ord)
-- draw state: alice's next choice
data Ans =  Winner Player | Draw (Maybe Char) deriving (Eq, Ord)
instance Show Ans where
  show (Winner Alice) = "Alice"
  show (Winner Bob) = "Bob"
  show (Draw _) = "Draw"

-- data Ans =  Winner Player | Draw (Maybe Char) deriving (Eq, Show)

op :: Player -> Player
op Alice = Bob
op Bob = Alice

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

parse :: IO Domain
parse = do
  line <- getLine
  line <- newListArray (0, length line -1) line
  (start, end) <- getBounds line
  dp <- newArray ((start,start), (end, end)) (Draw Nothing)
  return (line, dp)

test :: (Maybe x, Maybe y) -> Maybe (x, y)
test (Just x, Just y) = Just (x, y)
test _ = Nothing

whoWin :: Ord a => a -> a -> Player -> Ans
whoWin pa a p = if pa == a then Draw Nothing else Winner (if pa < a then p else op p)

choose :: Char -> Char-> Ans -> Ans -> Player -> Ans
choose pa pb x y p
  -- if p wins at some choice, then p wins
  | Winner p == x || Winner p == y = Winner p
  -- otherwise, he will lose
  | otherwise = case (x, y) of
      -- choose smaller one that lead to draw
      (Draw Nothing, Draw Nothing) -> Draw . Just $ min pa pb
      (Draw Nothing, _) -> Draw $ Just pa
      (_,Draw Nothing) -> Draw $ Just pb
      -- if outCome draw with a char, compare with currentOne
      (Draw (Just a), Draw (Just b)) -> f
          where
            f | pa > a && pb > b = Winner $ op p -- if both are larger, then p will lose
              | pa < a || pb < b = Winner p -- if either is smaller, then p will win
              | otherwise = Draw Nothing -- otherwise, p will draw
      (Draw (Just a), _) -> whoWin pa a p
      (_, Draw (Just b)) -> whoWin pb b p
      _ -> Winner $ op p

solve :: Solver
solve (line, dp) =  do
  lst <- getElems line
  (start, end) <- getBounds line
  mapM_ (\i -> (writeArray dp (i, i) . Draw . Just) =<< readArray line i) [start..end]
  mapM_ (gos end) [1..end]
  ans <- readArray dp (start, end)
  -- lst <- getElems dp
  -- let xs = zip (sort [(x,y) |x <- [start..end], y <- [start..end]]) lst
  -- print xs
  print ans
  where
    gos :: Int -> Int -> IO ()
    gos end i = mapM_ (uncurry go) [(x, x+i) | x <- [0..end-i]]
    go :: Int -> Int -> IO ()
    go x y =
      do
        a1 <- readArray line x
        a2 <- readArray line y
        a <- readArray dp (x+1, y)
        b <- readArray dp (x, y-1)
        writeArray dp (x, y) (choose a1 a2 a b player)
        where
          player = if (y - x) `mod` 2 == 1 then Alice else Bob

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}

module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Tuple
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.List (group, sort, intercalate)
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = String
type Solver = Domain -> IO ()
data Player = Alice | Bob deriving (Eq, Show)
-- draw state: alice's next choice
data Ans =  Winner Player | Draw (Maybe Char) deriving (Eq)
instance Show Ans where
  show (Winner Alice) = "Alice"
  show (Winner Bob) = "Bob"
  show (Draw _) = "Draw"

type DP = Map.Map (Int, Int) Ans

op :: Player -> Player
op Alice = Bob
op Bob = Alice

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

parse :: IO Domain
parse = getLine

test :: (Maybe x, Maybe y) -> Maybe (x, y)
test (Just x, Just y) = Just (x, y)
test _ = Nothing

whoWin :: Ord a => a -> a -> Player -> Ans
whoWin pa a p = if pa == a then Draw Nothing else Winner (if pa < a then p else op p)

choose :: Char -> Char-> Ans -> Ans -> Player -> Ans
choose pa pb x y p
  -- if p wins at some choice, then p wins
  | Winner p == x || Winner p == y = Winner p
  -- otherwise, he will lose
  | otherwise = case (x, y) of
      -- choose smaller one that lead to draw
      (Draw Nothing , Draw Nothing) -> Draw . Just $ min pa pb
      -- if outCome draw with a char, compare with currentOne
      (Draw (Just a), Draw (Just b)) -> f
          where
            f | pa > a && pb > b = Winner $ op p -- if both are larger, then p will lose
              | pa < a || pb < b = Winner p -- if either is smaller, then p will win
              | otherwise = Draw Nothing -- otherwise, p will draw
      (Draw (Just a), _) -> whoWin pa a p
      (_, Draw (Just b)) -> whoWin pb b p
      _ -> Winner $ op p

solve :: Solver
solve line =  case ((foldl gos dp [1 .. n - 1])) Map.!? (0, n-1) of
    Just x -> print x
    Nothing -> error "no result"
  where
    n = length line
    dp = Map.fromList [((x, x), Draw (Just $ line !! x)) | x <- [0..n-1]]
    gos :: DP -> Int -> DP
    gos p i =
      -- traceShow ("gos: ", i, p) $
      foldr (uncurry go) p [(x, x+i) | x <- [0..n-1-i]]
    go :: Int -> Int -> DP -> DP
    go x y dp =
      -- traceShow ("go: ", (x+1, y), (x, y-1)) $
      case test (Map.lookup (x+1, y) dp, Map.lookup (x, y-1) dp) of
        -- choose the best outcome
        Just (a, b) -> Map.insert (x, y) (choose (line !! x) (line !! y) a b player) dp
        -- nothing occur if first
        Nothing -> error $ "impossible!" ++ show ((x+1, y), (x, y-1)) ++ ":" ++ show dp
      where
        indices = [(x+1, y), (x, y-1)]
        player = if (y - x) `mod` 2 == 1 then Alice else Bob

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}

module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Tuple
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.List (group, sort, intercalate)
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = String
type Solver = Domain -> IO ()
data Player = Alice | Bob deriving (Eq, Show)
-- draw state: alice's next choice
data Ans =  Winner Player | Draw (Maybe Char) deriving (Eq)
instance Show Ans where
  show (Winner Alice) = "Alice"
  show (Winner Bob) = "Bob"
  show (Draw Nothing) = "Draw"

type DP = Map.Map (Int, Int) Ans

op :: Player -> Player
op Alice = Bob
op Bob = Alice

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

parse :: IO Domain
parse = getLine

test :: (Maybe x, Maybe y) -> Maybe (x, y)
test (Just x, Just y) = Just (x, y)
test _ = Nothing

whoWin pa a p = if pa == a then Draw Nothing else Winner (if pa < a then p else op p)

choose :: Char -> Char-> Ans -> Ans -> Player -> Ans
choose pa pb x y p
  -- if p wins at some choice, then p wins
  | Winner p == x || Winner p == y = Winner p
  -- else if p could draw, then he will draw
  | x == Draw Nothing || y == Draw Nothing = Draw Nothing
  -- otherwise, he will lose
  | otherwise = case (x, y) of
      -- choose smaller one that lead to draw
      (Draw Nothing , Draw Nothing) -> Draw . Just $ min pa pb
      -- if outCome draw with a char, compare with currentOne
      (Draw (Just a), Draw (Just b)) -> f
          where
            f | pa > a && pb > b = Winner $ op p -- if both are larger, then p will lose
              | pa < a || pb < b = Winner p -- if either is smaller, then p will win
              | otherwise = Draw Nothing -- otherwise, p will draw
      (Draw Nothing, _) -> Draw $ Just pa
      (Draw (Just a), _) -> whoWin pa a p
      (_, Draw (Just b)) -> whoWin pb b p
      _ -> Winner $ op p

solve :: Solver
solve line =  case (foldl gos dp [1 .. n - 1]) Map.!? (0, n-1) of
    Just x -> print x
    Nothing -> error "no result"
  where
    n = length line
    dp = Map.fromList [((x, x), Draw (Just $ line !! x)) | x <- [0..n-1]]
    gos :: DP -> Int -> DP
    gos p i =
      -- traceShow ("gos: ", i, p) $
      foldr (uncurry go) p [(x, x+i) | x <- [0..n-1-i]]
    go :: Int -> Int -> DP -> DP
    go x y dp =
      -- traceShow ("go: ", (x+1, y), (x, y-1)) $
      case test (Map.lookup (x+1, y) dp, Map.lookup (x, y-1) dp) of
        -- choose the best outcome
        Just (a, b) -> Map.insert (x, y) (choose (line !! x) (line !! y) a b player) dp
        -- nothing occur if first
        Nothing -> error $ "impossible!" ++ show ((x+1, y), (x, y-1)) ++ ":" ++ show dp
      where
        indices = [(x+1, y), (x, y-1)]
        player = if (y - x) `mod` 2 == 1 then Alice else Bob

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


A rooted tree is a non-directed connected graph without any cycles with a distinguished vertex, which is called the tree root. Consider the vertices of a rooted tree, that consists of n vertices, numbered from 1 to n. In this problem the tree root is the vertex number 1.Let's represent the length of the shortest by the number of edges path in the tree between vertices v and u as d(v, u).A parent of vertex v in the rooted tree with the root in vertex r (v ≠ r) is vertex pv, such that d(r, pv) + 1 = d(r, v) and d(pv, v) = 1. For example, on the picture the parent of vertex v = 5 is vertex p5 = 2.One day Polycarpus came across a rooted tree, consisting of n vertices. The tree wasn't exactly ordinary: it had strings written on its edges. Polycarpus positioned the tree on the plane so as to make all edges lead from top to bottom if you go from the vertex parent to the vertex (see the picture). For any edge that lead from vertex pv to vertex v (1 < v ≤ n), he knows string sv that is written on it. All strings are written on the edges from top to bottom. For example, on the picture s7="ba". The characters in the strings are numbered starting from 0.    An example of Polycarpus's tree (corresponds to the example from the statement) Polycarpus defines the position in this tree as a specific letter on a specific string. The position is written as a pair of integers (v, x) that means that the position is the x-th letter of the string sv (1 < v ≤ n, 0 ≤ x < |sv|), where |sv| is the length of string sv. For example, the highlighted letters are positions (2, 1) and (3, 1).Let's consider the pair of positions (v, x) and (u, y) in Polycarpus' tree, such that the way from the first position to the second goes down on each step. We will consider that the pair of such positions defines string z. String z consists of all letters on the way from (v, x) to (u, y), written in the order of this path. For example, in the picture the highlighted positions define string "bacaba".Polycarpus has a string t, he wants to know the number of pairs of positions that define string t. Note that the way from the first position to the second in the pair must go down everywhere. Help him with this challenging tree-string problem!

The first line contains integer n (2 ≤ n ≤ 105) — the number of vertices of Polycarpus's tree. Next n - 1 lines contain the tree edges. The i-th of them contains number pi + 1 and string si + 1 (1 ≤ pi + 1 ≤ n; pi + 1 ≠ (i + 1)). String si + 1 is non-empty and consists of lowercase English letters. The last line contains string t. String t consists of lowercase English letters, its length is at least 2. It is guaranteed that the input contains at most 3·105 English letters.

Print a single integer — the required number. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

7
1 ab
5 bacaba
1 abacaba
2 aca
5 ba
2 ba
aba

7
1 ab
5 bacaba
1 abacaba
2 aca
5 ba
2 ba
bacaba

NoteIn the first test case string "aba" is determined by the pairs of positions: (2, 0) and (5, 0); (5, 2) and (6, 1); (5, 2) and (3, 1); (4, 0) and (4, 2); (4, 4) and (4, 6); (3, 3) and (3, 5).Note that the string is not defined by the pair of positions (7, 1) and (5, 0), as the way between them doesn't always go down.

import Control.Arrow
import Control.DeepSeq
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C

kmp :: Eq a => Array Int a -> Array Int Int
kmp a = pre
  where
    ix = bounds a
    pre = listArray ix $ map f $ range ix
    f i
      | i == fst ix = fst ix - 1
      | otherwise   = g $ pre!(i-1)
      where
        g j
          | a!(j+1) == a!i  = j + 1
          | inRange ix j    = g $ pre!j
          | otherwise       = fst ix - 1

auto :: (Ix a) => (a, a) -> Array Int a -> U.UArray (Int, a) Int
auto (cl, cr) a = U.array ix $ assocs $ to
  where
    (il, ir) = bounds a
    ix = ((il - 1, cl), (ir, cr))
    pre = kmp a
    to = listArray ix $ map f $ range ix
    f (i, c)
      | i < ir && a!(i+1) == c  = i + 1
      | i == il - 1             = i
      | otherwise               = force $ to!(pre!i, c)

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  (sh: st) <- fmap C.words C.getContents
  let el = zipWith (\i (j, k) -> (readInt j, (i, k))) [2..] $ pairs $ init st
      e = accumArray (flip (:)) [] (1, readInt sh) el
      s = last st
      n = C.length s
      a = listArray (1, n) $ C.unpack s
      to = auto charset a
      go (x, i) c = let j = to U.! (i, c) in force (if j == n then x + 1 else x, j)
      gao v i = foldl' (+) 0 [force $ c + gao w j |
        (w, d) <- e!v, let (c, j) = C.foldl' go (0::Int, i) d]
  print $ gao 1 0
  where
    charset = ('a', 'z')

--import Control.Monad.State
import Control.Applicative
import Control.Arrow
import Data.Traversable
import Data.Tree
import qualified Data.Map as Map
import Data.Maybe

data KMP a = KMP { done :: Bool,
                 feed :: a -> KMP a }

mkKMP' :: Ord a => KMP a -> [a] -> KMP a
mkKMP' backup [] = KMP True (feed backup)
mkKMP' backup (h : t) = KMP False (\ch -> if ch == h then mkKMP' fbh t else feed backup ch) where
  fbh = feed backup h

mkKMP :: Ord a => [a] -> KMP a
mkKMP l = start where
  start = mkKMP' (KMP False (\x -> start)) l

swap(a,b)=(b,a)
runKMP :: Ord a => KMP a -> [a] -> ([Bool], KMP a)
--runKMP kmp l = runState (traverse (\x -> modify (`feed` x) *> gets done) l) kmp
runKMP kmp l = swap $ mapAccumL (\k x -> let k' = feed k x in (k', done k')) kmp l

type Tree1 = Tree String

process :: [(Int, String)] -> Tree1
process l = gogo 1 "" where
  gogo n s = Node s $ map (uncurry gogo) (fromMaybe [] $ Map.lookup n m)
  m = Map.fromListWith (++) $ zipWith (\i (j,s) -> (j, [(i, s)])) [2..] l

go k (Node s l) = case runKMP k s of
  (ms, kk) -> length (filter id ms) + sum (map (go kk) l)
z(l,s)=go (mkKMP s) (process (map ((\[a,b]->(read a,b)).words) l))
main=interact$show.z.(init&&&last).tail.lines


A programming coach has n students to teach. We know that n is divisible by 3. Let's assume that all students are numbered from 1 to n, inclusive.Before the university programming championship the coach wants to split all students into groups of three. For some pairs of students we know that they want to be on the same team. Besides, if the i-th student wants to be on the same team with the j-th one, then the j-th student wants to be on the same team with the i-th one. The coach wants the teams to show good results, so he wants the following condition to hold: if the i-th student wants to be on the same team with the j-th, then the i-th and the j-th students must be on the same team. Also, it is obvious that each student must be on exactly one team.Help the coach and divide the teams the way he wants.

The first line of the input contains integers n and m (3 ≤ n ≤ 48, . Then follow m lines, each contains a pair of integers ai, bi (1 ≤ ai < bi ≤ n) — the pair ai, bi means that students with numbers ai and bi want to be on the same team. It is guaranteed that n is divisible by 3. It is guaranteed that each pair ai, bi occurs in the input at most once.

If the required division into teams doesn't exist, print number -1. Otherwise, print  lines. In each line print three integers xi, yi, zi (1 ≤ xi, yi, zi ≤ n) — the i-th team.  If there are multiple answers, you are allowed to print any of them.

import Control.Monad
import Data.Graph
import Data.Tree

readPair :: IO (Int, Int)
readPair = do
  [a, b] <- fmap (map read . words) getLine
  return (a, b)

main :: IO ()
main = do
  (n, m) <- readPair
  e <- replicateM m readPair
  let g = buildG (1, n) e
      c = map flatten $ components g
      f l a = filter ((==l) . length) a
      one = f 1 c
      two = f 2 c
      three = f 3 c
  if maximum (map length c) > 3 || length two > length one then putStrLn "-1"
  else do
    let (x, y) = splitAt (length two) one
        ans = (three ++) $ (zipWith (++) x two ++) $
          map (concat . take 3) $ takeWhile (not . null) $ iterate (drop 3) $ y
    forM_ ans $ \i -> do
      putStrLn $ unwords $ map show $ i

import Data.Function
import Data.List

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

solve :: [[Int]] -> [[Int]]
solve ((n : _) : ps)
  | (length $ head ts) <= 3 && (fst $ con [] bs) = as ++ (snd $ con [] bs)
  | otherwise = [[-1]]
  where
  ts = sortBy (compare `on` (0 -) . length) $ map (map fst) $ groupBy ((==) `on` snd) $ sortBy (compare `on` snd) $ zip [1..] $ foldl f [1..n] $ sort $ map sort ps
  (as, bs) = span ((== 3) . length) ts
  con ys [] = (True, ys)
  con ys (x : xs)
    | length x == 2 = if (length $ last xs) == 1
      then con ((x ++ last xs) : ys) (init xs)
      else (False, [])
    | otherwise = con ((concat $ x : take 2 xs) : ys) (drop 2 xs)
  f ps [a, b] = [if p' == pa || p' == pb then p else p' | p' <- ps]
    where
    pa = ps !! (a - 1)
    pb = ps !! (b - 1)
    p = min pa pb

import Control.Monad (liftM, replicateM)
import Data.Char (ord)
import Data.Graph (buildG, components)
import Data.Tree (flatten)
import Data.List (intercalate)

solve :: Int -> [(Int, Int)] -> Maybe [[Int]]
solve n ps
  | any ((> 3) . length) comp  =  Nothing
  | length two > length one  =  Nothing
  | otherwise  =  Just ans
  where
    graph  =  buildG (1,n) ps
    comp   =  map flatten $ components graph
    one    =  filter ((== 1) . length) comp
    two    =  filter ((== 2) . length) comp
    three  =  filter ((== 3) . length) comp
    ans    =  three ++ zipWith (++) one two ++ toTuples (drop (length two) (concat one))
    toTuples []  =  []
    toTuples (a:b:c:xs)  =  [a,b,c] : toTuples xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM m readPair
    case solve n ps of
        Nothing  ->  print (-1)
        Just as  ->  mapM_ prints as

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

import Data.Graph
import Data.Tree
import Data.List
import Control.Monad

part n [] = []
part n xs = (take n xs):part n (drop n xs)

solve :: Int -> [(Int, Int)] -> [[Int]]
solve n es
  | solutionExists = c3 ++ zipWith (++) c2 (take n2 c1) ++ (part 3 $ drop n2 $ concat c1)
  | otherwise      = [[-1]]
  where cs = map flatten $ components $ buildG (1, n) es
        c1 = filter (\x -> length x == 1) cs
        c2 = filter (\x -> length x == 2) cs
        c3 = filter (\x -> length x == 3) cs
        n1 = length c1
        n2 = length c2
        n3 = length c3
        cn = filter (\x -> length x >  3) cs
        solutionExists = null cn && n2 <= n1 && (n1 - n2) `mod` 3 == 0

readPair = fmap ((\[x, y] -> (x, y)) . map read . words) getLine

main = do (n, m) <- readPair
          es <- replicateM m readPair
          let solution = solve n es
          putStr $ unlines $ map (unwords . map show) solution

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Data.List
import Data.Graph
import Data.Tree

toPairs (x:y:xys) = (x,y) : (y,x) : toPairs xys
toPairs _ = []

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  edges <- toPairs.map (pred.read).words <$> getContents
  let gr = buildG (0,n-1) edges
  putStr.unlines.map(unwords.map show).solve.map flatten $ scc gr

solve :: [[Int]] -> [[Int]]
solve vs = go [] [] [] vs
   where
     go vs1 vs2 vs3 ([x,y,z]:rest) = go vs1 vs2 ([x,y,z]:vs3)rest
     go vs1 vs2 vs3 ([x,y]:rest) = go vs1 ([x,y]:vs2) vs3 rest
     go vs1 vs2 vs3 ([x]:rest) = go ([x]:vs1) vs2 vs3 rest
     go vs1 vs2 vs3 []
       | len1 == len2 = map (map (1+)) $ vs3 ++ zipWith(++)vs1 vs2
       | len1 < len2 = [[-1]]
       | (len1-len2)`mod`3/=0 = [[-1]]
       | otherwise = map (map (1+)) $ vs3 ++ slices 3 (concat$drop len2 vs1) ++ zipWith(++)(take len2 vs1)vs2
      where
        len1 = length vs1
        len2 = length vs2
     go _ _ _ _ = [[-1]]

slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs

import Control.Monad (liftM, replicateM)
import Data.Char (ord)
import Data.Graph (buildG, components)
import Data.Tree (flatten)
import Data.List (intercalate)

solve :: Int -> [(Int, Int)] -> Maybe [[Int]]
solve n ps
  | any ((> 3) . length) comp  =  Nothing
  | two > one  =  Nothing
  | otherwise  =  Just ans
  where
    graph  =  buildG (1,n) ps
    comp   =  map flatten $ components graph
    one    =  filter ((== 1) . length) comp
    two    =  filter ((== 2) . length) comp
    three  =  filter ((== 3) . length) comp
    ans    =  three ++ zipWith (++) one two ++ toTuples (drop (length two) (concat one))
    toTuples []  =  []
    toTuples (a:b:c:xs)  =  [a,b,c] : toTuples xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM m readPair
    case solve n ps of
        Nothing  ->  print (-1)
        Just as  ->  mapM_ prints as

  where

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, TupleSections #-}

import Control.Applicative
import Data.List
import Data.Graph
import Data.Tree

toPairs (x:y:xys) = (x,y) : (y,x) : toPairs xys
toPairs _ = []

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  edges <- toPairs.map (pred.read).words <$> getContents
  let gr = buildG (0,n-1) edges
  putStr.unlines.map(unwords.map show).solve.map flatten $ scc gr

solve :: [[Int]] -> [[Int]]
solve vs = go [] [] [] vs
   where
     go vs1 vs2 vs3 ([x,y,z]:rest) = go vs1 vs2 ([x,y,z]:vs3)rest
     go vs1 vs2 vs3 ([x,y]:rest) = go vs1 ([x,y]:vs2) vs3 rest
     go vs1 vs2 vs3 ([x]:rest) = go ([x]:vs1) vs2 vs3 rest
     go vs1 vs2 vs3 []
       | len1 == len2 = map (map (1+)) $ vs3 ++ zipWith(++)vs1 vs2
       | len1 < len2 = [[-1]]
       | (len1-len2)`mod`3/=0 = [[-1]]
       | otherwise = map (map (1+)) $ slices 3 (concat$drop len2 vs1) ++ zipWith(++)(take len2 vs1)vs2
      where
        len1 = length vs1
        len2 = length vs2
     go _ _ _ _ = [[-1]]

slices n xs = map(take n).takeWhile(not.null) $ iterate(drop n)xs