import Data.Graph
main = do
  [n, m]:es <- fmap (map (map read.words).lines) getContents
  let g = buildG (1,n) $ concat [[(x,y),(y,x)] | [x,y] <- es]
  let c = length (components g)
  putStrLn $ if n == m && c == 1 then "FHTAGN!" else "NO"

module Main where

import Control.Monad
import Data.Array.IO
import Data.Array.MArray
import Data.Ix

newDisSet :: (MArray a i m, Ix i) => (i, i) -> m (a i i)
newDisSet b = newListArray b (range b)

rootDisSet :: (MArray a i m, Ix i) => (a i i) -> i -> m i
rootDisSet s i = do
    p <- readArray s i
    if p == i
        then return p
        else do
            p' <- rootDisSet s p
            when ( p' /= p ) $ writeArray s i p'
            return p'

unionDisSet :: (MArray a i m, Ix i) => (a i i) -> i -> i -> m ()
unionDisSet s i j = do
    pi <- rootDisSet s i
    pj <- rootDisSet s j
    when ( pi /= pj ) $ writeArray s pj pi

testDisSet :: (MArray a i m, Ix i) => (a i i) -> i -> i -> m Bool
testDisSet s i j = do
    pi <- rootDisSet s i
    pj <- rootDisSet s j
    return $ pi == pj

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

    res <- if n == m
        then do
            disSet <- newDisSet (1, n) :: IO (IOArray Int Int)
            replicateM m $ do
                [i, j] <- ( map read . words ) `liftM` getLine
                unionDisSet disSet i j
            foldM (\ans i -> ( ans && ) `liftM` testDisSet disSet 1 i) True [2..n]
        else return False
    putStrLn $ if res
        then "FHTAGN!"
        else "NO"

import Data.Graph

findCthulhu :: (Int, Int, [(Int, Int)]) -> String
findCthulhu (vn, en, edges) =
	if vn == en && (length $ components $ buildG (1, vn) edges) == 1
	then "FHTAGN!"
	else "NO"

parseInput :: String -> (Int, Int, [(Int, Int)])
parseInput input = (vn, ve, edges) where
	vn = read $ head $ words $ input
	ve = read $ head $ tail $ words $ input
	edges = pairsFromStrings $ tail $ tail $ words $ input where
		pairsFromStrings [] = []
		pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

main = do
	input <- getContents
	putStr $ findCthulhu $ parseInput input -- "6 5 5 6 4 6 3 1 5 1 1 2"

-- восстановить дерево по входным данным
-- сравнить число ребер с числом вершин и проверить связность (дфс)
--6 6
--6 3
--6 4
--5 1
--2 5
--1 4
--5 4

import Data.Graph

--main = do
--	vn <- read
--	en <- read

--	edges <- map toInteger (words getContents)
--	print $ length $ components $ buildG edges

findCthulhu :: (Int, Int, [(Int, Int)]) -> String
findCthulhu (vn, en, edges) =
	if vn == en && (length $ components $ buildG (1, vn) edges) == 1
	then "FHTAGN!"
	else "NO"

parseInput :: String -> (Int, Int, [(Int, Int)])
parseInput input = (vn, ve, edges) where
	vn = read $ head $ words $ input
	ve = read $ head $ tail $ words $ input
	edges = pairsFromStrings $ tail $ tail $ words $ input where
		pairsFromStrings [] = []
		pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--parseInput :: String -> (Int, Int, [(Int, Int)])
--parseInput input = (fst $ head pairs, snd $ head pairs, (tail pairs)) where
--	pairs = pairsFromStrings $ words input
--	pairsFromStrings [] = []
--	pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--pairsFromStrings :: [String] -> [(Int, Int)]
--pairsFromStrings (f:s:xs) = (read f, read s) : (pairsFromStrings xs)

main = do
	input <- getContents
	putStr $ findCthulhu $ parseInput input --"6 5 5 6 4 6 3 1 5 1 1 2" --" 6 6 3 6 4 5 1 2 5 1 4 5 4"
	--let pairs = pairsFromStrings $ words text
	--in print $ findCthulhu (fst $ head pairs) (snd $ head pairs) (tail pairs)

	--(1, 6) [(6, 3), (6, 4), (5, 1), (2, 5), (1, 4), (5, 4)]

		--[('*', 6, [3, 4]),
		-- ('*', 3, [6]),
		-- ('*', 4, [6, 1, 5]),
		-- ('*', 5, [1, 2, 4]),
		-- ('*', 1, [5, 4]),
		-- ('*', 2, [5])]

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

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

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

main = putStrLn =<< solve . evalState parseInput <$> BS.getContents

solve :: (Int, [(Int,Int)]) -> String
solve (n, edges)
    | n == m && comps == 1 = "FHTAGN!"
    | otherwise            = "NO"
  where
    m = length edges

    graph = buildG (1, n) $ concat [[(x, y), (y, x)] | (x, y) <- edges]

    comps = length $ components graph

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

import Data.List
import Data.String

addEdge' :: Int -> Int -> [[Int]] -> [[Int]]
addEdge' 0 b (g:gs) = ((b:g):gs)
addEdge' a b (g:gs) = g:addEdge' (a-1) b gs

addEdge :: Int -> Int -> [[Int]] -> [[Int]]
addEdge a b g = addEdge' a b $ addEdge' b a g

reachable' :: [Int] -> [[Int]] -> [Int] -> [Int]
reachable' [] g visited = []
reachable' (v:vs) g visited  =  fromv ++ reachable' vs g (fromv ++ visited)
								where fromv  =  if elem v visited
												then []
												else v:reachable' (g!!v) g (v:visited);

reachable :: Int -> [[Int]] -> [Int]
reachable v g = reachable' [v] g []

isConnected :: [[Int]] -> Bool
isConnected g = length g == (length $ reachable 0 g)

isKtulhu :: [[Int]] -> Bool
isKtulhu g = isConnected g && 2 * (length g) == length (concat g)

parse :: String -> [Int]
parse s = [read $ w !! 0, read $ w !! 1] where w = words s

parseGraph' :: [[Int]] -> [String] -> [[Int]]
parseGraph' g []     = g
parseGraph' g (s:sx) = parseGraph' (addEdge (e !! 0 - 1) (e !! 1 - 1) g) sx where e = parse s

parseGraph :: String -> [[Int]]
parseGraph s = parseGraph' (replicate ((parse $ head w) !! 0) []) (tail w) where w = lines s

ktulhuState :: Bool -> String
ktulhuState ktulhu = if ktulhu then "FHTAGN!" else "NO"

main = do
		graphData <- getContents
		putStrLn $ ktulhuState $ isKtulhu $ parseGraph $ graphData

import Data.List
import Data.String

{-
dropEdge' :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge' 0 b (g:gs) = (delete b g):gs
dropEdge' a b (g:gs) = g:dropEdge' (a-1) b gs

dropEdge :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge a b g = dropEdge' a b $ dropEdge' b a g

getCycle'' :: [Int] -> [[Int]] -> [Int] -> [Int]
getCycle'' [] g stack = []
getCycle'' (v:vs) g stack = if aCycle == []
							then getCycle'' vs g stack
							else aCycle
							where aCycle = getCycle' v g stack

getCycle' :: Int -> [[Int]] -> [Int] -> [Int]
getCycle' v g [] 			= 	getCycle'' (g!!v) g [v]
getCycle' v g stack@(s:sx)  =   if elem v sx
					    	   	then v:takeWhile (\x -> not $ x == v) stack
					    	   	else getCycle'' (delete s $ g!!v) g (v:stack)

getCycle :: [[Int]] -> [Int]
getCycle g = getCycle' 0 g []

hasSingleCycle :: [[Int]] -> Bool
hasSingleCycle g =  if aCycle == []
				    then False
					else [] == getCycle (dropEdge (aCycle !! 0) (aCycle !! 1) g)
				    where aCycle = getCycle g-}

addEdge' :: Int -> Int -> [[Int]] -> [[Int]]
addEdge' 0 b (g:gs) = ((b:g):gs)
addEdge' a b (g:gs) = g:addEdge' (a-1) b gs

addEdge :: Int -> Int -> [[Int]] -> [[Int]]
addEdge a b g = addEdge' a b $ addEdge' b a g

reachable' :: [Int] -> [[Int]] -> [Int] -> [Int]
reachable' [] g visited = []
reachable' (v:vs) g visited  =  if elem v visited
							  	then reachable' vs g visited
								else fromv ++ reachable' vs g (fromv ++ visited)
								where fromv = v:reachable' (g!!v) g (v:visited);

reachable :: Int -> [[Int]] -> [Int]
reachable v g = reachable' [v] g []

isConnected :: [[Int]] -> Bool
isConnected g = length g == (length $ reachable 0 g)

isKtulhu :: [[Int]] -> Bool
isKtulhu g = isConnected g && 2 * (length g) == length (concat g)

parse :: String -> [Int]
parse s = [read $ w !! 0, read $ w !! 1] where w = words s

parseGraph' :: [[Int]] -> [String] -> [[Int]]
parseGraph' g []     = g
parseGraph' g (s:sx) = parseGraph' (addEdge (e !! 0 - 1) (e !! 1 - 1) g) sx where e = parse s

parseGraph :: String -> [[Int]]
parseGraph s = parseGraph' (replicate ((parse $ head w) !! 0) []) (tail w) where w = lines s

ktulhuState :: Bool -> String
ktulhuState ktulhu = if ktulhu then "FHTAGN!" else "NO"

main = do
		graphData <- getContents
		putStrLn $ ktulhuState $ isKtulhu $ parseGraph $ graphData

import Data.Graph

solve ((n, _):es) =
  if (length $ components graph) == 1 && n == (length es) then
    "FHTAGN!"
  else
    "NO"
  where graph = buildG (1, n) es

main = interact $ solve.map toEdge.map (map read.words).lines
  where toEdge [x, y] = (x, y)

-- восстановить дерево по входным данным
-- сравнить число ребер с числом вершин и проверить связность (дфс)
--6 6
--6 3
--6 4
--5 1
--2 5
--1 4
--5 4

import Data.Graph

--main = do
--	vn <- read
--	en <- read

--	edges <- map toInteger (words getContents)
--	print $ length $ components $ buildG edges

findCthulhu :: (Int, Int, [(Int, Int)]) -> String
findCthulhu (vn, en, edges) =
	if vn == en && (length $ components $ buildG (1, vn) edges) == 1
	then "FHTAGN!"
	else "NO"

parseInput :: String -> (Int, Int, [(Int, Int)])
parseInput input = (vn, ve, edges) where
	vn = read $ head $ words $ input
	ve = read $ head $ tail $ words $ input
	edges = pairsFromStrings $ tail $ tail $ words $ input where
		pairsFromStrings [] = []
		pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--parseInput :: String -> (Int, Int, [(Int, Int)])
--parseInput input = (fst $ head pairs, snd $ head pairs, (tail pairs)) where
--	pairs = pairsFromStrings $ words input
--	pairsFromStrings [] = []
--	pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--pairsFromStrings :: [String] -> [(Int, Int)]
--pairsFromStrings (f:s:xs) = (read f, read s) : (pairsFromStrings xs)

main = do
	input <- getContents
	print $ findCthulhu $ parseInput input --"6 5 5 6 4 6 3 1 5 1 1 2" --" 6 6 3 6 4 5 1 2 5 1 4 5 4"
	--let pairs = pairsFromStrings $ words text
	--in print $ findCthulhu (fst $ head pairs) (snd $ head pairs) (tail pairs)

	--(1, 6) [(6, 3), (6, 4), (5, 1), (2, 5), (1, 4), (5, 4)]

		--[('*', 6, [3, 4]),
		-- ('*', 3, [6]),
		-- ('*', 4, [6, 1, 5]),
		-- ('*', 5, [1, 2, 4]),
		-- ('*', 1, [5, 4]),
		-- ('*', 2, [5])]

-- восстановить дерево по входным данным
-- сравнить число ребер с числом вершин и проверить связность (дфс)
--6 6
--6 3
--6 4
--5 1
--2 5
--1 4
--5 4

import Data.Graph

--main = do
--	vn <- read
--	en <- read

--	edges <- map toInteger (words getContents)
--	print $ length $ components $ buildG edges

findCthulhu :: (Int, Int, [(Int, Int)]) -> String
findCthulhu (vn, en, edges) =
	if vn == en && (length $ components $ buildG (1, vn) edges) == 1
	then "FHTAGN!"
	else "NO"

parseInput :: String -> (Int, Int, [(Int, Int)])
parseInput input = (vn, ve, edges) where
	vn = read $ head $ words $ input
	ve = read $ head $ tail $ words $ input
	edges = pairsFromStrings $ tail $ tail $ words $ input where
		pairsFromStrings [] = []
		pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--parseInput :: String -> (Int, Int, [(Int, Int)])
--parseInput input = (fst $ head pairs, snd $ head pairs, (tail pairs)) where
--	pairs = pairsFromStrings $ words input
--	pairsFromStrings [] = []
--	pairsFromStrings (f:s:xs) = (read f, read s) : pairsFromStrings xs

--pairsFromStrings :: [String] -> [(Int, Int)]
--pairsFromStrings (f:s:xs) = (read f, read s) : (pairsFromStrings xs)

main = do
	input <- getContents
	print $ findCthulhu $ parseInput input -- "6 6 6 3 6 4 5 1 2 5 1 4 5 4"
	--let pairs = pairsFromStrings $ words text
	--in print $ findCthulhu (fst $ head pairs) (snd $ head pairs) (tail pairs)

	--(1, 6) [(6, 3), (6, 4), (5, 1), (2, 5), (1, 4), (5, 4)]

		--[('*', 6, [3, 4]),
		-- ('*', 3, [6]),
		-- ('*', 4, [6, 1, 5]),
		-- ('*', 5, [1, 2, 4]),
		-- ('*', 1, [5, 4]),
		-- ('*', 2, [5])]

import Data.List
import Data.String

addEdge' :: Int -> Int -> [[Int]] -> [[Int]]
addEdge' 0 b (g:gs) = ((b:g):gs)
addEdge' a b (g:gs) = g:addEdge' (a-1) b gs

addEdge :: Int -> Int -> [[Int]] -> [[Int]]
addEdge a b g = addEdge' a b $ addEdge' b a g

dropEdge' :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge' 0 b (g:gs) = (delete b g):gs
dropEdge' a b (g:gs) = g:dropEdge' (a-1) b gs

dropEdge :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge a b g = dropEdge' a b $ dropEdge' b a g

getCycle'' :: [Int] -> [[Int]] -> [Int] -> [Int]
getCycle'' [] g stack = []
getCycle'' (v:vs) g stack = if aCycle == []
							then getCycle'' vs g stack
							else aCycle
							where aCycle = getCycle' v g stack

getCycle' :: Int -> [[Int]] -> [Int] -> [Int]
getCycle' v g [] 			= 	getCycle'' (g!!v) g [v]
getCycle' v g stack@(s:sx)  =   if elem v sx
					    	   	then v:takeWhile (\x -> not $ x == v) stack
					    	   	else getCycle'' (delete s $ g!!v) g (v:stack)

getCycle :: [[Int]] -> [Int]
getCycle g = getCycle' 0 g []

reachable' :: [Int] -> [[Int]] -> [Int] -> [Int]
reachable' [] g visited = []
reachable' (v:vs) g visited  =  if elem v visited
							  	then []
								else fromv ++ reachable' vs g (fromv ++ visited)
								where fromv = v:reachable' new g (v:visited); new = (g !! v) \\ visited

reachable :: Int -> [[Int]] -> [Int]
reachable v g = reachable' [v] g []

isConnected :: [[Int]] -> Bool
isConnected g = length g == (length $ reachable 0 g)

hasSingleCycle :: [[Int]] -> Bool
hasSingleCycle g =  if aCycle == []
				    then False
					else [] == getCycle (dropEdge (aCycle !! 0) (aCycle !! 1) g)
				    where aCycle = getCycle g

isKtulhu :: [[Int]] -> Bool
isKtulhu g = isConnected g && hasSingleCycle g

parse :: String -> [Int]
parse s = [read $ w !! 0, read $ w !! 1] where w = words s

parseGraph' :: [[Int]] -> [String] -> [[Int]]
parseGraph' g []     = g
parseGraph' g (s:sx) = parseGraph' (addEdge (e !! 0 - 1) (e !! 1 - 1) g) sx where e = parse s

parseGraph :: String -> [[Int]]
parseGraph s = parseGraph' (replicate ((parse $ head w) !! 0) []) (tail w) where w = lines s

ktulhuState :: Bool -> String
ktulhuState ktulhu = if ktulhu then "FHTAGN!" else "NO"

main = do
		graphData <- getContents
		putStrLn $ ktulhuState $ isKtulhu $ parseGraph $ graphData

import Data.List
import Data.String

addEdge' :: Int -> Int -> [[Int]] -> [[Int]]
addEdge' 0 b (g:gs) = ((b:g):gs)
addEdge' a b (g:gs) = g:addEdge' (a-1) b gs

addEdge :: Int -> Int -> [[Int]] -> [[Int]]
addEdge a b g = addEdge' a b $ addEdge' b a g

dropEdge' :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge' 0 b (g:gs) = (delete b g):gs
dropEdge' a b (g:gs) = g:dropEdge' (a-1) b gs

dropEdge :: Int -> Int -> [[Int]] -> [[Int]]
dropEdge a b g = dropEdge' a b $ dropEdge' b a g

getCycle'' :: [Int] -> [[Int]] -> [Int] -> [Int]
getCycle'' [] g stack = []
getCycle'' (v:vs) g stack = if aCycle == []
							then getCycle'' vs g stack
							else aCycle
							where aCycle = getCycle' v g stack

getCycle' :: Int -> [[Int]] -> [Int] -> [Int]
getCycle' v g [] 			= 	getCycle'' (g!!v) g [v]
getCycle' v g stack@(s:sx)  =   if elem v sx
					    	   	then v:takeWhile (\x -> not $ x == v) stack
					    	   	else getCycle'' (delete s $ g!!v) g (v:stack)

getCycle :: [[Int]] -> [Int]
getCycle g = getCycle' 0 g []

reachable' :: [Int] -> [[Int]] -> [Int] -> [Int]
reachable' [] g visited = []
reachable' (v:vs) g visited  =  if elem v visited
							  	then []
								else fromv ++ reachable' vs g (fromv ++ visited)
								where fromv = v:reachable' new g (v:visited); new = (g !! v) \\ visited

reachable :: Int -> [[Int]] -> [Int]
reachable v g = reachable' [v] g []

isConnected :: [[Int]] -> Bool
isConnected g = length g == (length $ reachable 0 g)

hasSingleCycle :: [[Int]] -> Bool
hasSingleCycle g =  if aCycle == []
				    then False
					else [] == getCycle (dropEdge (aCycle !! 0) (aCycle !! 1) g)
				    where aCycle = getCycle g

isKtulhu :: [[Int]] -> Bool
isKtulhu g = isConnected g && 2 * (length g) == length (concat g)

parse :: String -> [Int]
parse s = [read $ w !! 0, read $ w !! 1] where w = words s

parseGraph' :: [[Int]] -> [String] -> [[Int]]
parseGraph' g []     = g
parseGraph' g (s:sx) = parseGraph' (addEdge (e !! 0 - 1) (e !! 1 - 1) g) sx where e = parse s

parseGraph :: String -> [[Int]]
parseGraph s = parseGraph' (replicate ((parse $ head w) !! 0) []) (tail w) where w = lines s

ktulhuState :: Bool -> String
ktulhuState ktulhu = if ktulhu then "FHTAGN!" else "NO"

main = do
		graphData <- getContents
		putStrLn $ ktulhuState $ isKtulhu $ parseGraph $ graphData


import Data.Ord
import Control.Applicative
import Data.List
import Data.IntMap(IntMap,Key)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as B

main = do n <- read <$> getLine
          rs <- map read' <$> B.words <$> B.getLine
          putStrLn $ unlines $ map (unwords.map show) $ solve n $ IM.fromList $ map (\x -> ((fst.head) x,map snd x)) $ groupBy (\ (i,_) (j,_) -> i==j) $ sortBy (comparing fst) $ map (\x -> (length x,head x)) $ group $ sortBy (comparing negate) rs

read' s = let Just (n,_) = B.readInt s
          in n

solve :: Int -> IntMap [Int] -> [[Int]]
solve _ ixs = [(length ans)]:ans
   where ans = map (sortBy (comparing negate)) $ solve' [] ixs
solve' :: [[Int]] -> IntMap [Int] -> [[Int]]
solve' rss ixs = case (f =<< f =<< f =<< (return ([],ixs))) of
                   Nothing -> rss
                   Just (rs@[(x,[r1]),(y,[r2]),(z,[r3])],ixs') -> solve' ([r1,r2,r3]:rss) $ foldl insert' ixs' rs

f :: ([(Key,[Int])],IntMap [Int]) -> Maybe ([(Key,[Int])],IntMap [Int])
f (kxss,ixs) = case (IM.maxViewWithKey ixs) of
          Nothing -> Nothing
          Just ((k,[x]), ixs') -> Just ((k,[x]):kxss, ixs')
          Just ((k,(x:xs)), ixs') -> Just ((k,[x]):kxss, IM.insertWith (++) k xs ixs')

insert' :: IM.IntMap [Int] -> (IM.Key,[Int]) -> IM.IntMap [Int]
insert' ixs (1,_) = ixs
insert' ixs (k,[x]) = IM.insertWith (++) (k-1) [x] ixs

import Data.Ord
import Control.Applicative
import Data.List
import qualified Data.IntMap as IM

main = do n <- read <$> getLine
          rs <- map read <$> words <$> getLine
          putStrLn $ unlines $ map (unwords.map show) $ solve n $ IM.fromList $ map (\x -> ((fst.head) x,map snd x)) $ groupBy (\ (i,_) (j,_) -> i==j) $ sortBy (comparing fst) $ map (\x -> (length x,head x)) $ group $ sortBy (comparing negate) rs

solve :: Int -> IM.IntMap [Int] -> [[Int]]
solve _ ixs = [(length ans)]:ans
   where ans = map (sortBy (comparing negate)) $ solve' [] ixs
solve' :: [[Int]] -> IM.IntMap [Int] -> [[Int]]
solve' rss ixs = case (f =<< f =<< f =<< (return ([],ixs))) of
                   Nothing -> rss
                   Just (rs@[(x,[r1]),(y,[r2]),(z,[r3])],ixs') -> solve' ([r1,r2,r3]:rss) $ foldl insert' ixs' rs

f :: ([(IM.Key,[Int])],IM.IntMap [Int]) -> Maybe ([(IM.Key,[Int])],IM.IntMap [Int])
f (kxss,ixs) = case (IM.maxViewWithKey ixs) of
          Nothing -> Nothing
          Just ((k,[x]), ixs') -> Just ((k,[x]):kxss, ixs')
          Just ((k,(x:xs)), ixs') -> Just ((k,[x]):kxss, IM.insertWith (++) k xs ixs')

insert' :: IM.IntMap [Int] -> (IM.Key,[Int]) -> IM.IntMap [Int]
insert' ixs (1,_) = ixs
insert' ixs (k,[x]) = IM.insertWith (++) (k-1) [x] ixs

import Data.Ord
import Control.Applicative
import Data.List
import qualified Data.IntMap as IM

main = do n <- read <$> getLine
          rs <- map read <$> words <$> getLine
          putStrLn $ unlines $ map (unwords.map show) $ solve n $ IM.fromList $ map (\x -> ((fst.head) x,map snd x)) $ groupBy (\ (i,_) (j,_) -> i==j) $ map (\x -> (length x,head x)) $ group $ sortBy (comparing negate) rs

solve :: Int -> IM.IntMap [Int] -> [[Int]]
solve _ ixs = [(length ans)]:ans
   where ans = map (sortBy (comparing negate)) $ solve' [] ixs
solve' :: [[Int]] -> IM.IntMap [Int] -> [[Int]]
solve' rss ixs = case (f =<< f =<< f =<< (return ([],ixs))) of
                   Nothing -> rss
                   Just (rs@[(x,[r1]),(y,[r2]),(z,[r3])],ixs') -> solve' ([r1,r2,r3]:rss) $ foldl insert' ixs' rs

f :: ([(IM.Key,[Int])],IM.IntMap [Int]) -> Maybe ([(IM.Key,[Int])],IM.IntMap [Int])
f (kxss,ixs) = case (IM.maxViewWithKey ixs) of
          Nothing -> Nothing
          Just ((k,[x]), ixs') -> Just ((k,[x]):kxss, ixs')
          Just ((k,(x:xs)), ixs') -> Just ((k,[x]):kxss, IM.insert k xs ixs')

insert' :: IM.IntMap [Int] -> (IM.Key,[Int]) -> IM.IntMap [Int]
insert' ixs (1,xs) = ixs
insert' ixs (k,xs) = IM.insert k xs ixs

import Control.Applicative ((<$>))
import Data.List (group,sortBy)

main = do
  n <- read <$> getLine
  rs <- map read <$> words <$> getLine
  putStrLn $ solve n $ map (\x->(length x,x)) $ group $ sortBy rev rs

rev :: Int -> Int -> Ordering
rev x y = compare (-x) (-y)

solve :: Int -> [(Int,[Int])] -> String
solve _ rs = unlines $ [(show n)] ++ (map (unwords.map show.sortBy rev) rs')
   where rs' = f $ sortBy (\x y -> rev (fst x) (fst y)) rs
         n = length rs'

f :: [(Int,[Int])] -> [[Int]]
f [] = []
f [x] = []
f [x,y] = []
f (xxs:yys:zzs:wss) = xyz : f xyzs'
   where xyz = map (head.snd) [xxs,yys,zzs]
         xyzs = map (\ (i,xs) -> (pred i,tail xs))  [xxs,yys,zzs]
         xyzs' = foldl (flip insert) wss xyzs

insert :: (Int,[Int]) -> [(Int,[Int])] -> [(Int,[Int])]
insert (_,[]) yss = yss
insert (0,_)  yss = yss
insert (i,xxs@(x:xs)) yss = zss ++ [(i,xxs)] ++ wss
   where (zss,wss) = span (\ (k,(l:_)) -> (k>i)||((k<=i)&&(l>x))) yss

import Control.Applicative
import Data.List

main = do
  n <- read <$> getLine
  rs <- map read <$> words <$> getLine
  putStrLn $ solve n $ group $ sortBy (\x y -> compare (-x) (-y)) rs

solve :: Int -> [[Int]] -> String
solve _ rs = unlines $ [(show n)] ++ (map (unwords.map show) rs')
   where rs' = f rs
         n = length rs'

f [] = []
f [x] = []
f [x,y] = []
f (xxs:yys:zzs:wss) = hxyz:(f $ (filter (not.null) txyzs)++wss)
   where hxyz = map head [xxs,yys,zzs]
         txyzs = map tail [xxs,yys,zzs]


import Data.Maybe

getHalf :: Char -> Char
getHalf c
  | c == 'L' || c == 'R'  = c
  | c == 'U'              = 'D'
  | c == 'D'              = 'U'

solve = do
  n <- readLnInt
  row <- getLine
  putStrLn (map getHalf row)

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

readLnInt :: IO Int
readLnInt = readLn :: IO Int

main = do
  tests <- readLnInt
  loop tests $ do
    solve

readLnInt = readLn :: IO Int

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

main = do
  t <- readLnInt
  loop t $ do
    n <- readLnInt
    s <- getLine
    putStrLn $ map (\c -> if c == 'U' then 'D' else if c == 'D' then 'U' else c) s

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >> map f  <$> getLine >>= putStrLn

f 'U' = 'D'
f 'D' = 'U'
f c = c

import Control.Monad

calc :: String -> String
calc [] = []
calc ['U'] = ['D']
calc ['D'] = ['U']
calc ('L':'R':xs) = ('L':'R':(calc xs))
calc ('R':'L':xs) = ('R':'L':(calc xs))
calc ('U':xs) = ('D':(calc xs))
calc ('D':xs) = ('U':(calc xs))

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    unused <- getLine
    line <- getLine
    putStrLn $ calc line

solve ys []  = reverse ys
solve ys ('U':xs)      = solve('D' : ys ) xs
solve ys ('D':xs)      = solve ('U' : ys ) xs
solve ys ('L':'R':xs)  = solve ('R':'L': ys ) xs
solve ys ('R':'L':xs)  = solve ('L':'R': ys ) xs
main = interact $ unlines . map (solve [] . snd) . filter (odd . fst )  . zip [0..] . tail  . lines

{-# LANGUAGE LambdaCase #-}

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

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = str >> str

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

-- solve :: Input -> Output
solve = map conv
  where
    conv 'D' = 'U'
    conv 'U' = 'D'
    conv c = c

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

readLnInt = readLn :: IO Int

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

main = do
  t <- readLnInt
  loop t $ do
    n <- readLnInt
    s <- getLine
    putStrLn $ map (\c -> if c == 'U' then 'D' else c) s


import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    putStrLn $ solve n l

solve :: Int -> [[Int]] -> String
solve n l =
    if precheck g then
        findAnswer n g
    else
        "-1"
    where
        g = mkGraph n l
        precheck g = and [length (g A.! i) == 4 | i <- [1..n]]

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> String
findAnswer n g = M.fromMaybe ("-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        let g' = f 1
        y <- g' A.! x
        return (dfs x y g')
    return . unwords . map show $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [1])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub n
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! (a A.! x)) && elem v (g A.! (a A.! y)) && elem v (g A.!(a A.! z)) && elem v (g A.! (a A.! w)) in
                b `seq` (b && sub (k-1))

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

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

comm :: [Int] -> [Int] -> Int
comm [] _ = 0
comm _ [] = 0
comm a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> comm at b
    EQ -> succ $ comm at bt
    GT -> comm a bt

ok :: [Int] -> [Int] -> Bool
ok a b = (==2) $ comm a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 || w == -1 then ret else gao w v (w:ret)
        where
          w = head $ (++[-1]) $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | fmap length e /= listArray (1, n) (repeat 4) = []
        | n <= 8    = head $ (++[[]]) $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  if length ans == n
    then putStrLn $ unwords $ map show $ ans
    else putStrLn "-1"

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

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

diff :: [Int] -> [Int] -> [Int]
diff [] _ = []
diff a [] = a
diff a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> ah: diff at b
    EQ -> diff at bt
    GT -> diff a bt

ok :: [Int] -> [Int] -> Bool
ok a b = null $ drop 2 $ diff a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 then ret else gao w v (w:ret)
        where
          w = head $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | n <= 8    = head $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  putStrLn $ unwords $ map show $ ans

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

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

comm :: [Int] -> [Int] -> Int
comm [] _ = 0
comm _ [] = 0
comm a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> comm at b
    EQ -> succ $ comm at bt
    GT -> comm a bt

ok :: [Int] -> [Int] -> Bool
ok a b = (==2) $ comm a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 then ret else gao w v (w:ret)
        where
          w = head $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | n <= 8    = head $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  putStrLn $ unwords $ map show $ ans

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        y <- g A.! x
        if x == y then return [] else return (dfs x y (f x))
    return . B.unwords . map (B.pack . show ) $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]
dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
            in
            let b = elem k (g A.! x) && elem k (g A.! y) && elem k (g A.! z) && elem k (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) [dfs 1 x g | x <- g A.! 1]
    return . B.unwords . map (B.pack . show ) $ l

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
            in
            let b = elem k (g A.! x) && elem k (g A.! y) && elem k (g A.! z) && elem k (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) [dfs 1 x g | x <- g A.! 1]
    return . B.unwords . map (B.pack . show ) $ l

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = True

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        y <- g A.! x
        if x == y then return [] else return (dfs x y (f x))
    return . B.unwords . map (B.pack . show ) $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]
dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! x) && elem v (g A.! y) && elem v (g A.! z) && elem v (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    putStrLn $ solve n l

solve :: Int -> [[Int]] -> String
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> String
findAnswer n g = M.fromMaybe ("-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        let g' = f x
        y <- g' A.! x
        if y == 1 then return [] else return (dfs x y g')
    return . unwords . map show $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [1])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub n
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! (a A.! x)) && elem v (g A.! (a A.! y)) && elem v (g A.!(a A.! z)) && elem v (g A.! (a A.! w)) in
                b `seq` (b && sub (k-1))


import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

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

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 4 >>> map (drop 1 >>> map (words >>> map read) >>> solve >>> show) >>> unlines

solve :: [[Int]] -> Int
solve [[xa, ya], [xb, yb], [xf, yf]]
  | xa == xf && xf == xb && min ya yb <= yf && yf <= max ya yb = gap + 2
  | ya == yf && yf == yb && min xa xb <= xf && xf <= max xa xb = gap + 2
  | otherwise = gap
  where
    gap = abs (xa - xb) + abs (ya - yb)

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    "" <- getLine
    replicateM 3 readIListLn

readIListLn = map read <$> words <$> getLine  :: IO [Int]

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

solve [[ax,ay], [bx,by], [fx,fy]] = show $ dx + dy + obstacle
  where
    minX = min ax bx
    minY = min ay by
    maxX = max ax bx
    maxY = max ay by
    dx = maxX - minX
    dy = maxY - minY
    obstacle | (isCLine && isBetween) = 2 | otherwise = 0
    isCLine = (dx == 0) || (dy == 0)
    isBetween = (minX <= fx && fx <= maxX && minY <= fy && fy <= maxY)
solve _ = error "Bad TC input"

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

calcDistance [xa, ya] [xb, yb] [xf, yf]
  | xf == xa && xa == xb &&
    min ya yb < yf && yf < max ya yb
    = 2 + normalDistance
  | yf == ya && ya == yb &&
    min xa xb < xf && xf < max xa xb
    = 2 + normalDistance
  | otherwise = normalDistance
    where normalDistance = abs (xa - xb) + abs (ya - yb)
calcDistance _ _ _ = error "Should never happen"

main = do
  t <- getInt
  replicateM_ t $ do
    _ <- getLine
    a <- getInts
    b <- getInts
    f <- getInts
    print $ calcDistance a b f

import Control.Monad (replicateM_)

readInts :: IO [Int]
readInts = map read . words <$> getLine

solve [xa, ya] [xb, yb] [xf, yf]
  | dx > 0 && dy > 0 = dx + dy
  | dy == 0 = if yf == ya && xf `inRange` mkRange xa xb then dx + 2 else dx
  | otherwise = if xf == xa && yf `inRange` mkRange ya yb then dy + 2 else dy
  where
    dx = abs (xa - xb)
    dy = abs (ya - yb)
    mkRange a b = [min a b + 1, max a b - 1]
    inRange x [l, r] = x >= l && x <= r

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    a <- readInts
    b <- readInts
    f <- readInts
    print $ solve a b f

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    getLine
    [xa, ya] <- getIntList
    [xb, yb] <- getIntList
    [xc, yc] <- getIntList
    let d = abs (xa - xb) + abs (ya - yb)
    print $ if xa /= xb && ya /= yb
            then d
            else if xc == xa && xc == xb && yc > min ya yb && yc < max ya yb
                 then d + 2
                 else if yc == ya && yc == yb && xc > min xa xb && xc < max xa xb
                      then d + 2
                      else d

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

solve :: IO ()
solve = do
  [_, sa, sb, sf] <- sequence $ replicate 4 getLine
  let [xa, ya] = getints sa
      [xb, yb] = getints sb
      [xf, yf] = getints sf
      oneline = (xa == xb && xb == xf && yf > min ya yb && yf < max ya yb)
                || (ya == yb && yb == yf && xf > min xa xb && xf < max xa xb)
      dist = abs (xa-xb) + abs (ya-yb)
      res = (if oneline then dist + 2 else dist)
    in print res
  where getints s = map read $ words s :: [Int]

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    nothing <- getLine
    [xa,ya] <- readInts
    [xb,yb] <- readInts
    [xf,yf] <- readInts
    print $ abs(xa-xb) + abs(ya-yb) + if (xa == xb && xa == xf && (ya-yf)*(yb-yf) < 0) || (ya == yb && ya == yf && (xa-xf)*(xb-xf) < 0) then 2 else 0

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult


{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Monoid
import Data.Maybe
import Text.Printf

data Max = Max { maxValue :: Int } deriving (Ord, Eq)
data Min = Min { minValue :: Int } deriving (Ord, Eq)

instance Monoid Min where
	mempty = Min maxBound
	mappend = min

instance Monoid Max where
	mempty = Max minBound
	mappend = max

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n - 1) (r + n - 1)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

getInts = map (fst . fromJust . C.readInt) . C.words <$> B.getLine

main = do
	[n, k] ← getInts
	as ← getInts

	let maxTree = build $ map Max as
	let minTree = build $ map Min as

	let diff i j = maxValue (query maxTree i j) - minValue (query minTree i j)

	let maxBooksCount i j
		| i == n + 1 = 1
		| otherwise = max (j' - i + 1) (maxBooksCount (i + 1) j')
			where
				j' = last $ takeWhile (\j'' → diff i j'' <= k) [(max i j)..n]

	let m = maxBooksCount 1 1

	let is = [(i, j) | i ← [1..n], let j = i + m - 1, j <= n, diff i j <= k]

	printf "%d %d\n" m (length is)
	sequence $ map (uncurry $ printf "%d %d\n") is

module Main where

import qualified Data.ByteString.Char8 as BS

import Data.Maybe (fromJust)
import Control.Monad (forM_)
import Data.Array.Unboxed
import qualified Data.Set as S

main :: IO ()
main = do
    [n, k] <- ints
    hs <- listArray (1, n) <$> ints
    let (m, series) = solve hs k
    p (m, length series)
    forM_ series p
  where
    p (a, b) = putStrLn $ show a <> " " <> show b

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

solve :: UArray Int Int -> Int -> (Int, [(Int, Int)])
solve hs k = go (from, from + 1) (0, []) $ S.singleton (hs ! from, from)
  where
    (from, to) = bounds hs
    n = to - from + 1

    update i@(l, r) res@(m, s)
      | p > m = (p, [i])
      | p == m = (m, i:s)
      | otherwise = res
      where p = r - l + 1

    go (l, r) res acc
      | r > to = commitPred
      | fst (S.findMax accR) - fst (S.findMin accR) <= k = go (l, r + 1) res accR
      | otherwise = go (l + 1, r) commitPred (S.delete (hs ! l, l) accR)
      where
        commitPred = update (l, r - 1) res
        accR = S.insert (hs ! r, r) acc


{-# LANGUAGE FlexibleContexts #-}
import           Data.Bits
import qualified Data.ByteString.Lazy          as B
import qualified Data.ByteString.Lazy.Char8    as BC
import           Data.List
import           Data.Maybe
import qualified Data.Set                      as S

bread = fst . fromJust . BC.readInt

solve (n, xs) =
  let (r, _, _) =
        foldl' solve' (0, 0, S.fromList [0]) (map bread $ BC.words xs)
  in  BC.pack $ show $ bread n - r
 where
  solve' :: (Int, Int, S.Set Int) -> Int -> (Int, Int, S.Set Int)
  solve' (c, xr, s) x = (c', xr', xr' `S.insert` s')
   where
    xr'      = xr `xor` x
    (c', s') = if xr' `S.member` s then (c + 1, S.empty) else (c, s)

pairs (x : y : xs) = (x, y) : pairs xs
pairs _            = []

main = B.interact $ BC.unlines . map solve . pairs . tail . BC.lines

{-# LANGUAGE FlexibleContexts #-}
import           Data.Bits
import           Data.List
import qualified Data.Set                      as S

solve :: (String, String) -> String
solve (n, xs) =
  let (r, _, _) =
        foldl' solve' (0, 0, S.fromList [0]) (map read $ words xs)
  in  show $ read n - r
 where
  solve' :: (Int, Int, S.Set Int) -> Int -> (Int, Int, S.Set Int)
  solve' (c, xr, s) x = (c', xr', xr' `S.insert` s')
   where
    xr'      = xr `xor` x
    (c', s') = if xr' `S.member` s then (c + 1, S.empty) else (c, s)

pairs (x : y : xs) = (x, y) : pairs xs
pairs _            = []

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


{-# LANGUAGE MultiWayIf #-}
import Control.Monad
import Control.Applicative
import Data.List

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    n <- read <$> getLine :: IO Int
    a0 : a1 : a2 : as <- map read . words <$> getLine :: IO [Int]
    let
      (x0, i0, y0, j0, z0, k0)
        | a0 <= a1 = if
          | a1 <= a2 -> (a0, 1, a1, 2, a2, 3)
          | a0 <= a2 -> (a0, 1, a2, 3, a1, 2)
          | otherwise -> (a2, 3, a0, 1, a1, 2)
        | a0 <= a2 = (a1, 2, a0, 1, a2, 3)
        | a1 <= a2 = (a1, 2, a2, 3, a0, 1)
        | otherwise = (a2, 3, a1, 2, a0, 1)

      (x, i, y, j, z, k) = foldl' f (x0, i0, y0, j0, z0, k0) $ zip as [4..]
      f (x, i, y, j, z, k) (a, l)
        | a > z = (x, i, y, j, a, l)
        | a < x = (a, l, x, i, z, k)
        | a < y = (x, i, a, l, z, k)
      f xxx _ = xxx

    if x + y <= z then
      putStrLn $ show i ++ " " ++ show j ++ " " ++ show k
    else
      putStrLn "-1"

input :: IO [Int]
input = do
    line <- getLine
    return (map read (words line))

solve 0 = do return ()

solve t = do
    [n] <- input
    a <- input
    putStrLn $
        if a !! 0 + a !! 1 <= a !! (n - 1)
        then "1 2 " ++ show n
        else "-1"
    solve (t - 1)

main = do
    [n] <- input
    solve n

import Data.List

convertToInt :: String -> Int
convertToInt = read

readOneInt :: IO Int
readOneInt = do
    line_ <- getLine
    return $ convertToInt line_

readLineInts :: IO [Int]
readLineInts = do
    line_ <- getLine
    return $ map convertToInt $ words line_

convertIntsToLine :: [Int] -> String
convertIntsToLine [] = ""
convertIntsToLine (x:xs) = (show x) ++ " " ++ (convertIntsToLine xs)

main :: IO ()
main = do
    -- read t
    t <- readOneInt
    for t where
        for 0 = return ()
        for t' = do
            _ <- readOneInt
            ints <- readLineInts
            let nums = zip ints [1,2..]
            let sorted = sortBy (\(a,_) (b,_) -> compare a b) nums
            let (alpha:beta:last_) = sorted
            let theta = last last_
            putStrLn $ if (fst alpha) + (fst beta) <= (fst theta)
                then convertIntsToLine $ sort (snd (unzip [alpha, beta, theta]))
                else "-1"
            for (t'-1)

import Control.Monad

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

routine :: IO ()
routine = do
  n <- readLn
  as <- (map read.words) <$> getLine
  (putStrLn.unwords.map show) $ solve n as

solve :: Int -> [Int] -> [Int]
solve n (a:a':as)
  | a+a' > last as = [-1]
  | otherwise = [1,2,n]

{-# LANGUAGE ViewPatterns #-}

import Data.List

solveOne :: [Int] -> String
solveOne (splitAt 2 -> (s, e)) = maybe "-1" (("1 2 " ++) . show . (+3)) $ findIndex (>= sum s) e

main = interact $ unlines . fmap (solveOne . fmap read . words) . evens . tail . lines

evens (_:x:xs) = x:evens xs
evens a = a

import Data.List
main :: IO ()
main = do
    t <- readLn :: IO Int
    solveCases t
solveCases :: Int -> IO ()
solveCases 0 = return ()
solveCases t = do
    (n, a) <- readCaseData
    putStrLn $ intercalate " " $ map show $ getTestCaseAnswer n a
    solveCases (t - 1)
readCaseData :: IO (Int, [Int])
readCaseData = do
    n <- readLn :: IO Int
    a <- getLine
    return (n, map read (words a))
checkArray :: Int -> [Int] -> Bool
checkArray n a = x + y <= z
    where x = a !! 0
          y = a !! 1
          z = a !! (n - 1)
getTestCaseAnswer :: Int -> [Int] -> [Int]
getTestCaseAnswer n a = if checkArray n a
                        then [1, 2, n]
                        else [-1]

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

isTriangle :: (Int, Int, Int) -> Bool
isTriangle (a, b, c) = c < (a + b)

solve :: [Int] -> Maybe (Int, Int, Int)
solve as =
    if isTriangle triple
        then Nothing
        else Just tripleIndices
    where
        tripleIndices = (1, 2, length as)
        triple = (as !! 0, as !! 1, last as)

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        as <- map readIntB8 <$> B8.words <$> B8.getLine
        let answer = solve as
        case answer of
           Just (i, j, k) -> printf "%d %d %d\n" i j k
           _ -> printf "-1\n"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b <= c = Just (1,2,fromIntegral $ length xs)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int]
solve p@(x:y:xs)
    | length xs < 1 = [-1, -1, -1]
    | x + y <= last xs = [1, 2, length p]
    | otherwise = [-1, -1, -1]

output :: [Int] -> [String]
output [-1, -1, -1] = ["-1"]
output xs = map show xs

myshow :: [String] -> String
myshow (x:xs)
    | null xs = x
    | otherwise = x ++ " " ++ myshow xs

deal :: IO()
deal = do
    getLine
    x <- map read . words <$> getLine
    putStrLn $ myshow $ output $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read

{-# LANGUAGE TypeApplications, ViewPatterns #-}

import Data.List

solveOne :: [Int] -> String
solveOne (splitAt 2 -> (s, e)) = maybe "-1" (("0 1 " ++) . show . (+2)) $ findIndex (>= sum s) e

main = interact $ unlines . fmap (solveOne . fmap read . words) . evens . tail . lines

evens (_:x:xs) = x:evens xs
evens a = a

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b < c = Just (1,2,fromIntegral $ length xs)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b < c = Just (a,b,c)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs


solve :: Int -> IO ()
solve _ = do
    s <- getLine
    let cnt_a = length . filter (== 'A') $ s
        cnt_b = length . filter (== 'B') $ s
        cnt_c = length . filter (== 'C') $ s
    if (cnt_a + cnt_c == cnt_b) then putStrLn "YES" else putStrLn "NO"

main = do
    tc <- getLine
    let testcase = read tc :: Int
    mapM_ solve [1..testcase]

import Control.Monad ( replicateM_ )
solve = do
    x <- getLine
    putStrLn $ if length x == 2 * (length . filter (== 'B') $ x) then "YES" else "NO"

main = readLn >>= flip replicateM_ solve

import Control.Monad
import Data.List

calc :: String -> String
calc str =
  let (a,b,c) = foldl (\(a,b,c) x ->
                         if x == 'A' then (a+1,b,c)
                         else if x == 'B' then (a,b+1,c)
                         else (a,b,c+1)
                         ) (0,0,0) str
  in
    if (a+c) == b then "YES"
    else "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    putStrLn $ calc line

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude
import System.IO
import Control.Monad
import Data.List

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering

    t <- readLn
    tcs <- replicateM t getLine

    (putStrLn . unlines . map (showB . solve)) tcs

showB False = "NO"
showB True  = "YES"

solve = f . map (flip (-) 1 . length) . group . sort . (++ "ABC")
  where
    f :: [Int] -> Bool
    f [a, b, c] = (b == a + c)
    f _         = error "letter set"

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    putStrLn . yesOrNo $ (c 'B' s == c 'A' s + c 'C' s)

c :: (Eq a) => a -> [a] -> Int
c e = length . filter (e ==)

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- getNext 1
    let
      [ctA, ctB, ctC] = [P.count c s | c <- "ABC"]
    pure $ string7 $ if  ctA + ctC == ctB
      then "YES\n"
      else "NO\n"

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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 mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

    main=let a=length.(filter(=='A'))
             b=length.(filter(=='B'))
             c=length.(filter(=='C'))
             a2bc x=if a x + c x - b x==0 then "YES" else "NO"
            in interact$unlines.map a2bc.tail.lines

count :: Eq a => a -> [a] -> Int
count x = length . filter (x ==)

solve :: Int -> IO ()
solve _ = do
    s <- getLine
    putStrLn $ if (count 'A' s) + (count 'C' s) == (count 'B' s) then "YES" else "NO"

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]


--ghc 7.10

import Data.List(findIndices)

operate :: (Int,Int,Char,Char) -> String -> String
operate (l,r,c1,c2) str = map (\(i,c) -> if c == c1 && i >= l && i <= r then c2 else c) . zip [1..] $ str

operateAll operands str = foldl (\acc x -> operate x acc) str operands

readLine x = (l,r,c1,c2)
    where
        [l',r',c1',c2'] = words x
        l = read l' :: Int
        r = read r' :: Int
        c1 = head c1'
        c2 = head c2'

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    s <- getLine
    contents <- getContents
    let operands = map readLine . lines $ contents
    putStrLn $ operateAll operands s

import Data.Array
import Control.Monad
main = do
  [n,m] <- map read . words <$> getLine
  s <- listArray (1,n) <$> getLine
  s' <- foldl f s <$> replicateM m getLine
  putStrLn (elems s')
f s ws = s // map g [read l..read r] where
  [l,r,[c1],[c2]] = words ws
  g i | v == c1 = (i,c2)
      | otherwise = (i,v)
    where v = s!i

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T

process s [l,r,c1,c2] = T.concat [(T.take (ll-1) s) , (T.replace (T.pack c1) (T.pack c2) (T.drop (ll-1) (T.take rr s)) ) , T.drop (rr)  s]
	where	ll= read l ::Int
		rr= read r ::Int

main= do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		s<- T.pack <$> getLine
		c<-  map words <$> replicateM m getLine
		putStrLn$ T.unpack $ foldl process s c

main = interact $ unlines . parse . lines

parse (_:s:ops') = sol s ops
  where
    ops = map (fn . words) ops'
    fn :: [String] -> (Int, Int, Char, Char)
    fn [b, e, f, t] = (read b, read e, head f, head t)

sol s ops = [ foldl makeOp s ops ]
  where
    makeOp :: String -> (Int, Int, Char, Char) -> String
    makeOp s (b, e, f, t) = let
        (tmp, end) = splitAt e s
        (beg, mid) = splitAt (b-1) tmp
        midr = map replacer mid
        replacer x = if x == f then t else x
      in beg ++ midr ++ end


import qualified Data.ByteString.Char8 as B
import Data.Ix
import Data.Char
import Text.Printf
import qualified Data.List as L
import qualified Data.Array as A

main :: IO()
main = do l <- B.getLine
          putStrLn $ solve l

solve :: B.ByteString -> String
solve = mkDate . snd . last . L.sort . map mkPair . L.group . L.sort . filter correctDate . findDates

findDates :: B.ByteString -> [(Int,Int,Int)]
findDates = L.foldl' accum [] . B.tails
    where
        accum e str = case match str of
                        Nothing   -> e
                        Just date -> date:e
        match str = do day   <- matchDay token0
                       month <- matchMonth token1
                       year  <- matchYear  token2
                       return (day,month,year)
            where (token0,str1) = B.span (/='-') str
                  (token1,str2) = B.span (/='-') (if B.length str1 > 0 then B.tail str1 else B.empty)
                  token2       = B.take 4 (if B.length str2 > 0 then B.tail str2 else B.empty)
        matchDay   = matchToken 2
        matchMonth = matchToken 2
        matchYear  = matchToken 4 . B.take 4
        matchToken n str | B.length str == n && B.all isDigit str = Just (B.foldl' (\ x c -> x*10+ digitToInt c) 0 str)
                         | otherwise = Nothing

correctDate :: (Int,Int,Int) -> Bool
correctDate (day,month,year) = correctDayAndMonth month day && correctYear year

correctDayAndMonth month day = inRange (1,12) month && inRange (1,calendar A.! month) day
    where calendar = A.array (1,12) [(1,31),(2,28),(3,31),(4,30),(5,31),(6,30),
                                     (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

correctYear = inRange (2013,2015)

mkPair :: [(Int,Int,Int)] -> (Int,(Int,Int,Int))
mkPair l = (length l,head l)

mkDate :: (Int,Int,Int) -> String
mkDate (day,month,year) = printf "%02d-%02d-%04d" day month year

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

dom :: UArray Int Int
dom = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

parse :: C.ByteString -> Maybe C.ByteString
parse s =
  if C.elemIndices '-' s == [2, 5]
      && 2013 <= y && y <= 2015
      && 1 <= m && m <= 12
      && 1 <= d && d <= dom!m
    then Just s
    else Nothing
  where
    readInt = maybe 0 fst . C.readInt
    [d, m, y] = map readInt $ C.split '-' s

main :: IO ()
main = do
  input <- C.getLine
  let date = catMaybes $ map (parse . C.take 10) $ C.tails input
  C.putStrLn $ snd $ maximum $ map (liftA2 (,) length head) $ group $ sort $ date

import Control.Monad (liftM)
import Data.Map (assocs, empty, insertWith, singleton)
import Data.Char (ord)
import Data.List (intercalate, maximumBy)

solve :: String -> String
solve s  =  solve' empty s
  where
    solve' map ""  =  fst $ maximumBy compareSnd $ assocs map
    solve' map ss@(d1:d2:'-':m1:m2:'-':y1:y2:y3:y4:s)
      | any (== '-') [d1, d2, m1, m2, y1, y2, y3, y4]  =  solve' map (tail ss)
      | correctDate y m d  =  solve' map' $ tail ss
      | otherwise  =  solve' map $ tail ss
      where
        d  =  read [d1, d2]
        m  =  read [m1, m2]
        y  =  read [y1, y2, y3, y4]
        map'  =  insertWith (+) (take 10 ss) 1 map
    solve' map ss  =  solve' map $ tail ss
    compareSnd (a, b) (c, d)  =  compare b d
    correctDate y m d
      =  2013 <= y && y <= 2015
      && 1 <= m && m <= 12
      && 1 <= d && d <= mounthDays m
    mounthDays 2  =  28
    mounthDays m
      | m `elem` [4,7,9,11]  =  30
      | otherwise  =  31

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

import qualified Data.Map as Map
import Data.Char
import Data.List

days = [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

correctDate d m y =
  2013 <= y && y <= 2015 &&
  1    <= m && m <= 12   &&
  1    <= d && d <= days !! m

collectDates (d1:d2:t1:m1:m2:t2:y1:y2:y3:y4:rest)
  | correct   = [d1, d2, t1, m1, m2, t2, y1, y2, y3, y4]:collectDates next
  | otherwise = collectDates next
  where correct = [t1, t2] == "--" && allDigits && correctDate d m y
        allDigits = all isDigit [d1, d2, m1, m2, y1, y2, y3, y4]
        d = read [d1, d2]
        m = read [m1, m2]
        y = read [y1, y2, y3, y4]
        next = d2:t1:m1:m2:t2:y1:y2:y3:y4:rest

collectDates _ = []

solve xs = fst $ maximumBy (\(_, x) (_, y) -> compare x y) $ map (\x -> (head x, length x)) $ group dates
  where dates = sort $ collectDates xs

main = interact solve

{-# OPTIONS_GHC -O2 #-}

import Data.Array.Base
import Data.Array.IO (IOUArray)
import Text.Printf

main = getLine >>= solve

isNum c = '0'<=c && c<='9'

solve cs = do
  arr <- newArray (0,50000) 0 :: IO (IOUArray Int Int)
  let f (d1:d2:'-':m1:m2:'-':'2':'0':'1':y4:rest)
        | '3'<=y4 && y4<='5' && all isNum [d1,d2,m1,m2] && isDate m d=unsafeRead arr ymd>>=unsafeWrite arr ymd.(1+)>>f ('1':y4:rest)
       where
         d=read[d1,d2]
         m=read[m1,m2]
         y=read$'2':'0':'1':[y4]
         ymd=(y-2013)*10000+m*100+d
      f (_:cs) = f $ dropWhile ('-'==) cs
      f _ = getElems arr>>=putStrLn.showAns.maximum.(`zip`[0..])
  f cs

showAns :: (Int,Int) -> String
showAns (_,ymd) = printf"%02d-%02d-%4d" d m y
   where
     y = 2013 + ymd`div`10000
     m = ymd`mod`10000`div`100
     d = ymd`mod`100

isDate :: Int -> Int -> Bool
isDate m d = 1<=m && m<=12 && 1<=d && d<=dmax
   where
     dmax = [31,28,31,30,31,30,31,31,30,31,30,31]!!(m-1)

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

mon = [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

main = getLine >>= putStrLn.snd.maximum.map (\x -> (length x, head x)).group.sort.all_date
--main = getLine >>= putStrLn.show.all_date

get_int s x = foldl (\a b -> a*10 + (ord (s !! b) - 48)) 0 x

valid_date :: String -> Bool
valid_date s = 	2013 <= yy && yy <= 2015 && 1 <= mm && mm <= 12 && 1 <= dd && dd <= (mon !! mm)
			   where
			    dd = get_int s [0,1];
				mm = get_int s [3,4];
				yy = get_int s [6..9];

check :: String -> Maybe String
check s = if length s == 10 && '-' `elemIndices` s == [2,5] then
			if valid_date s then Just s else Nothing
		  else Nothing

all_date :: String -> [String]
all_date x = catMaybes $ filter (\x -> x /= Nothing) $ map (check.take 10) $ tails x

import Data.List (tails, elemIndices, sort, group, maximum)
import Data.Array.Unboxed
import Data.Maybe (catMaybes)

splitHelper c [] = ([], [])
splitHelper c (x:rest) = if x == c
                           then ([], rest)
                           else let (a, r) = splitHelper c rest in (x:a, r)

split c [] = []
split c s = let (a, r) = splitHelper c s
              in a : split c r

findDate :: String -> Maybe [Int]
findDate l = if elemIndices '-' l == [2,5]
               then Just (map (read :: String -> Int) $ split '-' l)
               else Nothing

dmc :: UArray Int Int
dmc = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

validDay :: Int -> Int -> Bool
validDay d m = 1 <= d && d <= (dmc!m)

validDate :: [Int] -> Bool
validDate [d, m, y] = 2013 <= y && y <= 2015 &&
                             1 <= m && m <= 12 &&
                             validDay d m

showD n = let m = (show n) in if (length m == 1) then '0': m else m

prettyDate (_, [d, m, y]) = (showD d) ++ "-" ++ (showD m) ++ "-" ++ (show y)

main = do
  str <- getLine
  putStrLn $ (prettyDate . maximum . map (\x -> (length x, head x)) . group . sort .
              filter validDate . catMaybes . map (findDate . take 10) . tails) str

import Data.List (tails, elemIndices, sort, group, maximum)
import Data.Array.Unboxed
import Data.Maybe (catMaybes)

splitHelper c [] = ([], [])
splitHelper c (x:rest) = if x == c
                           then ([], rest)
                           else let (a, r) = splitHelper c rest in (x:a, r)

split c [] = []
split c s = let (a, r) = splitHelper c s
              in a : split c r

findDate :: String -> Maybe [Int]
findDate l = if elemIndices '-' l == [2,5]
               then Just (map (read :: String -> Int) $ split '-' l)
               else Nothing

dmc :: UArray Int Int
dmc = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

validDay :: Int -> Int -> Bool
validDay d m = 1 <= d && d <= (dmc!m)

validDate :: [Int] -> Bool
validDate [d, m, y] = 2013 <= y && y <= 2015 &&
                             1 <= m && m <= 12 &&
                             validDay d m

prettyDate (_, [d, m, y]) = (show d) ++ "-" ++ (show m) ++ "-" ++ (show y)

main = do
  str <- getLine
  putStrLn $ (prettyDate . maximum . map (\x -> (length x, head x)) . group . sort .
              filter validDate . catMaybes . map (findDate . take 10) . tails) str


import Data.Bits
import Data.List

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

solve :: [Int] -> Int
solve = maximum . map (maximum . map (foldl xor 0) . tails) . inits

import Data.List
import Data.Bits

xorSegment xs i j = foldl xor 0 $ take (j - i + 1) $ drop i xs

solve :: [Int] -> Int
solve xs = maximum [(xorSegment xs i j) | i <- [0 .. n], j <- [i .. n]]
  where n = length xs

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

import Data.List
import Data.Bits

xorSegment xs i j = foldl' xor 0 $ take (j - i + 1) $ drop i xs

solve :: [Int] -> Int
solve xs = foldl' max 0 [(xorSegment xs i j) | i <- [0 .. n], j <- [i .. n]]
  where n = length xs

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

import Data.Bits
main = getContents>>=print.solve.map read.tail.words

solve :: [Int] -> Int
solve xs = maximum $ ys ++ [y1`xor`y2|y1<-ys,y2<-ys]
   where
     ys = scanl1 xor xs

import Data.Bits
main = getContents >>= print.solve.map read.tail.words

solve :: [Int] -> Int
solve [] = 0
solve ls = maximum [(fst (foldl (\(x,y) z -> (maximum [x,y `xor` z], y `xor` z)) (0,0) ls)), (solve (tail ls)) ]

import Data.Bits(xor)

main = do
    n <- getLine
    ar <- getLine
    let ls = map read (words ar) :: [Int]
    print $ foreachXor ls

foreachXor [] = 0
foreachXor xs'@(x:xs) = maxXor (x:xs) 0 `max` foreachXor xs

maxXor [] _ = 0
maxXor (x:xs) s = currentXor `max` maxXor xs currentXor
    where currentXor = xor x s

import Data.Bits
main = do
  (n : input) <- fmap (map read . words) getContents
  let par = scanl1 xor (input :: [Int]) ++ [0]
  print $ maximum [x `xor` y | x <- par, y <- par]

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Bits.html

import Data.Bits

maxXor :: [Int] -> Int
maxXor [] = 0
maxXor a = max (maxPrefixXor a 0) (maxXor (tail a))

maxPrefixXor :: [Int] -> Int -> Int
maxPrefixXor [] x = x
maxPrefixXor (a : b) x = max (xor a x) (maxPrefixXor b (xor a x))

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	let list = map read (words str2)
	putStrLn (show (maxXor (list)))

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Data.Bits (xor)
import Prelude hiding (reads)

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

solve :: Int -> [Int] -> Int
solve n xs  =  maximum [foldl1 xor [a ! k | k <- [i .. j]] | i <- [1 .. n], j <- [i .. n]]
  where
    a  =  listArray (1, n) xs

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  reads
    print $ solve n xs

-- Codeforces 252B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

readInt :: BC.ByteString -> Int
readInt !s = case BC.readInt s of Just (n, _) -> n

main :: IO ()
main = do
    (x:xs) <- (map readInt . BC.words) <$> BC.getContents :: IO [Int]
    let ys = scanl1 xor (0:xs)
    print $ maximum [x `xor` y | x <- ys, y <- ys]

-- Codeforces 252B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

readInt :: BC.ByteString -> Int
readInt !s = case BC.readInt s of Just (n, _) -> n

main :: IO ()
main = do
    (x:xs) <- (map readInt . BC.words) <$> BC.getContents :: IO [Int]
    let ys = scanl1 xor xs
    print $ maximum [x `xor` y | x <- ys, y <- ys]

import Data.Bits(xor)

main = do
    n <- getLine
    ar <- getLine
    let lsAr = map read (words ar) :: [Int]
    print $ maximum $ maximum lsAr : maxXor lsAr 0 ++ maxXor (reverse lsAr) 0

maxXor [] _ = []
maxXor (x:xs) s = currentXor : maxXor xs currentXor
    where currentXor = xor x s

import Data.Bits
main = do
  (n : input) <- fmap (map read . words) getLine
  let par = scanl1 xor (input :: [Int]) ++ [0]
  print $ maximum [x `xor` y | x <- par, y <- par]