{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	-- foldM' (\!s !i -> readArray f i) 0 $ takeWhile (>= 0) $ iterate (\ !i -> i .&. (i + 1) - 1) i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let next (I# i) = I# (i `orI#` (i +# 1#))
	-- let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	let is = takeWhile (<= l) $ iterate next i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
a `orI#` b = word2Int# (int2Word# a `or#` int2Word# b)

query f (-1) = return 0
query f i = do
	-- let next i = (i .&. (i+1)) - 1
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	-- sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	foldM' (\s i -> (s+) <$> (readArray f i)) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
{-# OPTIONS_GHC -fvia-C -optc-O2 #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let next (I# i) = I# (i `orI#` (i +# 1#))
	-- let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	let is = takeWhile (<= l) $ iterate next i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
a `orI#` b = word2Int# (int2Word# a `or#` int2Word# b)

query f (-1) = return 0
query f i = do
	-- let next i = (i .&. (i+1)) - 1
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	-- sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	foldM' (\s i -> (s+) <$> (readArray f i)) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	-- foldM' (\s i -> readArray f i) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((word2Int# ((int2Word# i) `and#` (int2Word# (i +# 1#)))) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	-- foldM' (\!s !i -> readArray f i) 0 $ takeWhile (>= 0) $ iterate (\ !i -> i .&. (i + 1) - 1) i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	-- sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	foldM' (\s i -> (s+) <$> (readArray f i)) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let next (I# i) = I# (i `orI#` (i +# 1#))
	-- let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	let is = takeWhile (<= l) $ iterate next i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
a `orI#` b = word2Int# (int2Word# a `or#` int2Word# b)

query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	-- sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	foldM' (\s i -> (s+) <$> (readArray f i)) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

import Data.Graph
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, words, lines)
import Prelude hiding (getLine, words, lines)

readInts = map (fst . fromJust . readInt) . words <$> getLine

solve n edges queries = "ok"

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

{-# LANGUAGE BangPatterns, MagicHash #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple
import GHC.Prim
import GHC.Types

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

a `andI#` b = word2Int# (int2Word# a `and#` int2Word# b)
query f (-1) = return 0
query f i = do
	let next (I# i) = I# ((i `andI#` (i +# 1#)) -# 1#)
	-- let next (I# i) = I# $ word2Int# $ (int2Word# i) or# (int2Word# i)
	-- sum <$> (mapM (readArray f) $ takeWhile (>= 0) $ iterate next i)
	foldM' (\s i -> readArray f i) 0 $ takeWhile (>= 0) $ iterate next i
{-query f i = query1 f i 0

query1 f i r
	| i < 0 = return r
	| otherwise = do
		v <- readArray f i
		query1 f i' (r + v)
	where
		i' = i .&. (i + 1) - 1

query'' f !i
	| i < 0 = return 0
	| otherwise = do
		v <- readArray f i
		r <- query f i'
		return $ v + r
	where
		i' = i .&. (i + 1) - 1 -}

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		reverse <$> foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let !d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Debug.Trace
import Data.Array
import Data.Array.ST
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Graph
import Data.List
import Data.Maybe
import Data.Tree
import Data.Tuple

type Fenwick s = STUArray s Int Int
fenwick l = newArray (0, l-1) 0 :: ST s (Fenwick s)

update f i d = do
	l <- snd <$> getBounds f
	let is = takeWhile (<= l) $ iterate (\i -> i .|. (i + 1)) i
	forM_ is $ \i -> do
		v <- readArray f i
		writeArray f i (v + d)
	return f

query f (-1) = return 0
query f i = do
	let is = takeWhile (>= 0) $ iterate (\i -> i .&. (i + 1) - 1) i
	vs <- mapM (readArray f) is
	return $ sum vs

unordered edges = edges ++ map swap edges

solve n edges queries = runST $ do
		fenwicksList <- mapM (fenwick . length) paths

		let
			fenwicks = listArray (1, length paths) fenwicksList

		foldM (\rs q -> case q of
			[t, edgeIndex] -> do
				let
					(fenwicksIndex, index) = edgesPlaces edgeIndex
					fenwick = fenwicks ! fenwicksIndex
				update fenwick index (if t == 1 then -1 else 1)
				return rs
			[3, i, j] -> do
				let (i1, j1) = places ! i
				let (i2, j2) = places ! j
				s1 <- query (fenwicks ! i1) j1
				s2 <- query (fenwicks ! i2) j2

				let d = if i1 == i2
                                        then if s1 == s2 then abs (j1 - j2) else -1
					else if s1 + s2 == 0 then j1 + j2 + 2 else -1
				return $ d : rs) [] queries

	where
		g = buildG (1, n) (unordered edges)
		root = fromMaybe 1 $ find (\i -> indegree g ! i > 2) [1..n]
		paths = map flatten $ subForest $ head $ dfs g [root]

		parents = accumArray (flip const) 0 (1, n) $ concat [path `zip` (root:path) | path <- paths]

		places = accumArray (flip const) (1, -1) (1, n) $
			[(vertex, (pathIndex, index)) | (path, pathIndex) <- paths `zip` [1..],
				(vertex, index) <- path `zip` [0..]]

		edges' = listArray (1, length edges) edges
		edgesPlaces edgeIndex = places ! k
			where
				(i, j) = edges' ! edgeIndex
				k = if parents ! i == j then i else j

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

main = do
	[n] <- readInts
	edges <- map (\[a, b] -> (a, b)) <$> replicateM (n - 1) readInts
	[m] <- readInts
	queries <- replicateM m readInts
	putStrLn $ unlines $ map show $ solve n edges queries


import Control.Applicative
import Control.Monad
import Data.IORef
import Data.Array.IO.Safe
import qualified Data.Set

data Tree = Nil | Inner Tree Tree Int | Leaf (Data.Set.Set Int) Bool deriving Show

treeWidth = 2 ^ 10

makeInner :: Int -> Tree -> Tree -> Tree
makeInner w l r = Inner l r (getSum w l + getSum w r)

getSum :: Int -> Tree -> Int
getSum _ Nil = 0
getSum _ (Inner _ _ s) = s
getSum w (Leaf s rev) = let sz = Data.Set.size s in if rev then w - sz else sz

update :: Int -> Int -> Int -> Int -> Int -> Int -> Tree -> Tree
update w t y x a b Nil = update w t y x a b tr
	where tr = if b - a == 1 then Leaf Data.Set.empty False else Inner Nil Nil 0

update w t y x a b (Inner l r _) =
	if y < mid then makeInner w (update w t y x a mid l) r
	else makeInner w l (update w t y x mid b r)
	where mid = (a + b) `div` 2

update w t y x a b (Leaf s rev) =
	case t of
		1 -> Leaf ((if rev then Data.Set.delete else Data.Set.insert) x s) rev
		2 -> Leaf ((if rev then Data.Set.insert else Data.Set.delete) x s) rev
		3 -> Leaf s (not rev)

main = do
	[h, w, q] <- map read . words <$> getLine :: IO [Int]
	queries <- map (map read . words) <$> replicateM q getLine :: IO [[Int]]

	history <- newArray (0, q) Nil :: IO (IOArray Int Tree)
	tree <- newIORef Nil :: IO (IORef Tree)

	forM_ (zip [0..] queries) $ \(i, q) -> do
		t <- readIORef tree
		writeArray history i t
		when (head q == 1) $ do
			let [k, y, x] = q
			writeIORef tree $ update w k (y - 1) (x - 1) 0 treeWidth t
		when (head q == 2) $ do
			let [k, y, x] = q
			writeIORef tree $ update w k (y - 1) (x - 1) 0 treeWidth t
		when (head q == 3) $ do
			let [k, y] = q
			writeIORef tree $ update w k (y - 1) 0 0 treeWidth t
		when (head q == 4) $ do
			let [k, y] = q
			nextTree <- readArray history y
			writeIORef tree nextTree
		currTree <- readIORef tree
		print $ getSum w currTree

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable (toList)

main = do
  [n, m, q] <- map read . words <$> getLine
  qs <- replicateM q (map read . words <$> getLine)

  let
    process bookcases [1, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= mark = Seq.update (j-1) mark books
          | otherwise = books

        d = if pres == mark then 0 else 1

        shelves' = Seq.update (i-1) (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [2, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= not mark = Seq.update (j-1) (not mark) books
          | otherwise = books

        d = if pres == not mark then 0 else -1

        shelves' = Seq.update (i-1) (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [3, i] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)

        d = -cnt + m-cnt

        shelves' = Seq.update (i-1) (cnt+d, not mark, books) shelves
        bookcase' = (total+d, shelves')

    process bookcases [4, k] = bookcases Seq.|> bookcase'
      where
        bookcase' = bookcases `Seq.index` k

    zero = (0, Seq.replicate n zero') where zero' = (0, True, Seq.replicate m False)

    bookcases = foldl process (Seq.singleton zero) qs

  -- putStr $ unlines $ map show $ toList bookcases

  putStr $ unlines $ map show $ map fst $ tail $ toList bookcases

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable (toList)

main = do
  [n, m, q] <- map read . words <$> getLine
  qs <- replicateM q (map read . words <$> getLine)

  let
    process bookcases [1, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= mark = Seq.update (j-1) mark books
          | otherwise = books

        d
          | pres == mark = 0
          | mark = 1
          | otherwise = -1

        shelves' = Seq.update (i-1) (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [2, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= not mark = Seq.update (j-1) mark books
          | otherwise = books

        d
          | pres == not mark = 0
          | not mark = -1
          | otherwise = 1

        shelves' = Seq.update i (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [3, i] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)

        d = -cnt + m-cnt

        shelves' = Seq.update (i-1) (cnt+d, not mark, books) shelves
        bookcase' = (total+d, shelves')

    process bookcases [4, k] = bookcases Seq.|> bookcase'
      where
        bookcase' = bookcases `Seq.index` k

    zero = (0, Seq.replicate n zero') where zero' = (0, True, Seq.replicate m False)

    bookcases = foldl process (Seq.singleton zero) qs

  putStr $ unlines $ map show $ map fst $ tail $ toList bookcases

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable (toList)

main = do
  [n, m, q] <- map read . words <$> getLine
  qs <- replicateM q (map read . words <$> getLine)

  let
    process bookcases [1, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= mark = Seq.update (j-1) mark books
          | otherwise = books

        d
          | pres == mark = 0
          | mark = 1
          | otherwise = -1

        shelves' = Seq.update (i-1) (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [2, i, j] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)
        pres = books `Seq.index` (j-1)

        books'
          | pres /= not mark = Seq.update (j-1) (not mark) books
          | otherwise = books

        d
          | pres == not mark = 0
          | not mark = -1
          | otherwise = 1

        shelves' = Seq.update (i-1) (cnt+d, mark, books') shelves
        bookcase' = (total+d, shelves')

    process bookcases [3, i] = bookcases Seq.|> bookcase'
      where
        _ Seq.:> (total, shelves) = Seq.viewr bookcases
        (cnt, mark, books) = shelves `Seq.index` (i-1)

        d = -cnt + m-cnt

        shelves' = Seq.update (i-1) (cnt+d, not mark, books) shelves
        bookcase' = (total+d, shelves')

    process bookcases [4, k] = bookcases Seq.|> bookcase'
      where
        bookcase' = bookcases `Seq.index` k

    zero = (0, Seq.replicate n zero') where zero' = (0, True, Seq.replicate m False)

    bookcases = foldl process (Seq.singleton zero) qs

  -- putStr $ unlines $ map show $ toList bookcases

  putStr $ unlines $ map show $ map fst $ tail $ toList bookcases


{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

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.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.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

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

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

solve :: Int -> Int64 -> Maybe [Int]
solve n k =
        solve' 1 [] k
    where
        solve' :: Int -> [Int] -> Int64 -> Maybe [Int]
        solve' i is k
            | i == n + 1          = if k <= 0 && null is then Just [] else Nothing
            | k >= kCount         = solve' (i + 1) (i : is) (k - kCount)
            | otherwise           = ((i : is) ++) <$> solve' (i + 1) [] k
            where
                kCount = count' (n - i - 1)

        count' :: Int -> Int64
        count' x
            | x < 0       = 1
            | x >= 61     = 2 ^ 61
            | otherwise   = 2 ^ fromIntegral x

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        [n, k] :: [Int64] <- B8.getLine <&> B8.words <&> map (fromInteger . readIntegerB8)
        let answer = solve (fromIntegral n) (k - 1)
        case answer of
            Just answer -> forM_ answer $ printf "%lld "
            Nothing -> printf "-1"
        printf "\n"

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

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

parseInt64 :: C.ByteString -> Int64
parseInt64 = fromIntegral . fst . fromJust . C.readInteger

func :: Int -> Int -> Int64 -> [Int]
func n i k
  | n >= 63 = i : func (n - 1) (i + 1) k
  | n <= 0 = []
  | otherwise = [i + j - 1, i + j - 2 .. i] ++ func (n - j) (i + j) (k - limit + 1)
  where
  limits = iterate (\(lim, j) -> (lim + 2 ^ (max 0 (n - 1 - j)), j + 1)) (1 :: Int64, 1 :: Int)
  (limit, j) = last $ takeWhile (\(lim, _) -> k >= lim) limits

main :: IO ()
main = do
  t <- fmap parseInt C.getLine
  replicateM_ t $ do
    [s1, s2] <- fmap C.words C.getLine
    let n = parseInt s1
        k = parseInt64 s2
    C.putStrLn $ C.pack $ if n < 63 && k > 2 ^ (n - 1)
                            then "-1"
                            else unwords $ map show $ func n 1 k


module Main where

str n = putStrLn (show n ++ " 1 " ++ show n ++ " 2")

main = print 2001 >> mapM_ str [1..1000] >> str 1 >> mapM_ str [1..1000]

import Data.List (intersperse)

formatList :: Show a => [a] -> String
formatList = concat . intersperse " " . map show

main :: IO [()]
main = do
    let n = 1000
        a = map (\x -> [x, 1, x, 2]) [1 .. n]
    print (n * 2)
    mapM (putStrLn . formatList) (a ++ reverse a)

import Data.List (intersperse)

formatList :: Show a => [a] -> String
formatList = concat . intersperse " " . map show

main :: IO [()]
main = do
    let n = 1000
        a = map (\x -> [x, 1, x, 2]) [1 .. n]
    print n
    mapM (putStrLn . formatList) (a ++ reverse a)

import Data.List (intersperse)

formatList :: Show a => [a] -> String
formatList = concat . intersperse " " . map show

main :: IO [()]
main = do
    let n = 1000
        a = map (\x -> [x, 1, x, 2]) [1 .. n]
    mapM (putStrLn . formatList) (a ++ reverse a)

module Main where

str n = putStrLn (show n ++ " 1 " ++ show n ++ " 2")

rez 0 = return ()
rez n = str n >> str n >> rez (n - 1)

main = print 2000 >> rez 1000

module Main where

str n = putStrLn (show n ++ " 1 " ++ show n ++ " 2")

rez 0 = return ()
rez n = str n >> str n >> rez (n - 2)

main = print 2000 >> rez 2000


main = interact $ solve . head . tail . lines
solve = go [] [] where
  go l r (a:b:cs) = go (a:l) (b:r) cs
  go l r [c] = r ++ reverse (c:l)
  go l r [] = l ++ reverse r

-- Codeforces Round #386 (Div. 2)
-- B. Decoding
-- http://codeforces.com/problemset/problem/746/B

import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable (toList, foldl)
import Prelude hiding (foldl)

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    str <- Seq.fromList `fmap` reverse `fmap` getLine :: IO (Seq.Seq Char)
    putStrLn $ toList (decode str)

decode :: Seq.Seq Char -> Seq.Seq Char
decode s = foldl (\t ch -> insertAt (Seq.length t `div` 2) ch t) Seq.empty s

insertAt k a s = (x Seq.|> a) Seq.>< y where
    (x, y) = Seq.splitAt k 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

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

  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

  solutions :: Integer -> Integer -> Integer
  solutions n k =
    let midIndex = (2 ^ (n - 1))
    in case compare k midIndex of
      GT -> solutions (n - 1) (k - midIndex)
      LT -> solutions (n - 1) (midIndex - k)
      EQ -> n

  solverEven :: String -> String -> String
  solverEven [] ys = ys
  solverEven (x:xs) ys
    | length ys `mod` 2 == 0 = solverEven xs (x:ys)
    | length ys `mod` 2 == 1 = solverEven xs (ys ++ [x])

  solverOdd :: String -> String -> String
  solverOdd [] ys = ys
  solverOdd (x:xs) ys
    | length ys `mod` 2 == 1 = solverOdd xs (x:ys)
    | length ys `mod` 2 == 0 = solverOdd xs (ys ++ [x])

  solver :: String -> String
  solver xs
    | length xs `mod` 2 == 1 = solverOdd xs []
    | length xs `mod` 2 == 0 = solverEven xs []

  main :: IO()
  main = do
    n <- getLine >>= return . readInteger
    xs <- getLine
    putStrLn $ solver xs

{-# LANGUAGE BangPatterns #-}

main = do
  n <- readLn
  cs <- getLine
  putStrLn $ solve n cs

solve :: Int -> String -> String
solve 1 [c] = [c]
solve 2 [c, d] = [c, d]
solve n cs = go (even n) [] [] cs
  where
    go True ls rs (c:d:cs) = go True (c:ls) (d:rs) cs
    go False ls rs (c:cs) = go True (c:ls) rs cs
    go _ ls rs [] = ls ++ reverse rs

main = interact $ (\[n,s] -> decode (read n) s "") . words

decode :: Int -> String -> String -> String
decode _ "" res = res
decode n (x:xs) res | even n    = decode (n - 1) xs (x : res)
                    | otherwise = decode (n - 1) xs (res ++ [x])

main = interact $ show . solve . head . tail . lines
solve = go [] [] where
  go l r (a:b:cs) = go (a:l) (b:r) cs
  go l r [c] = r ++ reverse (c:l)
  go l r [] = l ++ reverse r


solve :: String -> [String]
solve s  =  solve' 0 s
  where
    solve' n []  =  []
    solve' n s
      | s !! 1 == '/'  =
        (replicate (n-2) ' ' ++ take 4 s) : (solve' (n-2) (drop 4 s))
      | otherwise  =
        (replicate n ' ' ++ take 3 s) : (solve' (n+2) (drop 3 s))

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

indent lvl tag = (replicate (2 * lvl) ' ') ++ tag ++ "\n"

parse _ [] = []
parse lvl ('<':x:'>':xs)     = (indent lvl ['<', x, '>'])            ++ parse (lvl + 1) xs
parse lvl ('<':'/':x:'>':xs) = (indent (lvl - 1) ['<', '/', x, '>']) ++ parse (lvl - 1) xs
parse lvl (_:xs) = parse lvl xs

main = interact $ parse 0

indent lvl tag = (replicate (2 * lvl) ' ') ++ tag ++ "\n"

parse _ [] = []
parse lvl ('<':x:'>':xs)     = (indent lvl ['<', x, '>'])            ++ parse (lvl + 1) xs
parse lvl ('<':'/':x:'>':xs) = (indent (lvl - 1) ['<', '/', x, '>']) ++ parse (lvl - 1) xs

main = do text <- getLine
          putStr $ parse 0 text

split = (filter (\x->length x > 0)) . words . (map (\x->if (elem x "<>") then ' ' else x))
solve = fst . (foldl g ("", 0))
    where g (res, cnt) it = (res ++ (take (2*(if (head it=='/') then cnt - 1 else cnt)) (repeat ' ')) ++ "<" ++ it ++ ">\n", if (head it == '/') then cnt - 1 else cnt + 1)
main = interact $ solve . split

main = interact (solve 0)

solve d ('>':xs) = ">\n"++solve d xs
solve d ('<':'/':xs) = replicate ((d-1)*2) ' ' ++ "</" ++ solve (d - 1) xs
solve d ('<':xs) = replicate (d*2) ' ' ++ "<" ++ solve (d + 1) xs
solve d (x:xs) = x : solve d xs
solve _ [] = ""

import Text.Printf

spaces :: String
spaces = repeat ' '

xML :: String -> String
xML = loop 0
 where
  loop _  ""                        = ""
  loop n  ('<' : c : '>' : s)       = printf "%s<%s>\n"   (take (n  * 2) spaces) [c] ++ loop n' s
   where n' = n + 1
  loop n ~('<' : '/' : c : '>' : s) = printf "%s</%s>\n"  (take (n' * 2) spaces) [c] ++ loop n' s
   where n' = n - 1

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

import Data.List

data Tag = Open | Close deriving (Eq)

splitTag str =
    if length str > 0 then
        let (f,b) = span (/='>') str
            tagType = if length f == 2 then Open else Close
            tag = f++[(head b)]
            rest = tail b
        in
          Just ((tagType, tag), rest)
    else
        Nothing

solve xml = ppnt 0 $ unfoldr splitTag xml
    where
      ppnt _ [] = ""
      ppnt n ((typ,tag):xs) = ("\n"++(replicate (if typ==Open then n else n-2) ' ')++tag)++(ppnt (if typ==Open then n+2 else n-2) xs)

main = getLine >>= putStrLn.tail.solve


module Main where

isInt x = x == fromInteger (round x)

other :: IO ()
other = do
    ln <- getLine
    let ints = map read (words ln) :: [Integer]
    let n = ints !! 0
    let k = fromIntegral (ints !! 1)
    putStrLn $ if even n == even k
               then if k * k > n
                    then "NO"
                    else "YES"
               else "NO"

name 1 = other
name t = do
    other
    name $ t - 1

main = do
    t <- getLine
    name $ read t

main :: IO ()
main = do
    t_str <- getLine
    let t = read t_str
    printElem [1..t]

printElem :: Show a => [a] -> IO ()
printElem [] = putStrLn ""
printElem (x:xs) = do
    nk_str <- getLine
    let n = read (head (words nk_str))
    let k = read( last (words nk_str))
    putStrLn (solve n k)
    printElem xs

solve :: Integer -> Integer -> String
solve n k
    | ((n `mod` 2 == k `mod` 2) && (n >= (k ^ 2))) = "YES"
    | otherwise = "NO"

main :: IO ()
main = do
    t_str <- getLine
    let t = read t_str :: Integer
    printList [1..t]

printList :: (Show a) => [a] -> IO ()
printList [] = putStr ""
printList (x:xs) = do
    case_str <- getLine
    let n = (read (head (words case_str)) :: Integer)
    let k = (read (last (words case_str)) :: Integer)
    putStrLn (solve n k)
    printList xs

solve :: Integer -> Integer -> String
solve n k
    | ((n >= (k * k)) && ((n `mod` 2) == (k `mod` 2))) = "YES"
    | otherwise = "NO"

import Control.Monad

-- solve :: Integer -> Integer -> String
solve n k = if n >= k^2 && n `mod` 2 == k `mod` 2 then "YES" else "NO"

main = do
        t <- fmap read getLine
        forM [1..t] (\_ -> do
          [n, k] <- fmap (map read.words) getLine
          putStrLn (solve n k))

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        [n, k] <- map read . words <$> getLine
        if n < k*k || n `mod` 2 /= k `mod` 2 then
            putStrLn "NO"
        else
            putStrLn "YES"

import Control.Arrow
import Data.Array as Array

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve) >>> unlines >>> (++"\n")

solve :: [Integer] -> String
solve [n, k]
  | n < k * k = "NO"
  | odd (n - k * k) = "NO"
  | otherwise = "YES"

solve :: Integer -> Integer -> Bool
solve n k
  | n < k*k          = False
  | even n && even k = True
  | odd n  && even k = False
  | even n && odd k  = False
  | otherwise        = True

solve' :: Integer -> Integer -> String
solve' n k = if solve n k then "YES" else "NO"

parse :: String -> String
parse input = solve' n k
  where [n, k] = map (\x -> read x :: Integer) $ words input

main :: IO ()
main = interact (unlines . map parse . tail . lines)

module Main where

import Control.Monad
import Data.List

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

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

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, k] <- (map read <$> getStrList) :: IO [Integer]
        putStrLn . yesOrNo . and $ [n `mod` 2 == k `mod` 2, n >= k * k]

import Data.Bits
import Control.Monad

main :: IO ()
main = do
    getLine
    answers <- map (solve . map read . words) <$> lines <$> getContents :: IO [String]
    forM_ answers putStrLn

solve :: [Integer] -> String
solve [x,y]
    | odd x `xor` odd y = "NO"
    | otherwise         = case x < y^2 of
                            True    -> "NO"
                            _       -> "YES"

solve ([a, b]) = if a `mod` 2 /= b `mod` 2 then "NO" else if a < b*b then "NO" else "YES"

main = do
    x <- getLine
    interact (unlines . map ( solve . (map read) . words ) . lines )

module Main where

isInt x = x == fromInteger (round x)

other :: IO ()
other = do
    ln <- getLine
    let ints = map read (words ln) :: [Integer]
    putStrLn $ if even (ints !! 0) == even (ints !! 1)
               then if (ints !! 1) ^ 2 > (ints !! 0)
                    then "NO"
                    else "YES"
               else "NO"

name 1 = other
name t = do
    other
    name $ t - 1

main = do
    t <- getLine
    name $ read t

main :: IO ()
main = do
    t_str <- getLine
    let t = read t_str :: Int
    printList [1..t]

printList :: (Show a) => [a] -> IO ()
printList [] = putStr ""
printList (x:xs) = do
    case_str <- getLine
    let n = (read (head (words case_str)) :: Int)
    let k = (read (last (words case_str)) :: Int)
    putStrLn (solve n k)
    printList xs

solve :: Int -> Int -> String
solve n k
    | (((n `mod` 2) == (k `mod` 2)) && (n >= (k * k))) = "YES"
    | otherwise = "NO"

main :: IO ()
main = do
    t_str <- getLine
    let t = read t_str
    printElem [1..t]

printElem :: Show a => [a] -> IO ()
printElem [] = putStrLn ""
printElem (x:xs) = do
    nk_str <- getLine
    let n = read (head (words nk_str))
    let k = read( last (words nk_str))
    putStrLn (solve n k)
    printElem xs

solve :: Integer -> Integer -> String
solve n k
    | (n `mod` 2 == k `mod` 2) = "YES"
    | otherwise = "NO"

solve :: Integer -> Integer -> Bool
solve n k
  | n < k            = False
  | even n && even k = True
  | odd n  && even k = False
  | even n && odd k  = False
  | otherwise        = True

solve' :: Integer -> Integer -> String
solve' n k = if solve n k then "YES" else "NO"

parse :: String -> String
parse input = solve' n k
  where [n, k] = map (\x -> read x :: Integer) $ words input

main :: IO ()
main = interact (unlines . map parse . tail . lines)

solve :: Integer -> Integer -> Bool
solve n k
  | even n && even k = True
  | odd n  && even k = False
  | even n && odd k  = False
  | otherwise        = True

solve' :: Integer -> Integer -> String
solve' n k = if solve n k then "YES" else "NO"

parse :: String -> String
parse input = solve' n k
  where [n, k] = map (\x -> read x :: Integer) $ words input

main :: IO ()
main = interact (unlines . map parse . tail . lines)

import Data.Bits
import Control.Monad

main :: IO ()
main = do
    getLine
    answers <- map (solve . map read . words) <$> lines <$> getContents :: IO [String]
    forM_ answers putStrLn

solve :: [Int] -> String
solve [x,y]
    | odd x `xor` odd y = "NO"
    | otherwise         = case x < y^2 of
                            True    -> "NO"
                            _       -> "YES"

import Control.Monad

solve :: Int -> Int -> String
solve n k = if n >= k^2 && n `mod` 2 == k `mod` 2 then "YES" else "NO"

main = do
        t <- fmap read getLine
        forM [1..t] (\_ -> do
          [n, k] <- fmap (map read.words) getLine
          putStrLn (solve n k))

import Control.Arrow
import Data.Array as Array

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve) >>> unlines >>> (++"\n")

solve :: [Int] -> String
solve [n, k]
  | n < k * k = "NO"
  | odd (n - k) = "NO"
  | otherwise = "YES"

import Control.Arrow
import Data.Array as Array

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve) >>> unlines >>> (++"\n")

solve :: [Int] -> String
solve [n, k]
  | n < k * k = "NO"
  | odd (n - k * k) = "NO"
  | otherwise = "YES"

import Control.Arrow
import Data.Array as Array

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve) >>> unlines >>> (++"\n")

solve :: [Int] -> String
solve [n, k]
  | n < k = "NO"
  | odd (n - k) = "NO"
  | otherwise = "YES"

module Main where

isInt x = x == fromInteger (round x)

other :: IO ()
other = do
    ln <- getLine
    let ints = map read (words ln) :: [Int]
    let n = ints !! 0
    let k = ints !! 1
    putStrLn $ if even n == even k
               then if (sum $ take k [1,3..]) > n
                    then "NO"
                    else "YES"
               else "NO"

name 1 = other
name t = do
    other
    name $ t - 1

main = do
    t <- getLine
    name $ read t

module Main where

isInt x = x == fromInteger (round x)

name :: Integer -> IO ()
name 1 = do
    ln <- getLine
    let ints = map read (words ln) :: [Integer]
    putStrLn $ if isInt (fromIntegral (ints !! 0) / fromIntegral (ints !! 1))
               then "YES"
               else "NO"
name t = do
    ln <- getLine
    let ints = map read (words ln) :: [Integer]
    putStrLn $ if isInt (fromIntegral (ints !! 0) / fromIntegral (ints !! 1))
               then "YES"
               else "NO"
    name $ t - 1

main = do
    t <- getLine
    name $ read t


{-# LANGUAGE Safe #-}

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import safe Data.Graph (flattenSCC, stronglyConnComp)
import safe Data.Maybe (catMaybes, fromJust)

main :: IO ()
main =
  C.interact $
    C.lines >>> drop 1
      >>> map (C.words >>> map readInt)
      >>> process
      >>> map (show >>> C.pack)
      >>> C.unlines
  where
    readInt = C.readInt >>> fromJust >>> fst

process :: [[Int]] -> [Int]
process [] = []
process ([n] : ps : cs : xs) = solve n ps cs : process xs

solve :: Int -> [Int] -> [Int] -> Int
solve _ ps cs = minimum $ best . flattenSCC <$> stronglyConnComp (zip3 cs [1 ..] ((: []) <$> ps))

best :: [Int] -> Int
best xs = head $ filter check $ filter ((== 0) . (n `mod`)) [1 .. n]
  where
    n = length xs

    check :: Int -> Bool
    check len = not . null . catMaybes $ groupZip len [] xs

    groupZip :: Int -> [Maybe Int] -> [Int] -> [Maybe Int]
    groupZip _ cur [] = cur
    groupZip len [] xs = groupZip len (Just <$> take len xs) (drop len xs)
    groupZip len cur xs = groupZip len (zipWith comb cur (take len xs)) (drop len xs)
      where
        comb Nothing _ = Nothing
        comb (Just x) y = if x == y then Just x else Nothing

import Data.Bool
import Data.Maybe
import Data.Array
import Data.List
import Control.Monad
--newtype Cycle = Cycle {colors :: Array Int Color}
type Cycle = Array Index Color
type Color = Int
type Index = Int
type Givens = (Int, Array Index Index, Array Index Color)
type Changing = (Index,Array Index Bool, [Cycle])

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

routine :: IO ()
routine = do
  n <- readLn
  perm <- (map (read :: String -> Int).words) <$> getLine
  cols <- (map (read :: String -> Int).words) <$> getLine
  let givens = (n,listArray (1,n) perm, listArray (1,n) cols)
  print $ smallestPower $ finish givens (start n)

start :: Int -> Changing
start n = (1,listArray (1,n) (replicate n False) ,[])

f :: Givens -> Changing -> Either [Cycle] Changing
f (n,perm,colors) (i,seen,cys)
  |i>n = Left cys
  |seen!i = Right (i+1,seen,cys)
  |otherwise =Right (i+1,newSeen,newCys)
  where
    newPerm = makeOneCycle perm i
    newSeen = updateSeen newPerm seen
    newCys = makeCycle newPerm colors : cys

finish :: Givens -> Changing -> [Cycle]
finish g ch = case f g ch of
  Left cys -> cys
  Right newCh -> finish g newCh

updateSeen :: Array Index Index -> Array Index Bool -> Array Index Bool
updateSeen arr seen = seen // map (\x -> (x,True)) (elems arr)

makeCycle ::  Array Index Index -> Array Int Color -> Cycle
makeCycle arr cols = (\x -> cols!x) <$> arr

makeOneCycle :: Array Index Index -> Int -> Array Index Index
makeOneCycle perm i = listArray (1,length list) list
  where
    stream = iterate (\ind -> perm!ind) (perm!i)
    list =i : takeWhile (/=i) stream

smallestPower :: [Cycle] -> Int
smallestPower cs = minimum (map processCycle cs)

divisors :: Int -> [Int]
divisors n = lows ++ bool id tail (n == root * root) (reverse (quot n <$> lows))
  where
    root = (floor . (sqrt:: Double -> Double) . fromIntegral) n
    lows = filter ((0==) . rem n) [1..root]

divisorTest :: Cycle -> Int -> Bool
divisorTest cy di = or alltests
  where
    (_,leng) = bounds cy
    testcyc n = all (==cy!n) [cy!(n+(x-1)*di) | x <- [1..(leng `div` di)]]
    alltests = map testcyc [1..di]

processCycle :: Cycle -> Int
processCycle cy = firstDiv
  where
    (_,leng) = bounds cy
    divs = divisors leng
    firstDiv =  fromJust $ find (divisorTest cy) divs


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Bits
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

type Vertex = Int
type Weight = Int
data Edge = Edge { w_ :: !Weight, v_ :: !Vertex }

instance NFData Edge where
    rnf (Edge w v) = w `seq` v `seq` ()

data EdgeList = Nil | Cons {-# UNPACK #-} !Edge EdgeList -- For performance reasons only :(

solve :: IO ()
solve = do
    void C.getLine -- why?
    ~[n, m] <- readInts
    g <- fmap (accumArray (flip Cons) Nil (1, n) . concat) $ replicateM m $ do
        ~[u, v, w] <- readInts
        let es = [(u, Edge w v), (v, Edge w u)]
        es `deepseq` pure es
    let f msk i = if connected g ((==0) . (msk' .&.)) then msk' else msk where
            msk' = msk `setBit` i
    print $ ((1 `shiftL` 30) - 1) `xor` foldl' f 0 [29,28..0]

connected :: Array Vertex EdgeList -> (Weight -> Bool) -> Bool
connected g p = runST $ do
    let bnds = bounds g
    vis :: STUArray s Int Bool <- newArray bnds False
    let go u = do
            done <- readArray vis u
            unless done $ do
                writeArray vis u True
                filterSequenceEdgeList p go (g!u) :: ST s ()
    go (fst bnds)
    and <$> getElems vis

filterSequenceEdgeList :: Monad m => (Weight -> Bool) -> (Vertex -> m ()) -> EdgeList -> m ()
filterSequenceEdgeList p f = go where
    go Nil = pure ()
    go (Cons (Edge w v) es)
        | p w       = f v >> go es
        | otherwise = go es

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
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.Maybe

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

maxBits :: Int
maxBits = 30

-- Perhaps packing (to traverse fewer lists) will help?
isConnected :: Array Int (UArray Int Int) -> Int -> Bool
isConnected arr mask = runST $ do
  let  (li, ri) = bounds arr
  vis :: STUArray s Int Bool
      <- newArray (li, ri) False :: ST s (STUArray s Int Bool)
  let
    dfs :: Int -> [Int] -> ST s Int
    dfs !ct [] = pure ct
    dfs !ct (v : vs) = do
      isVis <- readArray vis v
      writeArray vis v True
      if  isVis
        then  dfs ct vs
        else  let
        nbrs = do
          uw <- elems $ arr !  v
          let  u = uw .&. (bit maxBits - 1)
               w = uw `shiftR` maxBits
          guard $ w .&. mask == w
          pure u
        -- weird concatenation style to prevent thunks from existing
        vs' = foldl' (flip (:)) vs nbrs
        in  dfs (ct + 1) vs'
  ccsz <- dfs 0 [li]
  pure $ ccsz == ri + 1 - li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    es <- replicateM m $ do
      wasThisContributingToBadMemoryUse <- getInts 3
      -- I should profile it, but I don't feel like it right now
      case  wasThisContributingToBadMemoryUse  of
        [!vi, !ui, !wi] -> pure (vi, ui, wi)
        _ -> error "bad input format"
    let
      adj :: Array Int [Int]
      adj = accumArray (flip (:)) [] (1, n) $ do
        (vi, ui, wi) <- es
        let  !vw = pack (vi, wi)
             !uw = pack (ui, wi)
        [(ui, vw), (vi, uw)]
      pack (u, w) = u + shiftL w maxBits
      adj2 = (\li -> listArray (1, length li) li) <$> adj
      isOK :: Int -> Bool
      isOK = isConnected adj2
      solve s j = if  j < 0
        then  s
        else  let
        s' = s - bit j
        in  if  isOK s'
        then  solve s' (j - 1)
        else  solve s  (j - 1)
    pure $ putInts [solve (bit maxBits - 1) (maxBits - 1)]

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
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.Maybe

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

maxBits :: Int
maxBits = 30

-- Perhaps packing (to traverse fewer lists) will help?
isConnected :: Array Int (UArray Int Int) -> Int -> Bool
isConnected arr mask = runST $ do
  let  (li, ri) = bounds arr
  vis :: STUArray s Int Bool
      <- newArray (li, ri) False :: ST s (STUArray s Int Bool)
  let
    dfs :: Int -> [Int] -> ST s Int
    dfs !ct [] = pure ct
    dfs !ct (v : vs) = do
      isVis <- readArray vis v
      writeArray vis v True
      if  isVis
        then  dfs ct vs
        else  let
        nbrs = do
          uw <- elems $ arr !  v
          let  u = uw .&. (bit maxBits - 1)
               w = uw `shiftR` maxBits
          guard $ w .&. mask == w
          pure u
        -- weird concatenation style to prevent thunks from existing
        vs' = foldl' (flip (:)) vs nbrs
        in  dfs (ct + 1) vs'
  ccsz <- dfs 0 [li]
  pure $ ccsz == ri + 1 - li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    es <- replicateM m $ do
      wasThisContributingToBadMemoryUse <- getInts 3
      -- I should profile it, but I don't feel like it right now
      case  wasThisContributingToBadMemoryUse  of
        [!vi, !ui, !wi] -> pure (vi, ui, wi)
        _ -> error "bad input format"
    let
      adj :: Array Int [(Int, Int)]
      adj = accumArray (flip (:)) [] (1, n) $ do
        (vi, ui, wi) <- es
        [(ui, (vi, wi)), (vi, (ui, wi))]
      pack (u, w) = u + shiftL w maxBits
      adj2 = (\li -> listArray (1, length li) $ map pack li) <$> adj
      isOK :: Int -> Bool
      isOK = isConnected adj2
      solve s j = if  j < 0
        then  s
        else  let
        s' = s - bit j
        in  if  isOK s'
        then  solve s' (j - 1)
        else  solve s  (j - 1)
    pure $ putInts [solve (bit maxBits - 1) (maxBits - 1)]

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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


--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, FlexibleContexts, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import qualified Data.Array.Unboxed as UA
import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:a) = intDec res <> char7 '\n'
  where
    b = take n a
    !m = maximum b
    x :: UA.UArray Int Int
    x = UA.accumArray (+) 0 (0, m) (zip b (repeat 1))
    !res = runST $ do
      c <- thaw x :: ST s (STUArray s Int Int)
      let
        loop k s = do
          if s > m then return $! (k - 1)
          else do
            w <- readArray c s
            if w > 0 then do
              writeArray c s (pred w)
              loop (succ k) (max (succ k) s)
            else loop k (succ s)
      loop 1 1

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

import Data.List

readInt :: String -> Int
readInt = read

main = do
    unusefulThrash <- getLine
    a <- getLine
    putStrLn $ show $ solve [1..] ((sort . map readInt . words) a)

solve :: [Int] -> [Int] -> Int
solve (x:xs) [] = 0
solve (x:xs) (y:ys) =
    if x <= y
    then 1 + solve xs ys
    else solve (x:xs) ys


import Data.Bits

getgrundy :: Int -> Int
getgrundy 0 = 0
getgrundy 1 = 1
getgrundy 2 = 2
getgrundy x
 | even x = 1
 | otherwise = 0

no1 :: Int -> Int
no1 1 = 2
no1 _ = 1

getgrundy' :: Int -> Int
getgrundy' 0 = 0
getgrundy' 1 = 1
getgrundy' 2 = 0
getgrundy' 3 = 1
getgrundy' 4 = 2
getgrundy' x
 | even x = no1 $ getgrundy' $ div x 2
 | otherwise = 0

calc :: (Int -> Int) -> [Int] -> Int
calc f (x:xs) =  xor (f x) (calc f xs)
calc _ _ = 0

solve' :: Int -> [Int] -> Int
solve' 0 x = calc getgrundy $ x
solve' 1 x = calc getgrundy' $ x

solve ::Int -> [Int] -> String
solve k x
 | 0 == solve' k x = "Nicky"
 | otherwise = "Kevin"

parse :: String -> String
parse x = solve (mod (a!!1) 2) (tail $ tail a) where a = map read $ words x

main = interact parse

import Data.Bits (xor)
import Data.Char (ord)
import Data.List (foldl1')

readInt :: String -> Int
readInt = foldl (\s c -> s * 10 + ord c - 48) 0

type Input = (Int, [Int])

parse :: String -> Input
parse contents = (k, readInts l1)
    where [l0, l1] = lines contents
          [_, k] = readInts l0
          readInts l = map readInt $ words l

sgEven :: Int -> Int
sgEven n
    | n < 3     = n
    | otherwise = (n + 1) `mod` 2

sgOdd :: Int -> Int
sgOdd n
    | n < 5 = [0, 1, 0, 1, 2] !! n
    | odd n = 0
    | otherwise = let sg' = sgOdd (n `div` 2) in
                  case sg' of
                      0 -> 1
                      1 -> 2
                      2 -> 1
                      _ -> undefined

sg :: Int -> Int -> Int
sg k
    | odd k = sgOdd
    | otherwise = sgEven

solve :: Input -> Bool
solve (k, a) = s == 0
    where s = foldl1' xor . map (sg k) $ a

format :: Bool -> String
format False = "Kevin"
format True = "Nicky"

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents


{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, _] <- readChar8'
        xs <- fmap (sum . scanl (+) 0) <$> replicateM n readChar8'
        let idx = fromMaybe 0 $ findIndex (< mx) xs
            mx  = maximum xs
        printf "%d %d\n" (idx + 1) (mx - xs !! idx)

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import           Control.Exception              ( Exception )
import           Control.Monad                  ( replicateM
                                                , replicateM_
                                                )
import           Data.Bits                      ( Bits(..) )
import qualified Data.ByteString.Char8         as C
import           Data.List                      ( findIndex
                                                , foldl'
                                                , unfoldr
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Text.Printf                    ( printf )

-- arrange :: [a] -> Int -> [[a]]
-- arrange xs n = mapM (const xs) [1 .. n]

-- data Tree a = Null | Branch a (Tree a) (Tree a)
--   deriving (Show, Eq, Functor)

-- makeBaseFunctor ''Tree

-- x :: Tree Int
-- x = Branch 1 (Branch 2 Null Null) (Branch 3 Null Null)

-- y :: Tree Int -> Int
-- y = cata $ \case
--     NullF         -> 0
--     BranchF x a b -> x + a + b

-- >>> y x
-- 6

-- z :: Tree Int -> Int
-- z = para $ \case
--     NullF                     -> 0
--     BranchF x (x1, a) (x2, b) -> x + a + b + y x1 + y x2

-- >>> z x
-- 11

-- quicksort :: Ord a => [a] -> [a]
-- quicksort = hylo merge split  where
--     split []       = NullF
--     split (x : xs) = let (l, r) = partition (< x) xs in BranchF x l r

--     merge NullF           = []
--     merge (BranchF x l r) = l ++ [x] ++ r

-- >>> quicksort ([5,4,6,7,8,6,4,2])
-- [2,4,4,5,6,6,7,8]

-- fibSeq :: [Int]
-- fibSeq = futu phi Nil
--   where
--     phi Nil                    = Cons 0 (Pure (Cons 0 Nil))
--     phi x@(Cons _ Nil        ) = Cons 1 (Pure (Cons 1 (Cons 0 Nil)))
--     phi t@(Cons x (Cons y xs)) = Cons (x + y) (Pure (Cons (x + y) (Cons x Nil)))

-- >>> take 20 fibSeq
-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

-- f1 :: [Int] -> Int
-- f1 = flip runReader 0 . cataA phi
--   where
--     phi Nil        = return 0
--     phi (Cons x t) = do
--         n <- ask
--         if n >= 10 then return 0 else (x +) <$> local succ t

-- f2 :: [Int]
-- f2 = apo phi 1
--   where
--     phi n | n < 100   = Cons (n * 2) (Right (n + 1))
--           | otherwise = Cons (n * 2) (Left [1, 2, 3])

-- >>> f1 fibSeq
-- 88

-- >>> f2
-- [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198]

-- urlParser :: Parser String
-- urlParser = argument str (metavar "URL")

-- segmented :: Int -> Int -> [(Int, Int)]
-- segmented total blocksize = (id &&& (min (total - 1) . (+ (blocksize - 1)))) <$> takeWhile (< total) [0, blocksize ..]

-- main :: IO ()
-- main = do
--     manager <- newManager tlsManagerSettings
--     url     <- execParser opts
--     req     <- parseRequest url
--     res     <- httpNoBody req manager
--     let len = maybe 0 fst (readInt =<< (lookup "Content-Length" (requestHeaders req) <|> lookup "content-length" (responseHeaders res)))
--     if len == 0
--         then do
--             res <- httpLbs req manager
--             print $ responseStatus res
--             print $ responseBody res
--         else do
--             pool <- createPool (pure ()) (const (pure ())) 2 0.5 5
--             mapConcurrently_
--                 (\(s, e) -> withResource pool $ \_ -> do
--                     res <- httpLbs (req { requestHeaders = ("Range", BS.pack $ formatToString ("bytes=" % int % "-" % int) s e) : requestHeaders req }) manager
--                     print $ responseStatus res
--                     -- print $ responseBody res
--                 )
--                 (segmented len tenMegabytes)
--   where
--     opts         = info urlParser fullDesc
--     tenMegabytes = 10485760

-- eigenvector :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a)) => r (r a) -> r a
-- eigenvector m = iterate (\x -> normalize (m !* x)) (m `dot` m) !! 1000

-- eigenvalue :: (Fractional a, Foldable t, Additive t, Conjugate a) => t (t a) -> t a -> a
-- eigenvalue m x = (let V1 (V1 p) = (helper x!*! m) !*! (V1 <$> x) in p) / (let V1 (V1 q) = helper x !*! (V1 <$> x) in q)
--     where
--         helper :: (Functor t, Conjugate a) => t a -> V1 (t a)
--         helper = adjoint . fmap V1

-- eigenvalues :: (Floating a, Metric r, Epsilon a, Foldable r, Num (r a), Finite r, KnownNat (Size r), Traversable r, Num (r (r a)), Applicative r, Eq a, Distributive r, Conjugate a, R1 r) => r (r a) -> [a]
-- eigenvalues m = go [e0] (m - e0 *!! identity)
--     where
--         c0 = eigenvector m
--         e0 = eigenvalue m c0
--         go acc ma | luDetFinite (m - ev *!! identity) /= 0 = acc
--                   | otherwise = go (ev : acc) (ma - (ec' * adjoint ec') !!* ev !!/ (ec `dot` ec))
--                   where ec = eigenvector ma
--                         ev = eigenvalue ma ec
--                         ec' = (<$ unit _x) <$> ec

-- >>> eigenvalues (V2 (V2 1 2) (V2 3 4))
-- []

data Break = Break
    deriving Show

instance Exception Break

readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine where parse s = let Just (n, _) = C.readInt s in n

readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
  where
    parse = unfoldr go
    go s = do
        (n, s1) <- C.readInt s
        let s2 = C.dropWhile (== ' ') s1
        return (fromIntegral n, s2)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, _] <- readChar8
        xs <- fmap (sum . scanl (+) 0) <$> replicateM n readChar8
        let idx = fromMaybe 0 $ findIndex (< mx) xs
            mx  = maximum xs
        printf "%d %d\n" (idx + 1) (mx - xs !! idx)


main = getLine >> getLine >>= putStr.unlines.map (show.solve.read).words

solve :: Integer -> Integer
solve n
  | r == 1    = 2*n+1
  | r == 3    = n+1
  | otherwise = 4*n+1
   where r = mod n 4

main = getContents >>= mapM_ print.map solve. map (\x -> read x :: Integer). tail. words
 where
  solve x
   | even x = 4*x + 1
   | x `mod` 4 == 3 = x+1
   | otherwise = 2*x+1

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

solve x
    | odd x && (x - 3) `mod` 4 == 0 = x + 1
    | odd x = x * 2 + 1
    | otherwise = x * 4 + 1

main =  B.putStrLn =<< B.unlines . map (B.pack . show . solve . fst . fromJust .  B.readInteger) . B.words  <$>  (B.getLine >> B.getLine)

solve :: Integer -> Integer
solve n  =  1 + div (lcm (4*n) (n + 1)) (n + 1)

main :: IO ()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    mapM_ (print . solve) xs

main = do
  getLine -- t
  xs <- (map read . words) `fmap` getLine
  mapM_ (print . solve) xs
    where solve x = lcm (4 * x) (x + 1) `div` (x + 1) + 1

import Control.Applicative
import Data.List
--import Test.QuickCheck

main'fast :: Integer -> Integer
main'fast 1 = 3
main'fast n
    | n `mod` 2 == 0 = n * 4 + 1
    | n `mod` 4 == 1 = n * 2 + 1
    | otherwise = n + 1

--main'slow :: Integer -> Integer
main'slow n = (+2). genericLength. takeWhile (/=0). tail$ iterate f 0 where
    f x = (x + n + 1) `mod` (n*4)

--prop_main' x = x >= 1 ==> main'slow x == main'fast x

main = do
    getLine
    ss <- getLine
    putStrLn$ unlines. map (show. main'fast. read). words$ ss

calc :: Integer -> Integer
calc n = head [i*n+1 | i <- [1..], ((n+1)*n*i) `mod` (n*4) == 0]

putLs [] = return ()

putLs (x:xs) = do putStrLn x

                  putLs xs

main = do s <- getLine

          t <- getLine

          putLs $ map (\a -> show $ calc (read a :: Integer)) $ words t

main = getLine >> getLine >>= putStrLn.unlines.map (show.solve.read).words

solve :: Integer -> Integer
solve 1 = 3
solve n = 4*n+1


{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []  -> Nothing
          n:rest0   ->
            let (ls, rest1) = splitAt n rest0
                guess = (\cand ->
                  let ls1 = xor cand <$> ls
                  in sort ls == sort ls1
                  )
                guessAll = (\(!curr) -> if
                  | curr == 1024  -> -1
                  | otherwise     -> if guess curr then curr else guessAll (curr+1)
                  )
                subres = guessAll 1
            in Just (subres, rest1)
        ) vals
  sequence_ (putStrLn . show <$> res)

import Data.Set as S
import Data.Bits as B
import Data.List as L

isMatch :: S.Set Int -> Int -> Bool
isMatch s n = s == S.map (\x -> B.xor x n) s

isPossible :: S.Set Int -> Int
isPossible s = case L.find (\x -> isMatch s x) [1..1024] of
                 (Just a) -> a
                 Nothing -> -1

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (L.take n arr):(groupByNLines n (L.drop n arr))

parse :: [String] -> String
parse [_, input] = show $ isPossible $ S.fromList arr
  where arr = L.map (\x -> read x :: Int) $ words input

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 2 . tail . lines)