import Data.List
import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countSwitch' [] zs last n = (n,zs,last)
countSwitch' (x:xs) _ (-1) _ = countSwitch' xs [1] x 0
countSwitch' (x:xs) (z:zs) last n
    | x==last = countSwitch' xs ((z+1):zs) x n
    | otherwise = countSwitch' xs (1:z:zs) x (n+1)

addTo z start 0 = z
addTo z start end = addTo (show(start):z) (start-1) (end-1)

sum' _ _ partial 0 = [show partial]
sum' [] [] _ _= []
sum' ((a):as) ((b):bs) partial toGo = show (a + b + partial) : (sum' as bs (a + b + partial) (toGo-1))
sum' [] ((b):bs) partial toGo = show (b + partial) : (sum' [] bs (b + partial) (toGo-1))
sum' ((a):as) [] partial toGo = show (a + partial) : (sum' [] as (a + partial) (toGo-1))

countTurns switchA switchB lastA lastB firstA firstB a b
	| switchA > switchB =
		if (lastA == 0)
			then (show (switchA) ++ ("\n" ++ unwords (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ unwords (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((0):b) 0 (switchA+1)))))
	| switchB > switchA = if (lastB == 0)
		then (show (switchB) ++ ("\n" ++ unwords (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ unwords (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((0):a) b 0 (switchB+1)))))
	| lastA==0 && lastB==0 = show(switchA) ++ ("\n" ++ unwords (init(sum' a b 0 switchA)))
	| lastA==1 && lastB==1 = show(switchA+1) ++ ("\n" ++ unwords (init(sum' a b 0 (switchA+1))))
	| lastA==0 && lastB==1 = show(switchA + 1) ++ ("\n" ++ unwords (init(sum' ((0):a) b 0 (switchA+1))))
	| lastA==1 && lastB==0 = show(switchA + 1) ++ ("\n" ++ unwords (init(sum' a ((0):b) 0 (switchA+1))))

buildStack switchA switchB a b n m firstA firstB
	| switchA > switchB = stack a b n (n+m) [] switchA switchB
	| switchB > switchA = stack b a (n+m) n [] switchB switchA
	| firstA==firstB = stack a b n (n+m) [] switchA switchB
	| firstA==0 && firstB==1 = stack a b n (n+m) [] switchA switchB
	| firstA==1 && firstB==0 = stack b a (n+m) n [] switchB switchA

stack [] [] n m z _ _ = z
stack ((b):xs) [] n m z _ _ = stack xs [] (n-b) m (addTo z n b) 0 0
stack [] ((b):ys) n m z _ _ = stack [] ys n (m-b) (addTo z m b) 0 0
stack ((b):xs) ((d):ys) n m z lengthA lengthB
	| (lengthB) > (lengthA) = stack ((b):xs) (ys) n (m-d) (addTo z m d) lengthA (lengthB-1)
	| otherwise =  stack ((d):ys) xs m (n-b) (addTo z n b) lengthB (lengthA-1)

solve n m firstDeck secondDeck =
	let
		firstA = head firstDeck
		firstB = head secondDeck
		(switchA,a,lastA) = countSwitch' firstDeck [] (-1) n
		(switchB,b,lastB) = countSwitch' secondDeck [] (-1) m
	in
		do
	        --print a
			--print b
			(appendFile "output.txt" $ unwords (buildStack switchA switchB a b n m lastA lastB))
			(appendFile "output.txt" ("\n" ++ (countTurns switchA switchB lastA lastB firstA firstB (reverse a) (reverse b))))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     --print $ show (countSwitch firstDeck [] 0)
     --print $ show (countSwitch' firstDeck [] (-1) 0)
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

run line 0 = ([],0,-1,-1)
run line n =
	let Just(elem,line') = readInt line
	in
		let (stack,switches,last',first') = run line' (n-1)
		in
			if(stack==[])
			then (((elem,1):[]),0,elem,elem)
			else
				let ((_,count):s) = stack in
					if (elem == first')
					then (((elem,count+1):s),switches,last',elem)
					else (((elem,1):stack),switches+1,last',elem)
	where readInt s = BSC.readInt (BSC.dropWhile isSpace s)

addTo z start 0 = z
addTo z start end = (start:(addTo z (start+1) (end-1)))

--solve :: Integral a => [(a,a)] -> [(a,a)] -> a -> a -> a -> ([a],[a])
solve [] [] _ _ _ 0 = ([],[])
solve [] [] _ _ _ extra = ([],[extra])
solve [] ((c,d):sStack) n m count extra =
	if (sStack==[] && c==0)
	then
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, (cards))
	else
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, ((count+d):cards))
solve ((a,b):fStack) [] n m count extra =
	if(fStack==[] && a==0)
	then
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), (cards))
	else
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), ((count+b):cards))
solve ((a,b):fStack) ((c,d):sStack) n m count extra
	| a==c =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, (cards))
		else
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, ((count+b+d):cards))
	| otherwise =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in ((addTo (addTo stack m d) n b), ((count+b):cards))
		else
			let
			    (stack, cards) =
			        solve fStack sStack (n+b) (m+d) (count+b+d) (count+b+d)
			in ((addTo (addTo stack m d) n b), ((count+b):cards))

countTurns fSwitch sSwitch fLast sLast
	| fSwitch > sSwitch && fLast==1 = fSwitch + 1
	| fSwitch > sSwitch && fLast==0 = fSwitch
	| sSwitch > fSwitch && sLast==1 = sSwitch + 1
	| sSwitch > fSwitch && sLast==0 = sSwitch
	| fLast==sLast && fLast==0 = fSwitch
	| fLast==sLast && fLast==1 = fSwitch + 1
	| otherwise = fSwitch + 1

toStr array = tail $ foldr (\x y -> (' ':show(x)) ++ y) "" array

solve' fSwitch sSwitch fStack sStack fLast sLast n m
	| fSwitch>sSwitch =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| sSwitch>fSwitch =
		let
			(stack,cards) = solve sStack fStack 1 (m+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| fLast==sLast =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| fLast==0 =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| sLast==0 =
		let
			(stack,cards) = solve sStack fStack 1 (m+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))

main =
  do
     all <- BSC.readFile "input.txt"
     let (n':firstLine:m':secondLine:_) = BSC.lines all
     let Just (n,_) = readInt n'
     let Just (m,_) = readInt m'
     --print n
     --print firstLine
     --print m
     --print secondLine
     let (fStack,fSwitch,fLast,fFirst) = run firstLine n
     let (sStack,sSwitch,sLast,sFirst) = run secondLine m
     solve' fSwitch sSwitch fStack sStack fLast sLast n m

     --print $ run secondLine m
     --let (firstDeck, r2)  = readMany n readInteger r1
     --let Just (m, r3) = readInteger r2
     --let (secondDeck, _) = readMany m readInteger r3
   --  solve n m firstDeck secondDeck
     print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB
	| switchA > switchB = if (firstA == 0) then switchA else switchA+1
	| switchB > switchA = if (firstB == 0) then switchB else switchB+1
	| firstA==0 && firstB==0 = switchA
	| firstA==1 && firstB==1 = switchA + 1
	| otherwise = switchA + 1

addTo z start 0 = z
addTo z start end = addTo ((show(start)++" ")++z) (start-1) (end-1)

buildStack switchA switchB a b n m firstA
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==0 = stack a b n (n+m) []
	| otherwise = stack b a (n+m) n []

stack [] [] n m z = z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) (y:ys) n m z = stack (y:ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				BS.writeFile "output.txt" $ (BSC.pack ((show $ buildStack switchA switchB a b n m firstA) ++ "\n" ++ (show $ countTurns switchA switchB firstA firstB)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB a b
	| switchA > switchB =
		if (firstA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0,0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((1,0):b) 0 (switchA+1)))))
	| switchB > switchA = if (firstB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0,0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((1,0):a) b 0 (switchB+1)))))
	| firstA==0 && firstB==0 = show(switchA) ++ ("\n" ++ (init(sum' a b 0 switchA)))
	| firstA==1 && firstB==1 = show(switchA+1) ++ ("\n" ++ (init(sum' a b 0 (switchA+1))))
	| firstA==0 && firstB==1 = show(switchA + 1)  ++ ("\n" ++ (init(sum' a ((0,0):b) 0 (switchA+1))))
	| firstA==1 && firstB==0 = show(switchA + 1)  ++ ("\n" ++ (init(sum' ((0,0):a) b 0(switchA+1))))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = init z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==0 = stack a b n (n+m) []
	| otherwise = stack b a (n+m) n []

stack [] [] n m z = z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) (y:ys) n m z = stack (y:ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m firstA) ++ "\n" ++ (countTurns switchA switchB firstA firstB a b)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB a b
	| switchA > switchB =
		if (firstA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0,0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((1,0):b) 0 (switchA+1)))))
	| switchB > switchA = if (firstB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0,0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((1,0):a) b 0 (switchB+1)))))
	| firstA==0 && firstB==0 = show(switchA) ++ ("\n" ++ (init(sum' a b 0 switchA)))
	| firstA==1 && firstB==1 = show(switchA+1) ++ ("\n" ++ (init(sum' a b 0 (switchA+1))))
	| firstA==0 && firstB==1 = show(switchA + 1)  ++ ("\n" ++ (init(sum' a ((0,0):b) 0 (switchA+1))))
	| firstA==1 && firstB==0 = show(switchA + 1)  ++ ("\n" ++ (init(sum' ((0,0):a) b 0(switchA+1))))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==0 = stack a b n (n+m) []
	| otherwise = stack b a (n+m) n []

stack [] [] n m z = init z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) (y:ys) n m z = stack (y:ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m firstA) ++ "\n" ++ (countTurns switchA switchB firstA firstB a b)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB lastA lastB firstA firstB a b
	| switchA > switchB =
		if (lastA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0,0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((1,0):b) 0 (switchA+1)))))
	| switchB > switchA = if (lastB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0,0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((1,0):a) b 0 (switchB+1)))))
	| lastA==0 && lastB==0 = show(switchA) ++ ("\n" ++ (init(sum' a b 0 switchA)))
	| lastA==1 && lastB==1 = show(switchA+1) ++ ("\n" ++ (init(sum' a b 0 (switchA+1))))
	| lastA==0 && lastB==1 = show(switchA + 1)  ++ ("\n" ++ (init(sum' a ((0,0):b) 0 (switchA+1))))
	| lastA==1 && lastB==0 = show(switchA + 1)  ++ ("\n" ++ (init(sum' ((0,0):a) b 0(switchA+1))))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA firstB
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==firstB = stack a b n (n+m) []
	| firstA==0 && firstB==1 = stack a b n (n+m) []
	| firstA==1 && firstB==0 = stack b a (n+m) n []

stack [] [] n m z = init z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) ((c,d):ys) n m z
	| (length ys) > (length xs) = stack ((a,b):xs) (ys) n (m-d) (addTo z m d)
	| otherwise =  stack ((c,d):ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		firstA = head firstDeck
		firstB = head secondDeck
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((lastA,_):as) = a
			((lastB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m lastA lastB) ++ "\n" ++ (countTurns switchA switchB lastA lastB firstA firstB (reverse a) (reverse b))))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

run line 0 = ([],0,-1,-1)
run line n =
	let Just(elem,line') = readInt line
	in
		let (stack,switches,last',first') = run line' (n-1)
		in
			if(stack==[])
			then (((elem,1):[]),0,elem,elem)
			else
				let ((_,count):s) = stack in
					if (elem == first')
					then (((elem,count+1):s),switches,last',elem)
					else (((elem,1):stack),switches+1,last',elem)
	where readInt s = BSC.readInt (BSC.dropWhile isSpace s)

addTo z start 0 = z
addTo z start end = (start:(addTo z (start+1) (end-1)))

--solve :: Integral a => [(a,a)] -> [(a,a)] -> a -> a -> a -> ([a],[a])
solve [] [] _ _ _ 0 = ([],[])
solve [] [] _ _ _ extra = ([],[extra])
solve [] ((c,d):sStack) n m count extra =
	let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
	in if(extra==0)
		then (addTo stack m d, ((count+d):cards))
		else (addTo stack m d, ((count+d):extra:cards))
solve ((a,b):fStack) [] n m count extra =
	let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
	in if (extra==0)
		then ((addTo stack n b), ((count+b):cards))
		else ((addTo stack n b), ((count+b):extra:cards))
solve ((a,b):fStack) ((c,d):sStack) n m count extra
	| a==b =
		let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
		in (addTo (addTo stack n b) m d, ((count+b+d):cards))
	| otherwise =
		let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) (count+b+d)
		in ((addTo (addTo stack n b) m d), ((count+d):cards))

countTurns fSwitch sSwitch fLast sLast
	| fSwitch > sSwitch && fLast==1 = fSwitch + 1
	| fSwitch > sSwitch && fLast==0 = fSwitch
	| sSwitch > fSwitch && sLast==1 = sSwitch + 1
	| sSwitch > fSwitch && sLast==0 = sSwitch
	| fLast==sLast && fLast==0 = fSwitch
	| fLast==sLast && fLast==1 = fSwitch + 1
	| otherwise = fSwitch + 1

toStr array = tail $ foldr (\x y -> (' ':show(x)) ++ y) "" array

main =
  do
     all <- BSC.readFile "input.txt"
     let (n':firstLine:m':secondLine:_) = BSC.lines all
     let Just (n,_) = readInt n'
     let Just (m,_) = readInt m'
     --print n
     --print firstLine
     --print m
     --print secondLine
     let (fStack,fSwitch,fLast,fFirst) = run firstLine n
     let (sStack,sSwitch,sLast,sFirst) = run secondLine m
     let (stack,cards) = solve fStack sStack 1 (n+1) 0 0

     BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++ show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++ (toStr cards)))

     --print $ run secondLine m
     --let (firstDeck, r2)  = readMany n readInteger r1
     --let Just (m, r3) = readInteger r2
     --let (secondDeck, _) = readMany m readInteger r3
   --  solve n m firstDeck secondDeck
     print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

run line 0 = ([],0,-1,-1)
run line n =
	let Just(elem,line') = readInt line
	in
		let (stack,switches,last',first') = run line' (n-1)
		in
			if(stack==[])
			then (((elem,1):[]),0,elem,elem)
			else
				let ((_,count):s) = stack in
					if (elem == first')
					then (((elem,count+1):s),switches,last',elem)
					else (((elem,1):stack),switches+1,last',elem)
	where readInt s = BSC.readInt (BSC.dropWhile isSpace s)

addTo z start 0 = z
addTo z start end = (start:(addTo z (start+1) (end-1)))

--solve :: Integral a => [(a,a)] -> [(a,a)] -> a -> a -> a -> ([a],[a])
solve [] [] _ _ _ 0 = ([],[])
solve [] [] _ _ _ extra = ([],[extra])
solve [] ((c,d):sStack) n m count extra =
	if (sStack==[] && c==0)
	then
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, (cards))
	else
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, ((count+d):cards))
solve ((a,b):fStack) [] n m count extra =
	if(fStack==[] && a==0)
	then
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), (cards))
	else
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), ((count+b):cards))
solve ((a,b):fStack) ((c,d):sStack) n m count extra
	| a==c =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, (cards))
		else
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, ((count+b+d):cards))
	| otherwise =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in ((addTo (addTo stack m d) n b), ((count+b):cards))
		else
			let
			    (stack, cards) =
			        solve fStack sStack (n+b) (m+d) (count+b+d) (count+b+d)
			in ((addTo (addTo stack m d) n b), ((count+b):cards))

countTurns fSwitch sSwitch fLast sLast
	| fSwitch > sSwitch && fLast==1 = fSwitch + 1
	| fSwitch > sSwitch && fLast==0 = fSwitch
	| sSwitch > fSwitch && sLast==1 = sSwitch + 1
	| sSwitch > fSwitch && sLast==0 = sSwitch
	| fLast==sLast && fLast==0 = fSwitch
	| fLast==sLast && fLast==1 = fSwitch + 1
	| otherwise = fSwitch + 1

toStr array = tail $ foldr (\x y -> (' ':show(x)) ++ y) "" array

solve' fSwitch sSwitch fStack sStack fLast sLast n m
	| fSwitch>sSwitch =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| sSwitch>fSwitch =
		let
			(stack,cards) = solve sStack fStack (n+1) 1 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| fLast==sLast =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| fLast==0 =
		let
			(stack,cards) = solve fStack sStack 1 (n+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))
	| sLast==0 =
		let
			(stack,cards) = solve sStack fStack 1 (m+1) 0 0
		in
			BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++
			show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++
			(toStr cards)))

main =
  do
     all <- BSC.readFile "input.txt"
     let (n':firstLine:m':secondLine:_) = BSC.lines all
     let Just (n,_) = readInt n'
     let Just (m,_) = readInt m'
     --print n
     --print firstLine
     --print m
     --print secondLine
     let (fStack,fSwitch,fLast,fFirst) = run firstLine n
     let (sStack,sSwitch,sLast,sFirst) = run secondLine m
     solve' fSwitch sSwitch fStack sStack fLast sLast n m

     --print $ run secondLine m
     --let (firstDeck, r2)  = readMany n readInteger r1
     --let Just (m, r3) = readInteger r2
     --let (secondDeck, _) = readMany m readInteger r3
   --  solve n m firstDeck secondDeck
     print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB a b
	| switchA > switchB =
		if (firstA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0,0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((1,0):b) 0 (switchA+1)))))
	| switchB > switchA = if (firstB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0,0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((1,0):a) b 0 (switchB+1)))))
	| firstA==0 && firstB==0 = show(switchA) ++ ("\n" ++ (init(sum' a b 0 switchA)))
	| firstA==1 && firstB==1 = show(switchA+1) ++ ("\n" ++ (init(sum' a b 0 (switchA+1))))
	| firstA==0 && firstB==1 = show(switchA + 1)  ++ ("\n" ++ (init(sum' a ((0,0):b) 0 (switchA+1))))
	| firstA==1 && firstB==0 = show(switchA + 1)  ++ ("\n" ++ (init(sum' ((0,0):a) b 0(switchA+1))))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==0 = stack a b n (n+m) []
	| otherwise = stack b a (n+m) n []

stack [] [] n m z = init z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) (y:ys) n m z = stack (y:ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m firstA) ++ "\n" ++ (countTurns switchA switchB firstA firstB a b)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     BS.writeFile "output.txt" $ BSC.pack "1 2 4 5 6 7 3\n3\n1 2 7"
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB a b
	| switchA > switchB =
		if (firstA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchA) else init (sum' a ((0,0):b) 0 switchA))))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchA+1)) else init(sum' a ((1,0):b) 0 (switchA+1)))))
	| switchB > switchA = if (firstB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 switchB) else init(sum' ((0,0):a) b 0 switchB))))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then init(sum' a b 0 (switchB+1)) else init(sum' ((1,0):a) b 0 (switchB+1)))))
	| firstA==0 && firstB==0 = show(switchA) ++ ("\n" ++ (init(sum' a b 0 switchA)))
	| firstA==1 && firstB==1 = show(switchA+1) ++ ("\n" ++ (init(sum' a b 0 (switchA+1))))
	| firstA==0 && firstB==1 = show(switchA + 1)  ++ ("\n" ++ (init(sum' a ((0,0):b) 0 (switchA+1))))
	| firstA==1 && firstB==0 = show(switchA + 1)  ++ ("\n" ++ (init(sum' ((0,0):a) b 0(switchA+1))))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA firstB
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==firstB = stack a b n (n+m) []
	| firstA==0 && firstB==1 = stack a b n (n+m) []
	| firstA==1 && firstB==0 = stack b a (n+m) n []

stack [] [] n m z = init z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) ((c,d):ys) n m z
	| (length ys) > (length xs) = stack ((a,b):xs) (ys) n (m-d) (addTo z m d)
	| otherwise =  stack ((c,d):ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m firstA firstB) ++ "\n" ++ (countTurns switchA switchB firstA firstB a b)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

run line 0 = ([],0,-1,-1)
run line n =
	let Just(elem,line') = readInt line
	in
		let (stack,switches,last',first') = run line' (n-1)
		in
			if(stack==[])
			then (((elem,1):[]),0,elem,elem)
			else
				let ((_,count):s) = stack in
					if (elem == first')
					then (((elem,count+1):s),switches,last',elem)
					else (((elem,1):stack),switches+1,last',elem)
	where readInt s = BSC.readInt (BSC.dropWhile isSpace s)

addTo z start 0 = z
addTo z start end = (start:(addTo z (start+1) (end-1)))

--solve :: Integral a => [(a,a)] -> [(a,a)] -> a -> a -> a -> ([a],[a])
solve [] [] _ _ _ 0 = ([],[])
solve [] [] _ _ _ extra = ([],[extra])
solve [] ((c,d):sStack) n m count extra =
	if (sStack==[] && c==0)
	then
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, (cards))
	else
		let  (stack, cards) = solve [] sStack n (m+d) (count+d) 0
		in (addTo stack m d, ((count+d):cards))
solve ((a,b):fStack) [] n m count extra =
	if(fStack==[] && a==0)
	then
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), (cards))
	else
		let (stack, cards) = solve fStack [] (n+b) m (count+b) 0
		in ((addTo stack n b), ((count+b):cards))
solve ((a,b):fStack) ((c,d):sStack) n m count extra
	| a==c =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, (cards))
		else
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in (addTo (addTo stack m d) n b, ((count+b+d):cards))
	| otherwise =
		if(fStack==sStack && fStack==[] && c==0)
		then
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) 0
			in ((addTo (addTo stack m d) n b), ((count+b):cards))
		else
			let (stack, cards) = solve fStack sStack (n+b) (m+d) (count+b+d) (count+b+d)
			in ((addTo (addTo stack m d) n b), ((count+b):cards))

countTurns fSwitch sSwitch fLast sLast
	| fSwitch > sSwitch && fLast==1 = fSwitch + 1
	| fSwitch > sSwitch && fLast==0 = fSwitch
	| sSwitch > fSwitch && sLast==1 = sSwitch + 1
	| sSwitch > fSwitch && sLast==0 = sSwitch
	| fLast==sLast && fLast==0 = fSwitch
	| fLast==sLast && fLast==1 = fSwitch + 1
	| otherwise = fSwitch + 1

toStr array = tail $ foldr (\x y -> (' ':show(x)) ++ y) "" array

main =
  do
     all <- BSC.readFile "input.txt"
     let (n':firstLine:m':secondLine:_) = BSC.lines all
     let Just (n,_) = readInt n'
     let Just (m,_) = readInt m'
     --print n
     --print firstLine
     --print m
     --print secondLine
     let (fStack,fSwitch,fLast,fFirst) = run firstLine n
     let (sStack,sSwitch,sLast,sFirst) = run secondLine m
     let (stack,cards) = solve fStack sStack 1 (n+1) 0 0

     BS.writeFile "output.txt" $ (BSC.pack ( (toStr stack) ++ "\n" ++ show(countTurns fSwitch sSwitch fLast sLast) ++ "\n" ++ (toStr cards)))

     --print $ run secondLine m
     --let (firstDeck, r2)  = readMany n readInteger r1
     --let Just (m, r3) = readInteger r2
     --let (secondDeck, _) = readMany m readInteger r3
   --  solve n m firstDeck secondDeck
     print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)

import Data.Char (isSpace)
import Data.Char (intToDigit)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

countSwitch :: (Integral a) => [a] -> [(a,a)] -> a -> ([(a,a)],a)
countSwitch [] z n = (z,n)
countSwitch (x:xs) [] _ = countSwitch xs ((x,1):[]) 0
countSwitch (x:xs) ((a,b):zs) n
	| x==a = countSwitch xs ((a,succ b):zs) n
	| otherwise = countSwitch xs ((x,1):(a,b):zs) (n+1)

countTurns switchA switchB firstA firstB a b
	| switchA > switchB =
		if (firstA == 0)
			then (show (switchA) ++ ("\n" ++ (if (firstB==firstA) then sum' a b 0 switchA else sum' a ((0,0):b) 0 switchA)))
			else (show (switchA+1) ++ ("\n" ++ (if (firstB==firstA) then sum' a b 0 (switchA+1) else sum' a ((1,0):b) 0 (switchA+1))))
	| switchB > switchA = if (firstB == 0)
		then (show (switchB) ++ ("\n" ++ (if (firstB==firstA) then sum' a b 0 switchB else sum' ((0,0):a) b 0 switchB)))
		else (show (switchB+1) ++ ("\n" ++ (if (firstB==firstA) then sum' a b 0 (switchB+1) else sum' ((1,0):a) b 0 (switchB+1))))
	| firstA==0 && firstB==0 = show(switchA) ++ ("\n" ++ (sum' a b 0 switchA))
	| firstA==1 && firstB==1 = show(switchA+1) ++ ("\n" ++ (sum' a b 0 (switchA+1)))
	| firstA==0 && firstB==1 = show(switchA + 1)  ++ ("\n" ++ (sum' a ((0,0):b) 0 (switchA+1)))
	| firstA==1 && firstB==0 = show(switchA + 1)  ++ ("\n" ++ (sum' ((0,0):a) b 0(switchA+1)))

sum' _ _ _ 0 = []
sum' [] [] _ _= []
sum' ((_,a):as) ((_,b):bs) partial toGo = show (a + b + partial) ++ (' ' : (sum' as bs (a + b + partial) (toGo-1)))
sum' [] ((_,b):bs) partial toGo = show (b + partial) ++ (' ' : (sum' [] bs (b + partial) (toGo-1)))
sum' ((_,a):as) [] partial toGo = show (a + partial) ++ (' ' : (sum' [] as (a + partial) (toGo-1)))

addTo z start 0 = z
addTo z start end = addTo (show(start)++(' ':z)) (start-1) (end-1)

buildStack switchA switchB a b n m firstA
	| switchA > switchB = stack a b n (n+m) []
	| switchB > switchA = stack b a (n+m) n []
	| firstA==0 = stack a b n (n+m) []
	| otherwise = stack b a (n+m) n []

stack [] [] n m z = z
stack ((a,b):xs) [] n m z = stack xs [] (n-b) m (addTo z n b)
stack [] ((a,b):ys) n m z = stack [] ys n (m-b) (addTo z m b)
stack ((a,b):xs) (y:ys) n m z = stack (y:ys) xs m (n-b) (addTo z n b)

solve n m firstDeck secondDeck =
	let
		(a,switchA) = countSwitch firstDeck [] n
		(b,switchB) = countSwitch secondDeck [] m
	in
		let
			((firstA,_):as) = a
			((firstB,_):bs) = b
		in
			do
				print a
				print b
				BS.writeFile "output.txt" $ (BSC.pack ((buildStack switchA switchB a b n m firstA) ++ "\n" ++ (countTurns switchA switchB firstA firstB a b)))

main =
  do
     all <- BS.readFile "input.txt"
     let Just (n, r1) = readInteger all
     let (firstDeck, r2)  = readMany n readInteger r1
     let Just (m, r3) = readInteger r2
     let (secondDeck, _) = readMany m readInteger r3
     solve n m firstDeck secondDeck
     --print "hi"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany 0 _ s = ([], s)
        readMany n readf s = case readf s of
          Just (x, r) -> let (xs, t) = readMany (n-1) readf r
                         in  (x : xs, t)
          Nothing     -> ([], s)


import Data.List
import Data.Maybe
import Data.Function
import Control.Monad
import qualified Data.ByteString.Char8 as B

readIntegers :: IO [Integer]
readIntegers = map (fst . fromJust . B.readInteger) . B.words <$> B.getLine

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

apply (s,ans) ('L',x)
    | s - x > 0 = (s-x, ('R':ans))
    | otherwise = (s+x, ('L':ans))
apply (s,ans) ('R',x)
    | s + x < 0 = (s+x, ('L':ans))
    | otherwise = (s-x, ('R':ans))

parts (d:ds) bs (g:gs) =
    let z = length d
        (b1,b2) = splitAt (z-1) bs
    in (g:b1) : parts ds b2 gs
parts _ _ _ = []

main = do
    [n] <- readInts
    arr <- readIntegers
    expdir <- getLine
    let sorted = sort arr
        blocks = group expdir
        k = length blocks
        (bads, goods) = splitAt (n-k) sorted
        order = parts blocks (reverse bads) goods
        greedy = zip expdir $ concat order
        dirs = reverse $ snd $ foldl' apply (0,"") greedy
    forM_ (zip dirs greedy) $ \(d,(_,x)) -> do
        putStrLn $ show x ++ [' ', d]

import Data.List
import Data.Maybe
import Data.Function
import Control.Monad
import qualified Data.ByteString.Char8 as B

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

apply (s,ans) ('L',x)
    | s - x > 0 = (s-x, ('R':ans))
    | otherwise = (s+x, ('L':ans))
apply (s,ans) ('R',x)
    | s + x < 0 = (s+x, ('L':ans))
    | otherwise = (s-x, ('R':ans))

parts (d:ds) bs (g:gs) =
    let z = length d
        (b1,b2) = splitAt (z-1) bs
    in (g:b1) : parts ds b2 gs
parts _ _ _ = []

main = do
    [n] <- readInts
    arr <- readInts
    expdir <- getLine
    let sorted = sort arr
        blocks = group expdir
        k = length blocks
        (bads, goods) = splitAt (n-k) sorted
        order = parts blocks (reverse bads) goods
        greedy = zip expdir $ concat order
        dirs = reverse $ snd $ foldl' apply (0,"") greedy
    forM_ (zip dirs greedy) $ \(d,(_,x)) -> do
        putStrLn $ show x ++ [' ', d]

import Data.List
import Data.Maybe
import Data.Function
import Control.Monad
import qualified Data.ByteString.Char8 as B

readIntegers :: IO [Integer]
readIntegers = map (fst . fromJust . B.readInteger) . B.words <$> B.getLine

apply (sl,sr,ans) ('L',x)
    | sr + x < sl = (sl, sr+x, ('R':ans))
    | otherwise = (sl+x,sr, ('L':ans))
apply (sl,sr,ans) ('R',x)
    | sl + x < sr = (sl+x, sr, ('L':ans))
    | otherwise = (sl, sr+x, ('R':ans))

main = do
    getLine
    arr <- readIntegers
    expdir <- getLine
    let sorted = sort arr
        greedy = concat $ map reverse $ groupBy ((==) `on` fst) $ zip expdir sorted
        dirs = reverse $ (\(_,_,x) -> x) $ foldl' apply (0,0,"") greedy
    forM_ (zip dirs greedy) $ \(d,(_,x)) -> do
        putStrLn $ show x ++ [' ', d]


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
import           Data.Array
-- import           Data.Array.ST
-- import           Data.Array.Unsafe
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
import           Data.Set (Set)
import qualified Data.Set as Set
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

out = stdout

main = do
  n <- readInt1 <$> BS.getLine
  ss <- map readInt2 <$> replicateM n BS.getLine
  print $ solve ss

solve :: [(Int,Int)] -> Integer
solve ss = x + y - z where
  x = sum . map ((flip comb 2).fromIntegral.length) . group . sort . fst . unzip $ ss
  y = sum . map ((flip comb 2).fromIntegral.length) . group . sort . snd . unzip $ ss
  z = sum . map ((flip comb 2).fromIntegral.length) . group . sort $ ss

comb 1 r = 0
comb n r = iterate (scanl1 (+)) [1,1..] !! (n-r) !! r

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

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

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

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

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

-- output functions

data Cell  = ByteStringC BL.ByteString
           | IntC Int
           | Int64C Int64
           deriving( Eq, Ord, Show )

data Row   = ListR [Cell]
           | TupleR (Cell,Cell)
           | TripleR (Cell,Cell,Cell)
           deriving( Eq, Ord, Show )

type Table = [Row]

infixr 4 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

putAns :: Handle -> Table -> IO ()
putAns o = hPutBuilder o . renderTable

renderTable :: Table -> Builder
renderTable rs = mconcat [renderRow r <> char8 '\n' | r <- rs]

renderRow :: Row -> Builder
renderRow (ListR []) = mempty
renderRow (ListR (c:cs)) = renderCell c <> mconcat [ char8 ' ' <> renderCell c' | c' <- cs ]
renderRow (TupleR (x,y)) = renderCell x <> char8 ' ' <> renderCell y
renderRow (TripleR (x,y,z)) = renderCell x <> char8 ' ' <> renderCell y <> char8 ' ' <> renderCell z

renderCell :: Cell -> Builder
renderCell (ByteStringC cs) = lazyByteString cs
renderCell (IntC i) = intDec i
renderCell (Int64C i) = int64Dec i

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import Data.List
import Data.Ord

data SP = SP{
  sfst::{-# UNPACK #-} !Int,
  ssnd:: {-# UNPACK #-} !Int
}deriving (Eq, Ord)

countBy::Eq a=>(b->a)->[b]->Integer
countBy f = walk where
  walk (x:xs) = go x 1 0 xs
  walk []     = 0
  go _ _ acc [] = acc
  go y c acc (x:xs)
    | f x == f y = go x (c+1) (acc + c) xs
    | otherwise  = go x 1     acc       xs

main::IO ()
main = do
  n <-fmap  read getLine
  let lsp [x,y] = SP x y
      lsp _     = undefined
  es <- replicateM n $ fmap  (lsp .map read . words)  getLine::IO [SP]
  let xs = sort                    es
      ys = sortBy (comparing ssnd) xs
  print (countBy sfst xs + countBy ssnd ys - countBy id xs)

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import Data.List
import Data.Ord

data SP = SP{
  sfst::{-# UNPACK #-} !Int,
  ssnd:: {-# UNPACK #-} !Int
}deriving (Eq, Ord)

data ST a = ST !a {-# UNPACK #-} !Int Integer

countBy::Eq a=>(b->a)->[b]->Integer
countBy f = walk where
  thrd (ST _ _ x) = x
  walk (x:xs) = thrd $ foldl' go (ST x 1 0) xs
  walk []     = 0
  go (ST y c acc) x
    | f x == f y = ST x (c+1) (acc + fromIntegral c)
    | otherwise  = ST x 1   acc

main::IO ()
main = do
  n <-fmap  read getLine
  let lsp [x,y] = SP x y
      lsp _     = undefined
  es <- replicateM n $ fmap  (lsp .map read . words)  getLine::IO [SP]
  let xs = sort                    es
      ys = sortBy (comparing ssnd) xs
  print (countBy sfst xs + countBy ssnd ys - countBy id xs)

import Data.List
import Data.Maybe
import Data.Functor
import Data.Function (on)
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as B

main :: IO()
main = do
    _ <- getLine
    a <- readAllInts
    print $ solve $ selfZip a

readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt

readAllInts :: IO [Int]
readAllInts = map readInt . B.words <$> B.getContents

count :: [[a]] -> Integer
count a = sum $ map ((\x -> x * (x - 1) `div` 2) . fromIntegral . length) a

solve :: [(Int, Int)] -> Integer
solve a = let sx = sort a
              sy = sortBy (compare `on` snd) a
              gx = groupBy ((==) `on` fst) sx
              gy = groupBy ((==) `on` snd) sy
              gxy = group sx
              cx = count gx
              cy = count gy
              cxy = count gxy
          in cx + cy - cxy

selfZip :: [Int] -> [(Int, Int)]
selfZip [] = []
selfZip (a:b:s) = (a, b):selfZip s

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

comb2::Int->Integer

comb2 n = fromIntegral $ div ((fromIntegral n) * (fromIntegral (n-1)) ) 2

process q=   sum $ map comb2  $ filter (>1) $ I.elems $ I.fromListWith (+) $ zip q $ repeat 1

main=do
	s<- getLine
	[t1,t2]<- transpose. map (map (fst.fromJust.C.readInt)). map C.words. C.lines <$> C.getContents ::IO [[Int]]
	let n1 = process t1 + process t2
	let n2 =  sum $ map comb2  $filter (>1) $ map length $ group $ sort (zip t1 t2)
	print $ n1-n2

import Control.Monad
import Control.Applicative

import Data.List
import Data.Maybe
import Data.Function(on)
import Data.Tuple(swap)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    _ <- readLn :: IO Int
    ps <- map l2p <$> readAllInts
    let count f = sum .
                  map ((\x -> x * (x-1) `div` 2) . fromIntegral . length) .
                  groupBy ((==) `on` f) .
                  sortBy (compare `on` f)
    let a,b,c :: Integer
        a = count fst ps
        b = count snd ps
        c = count id  ps
    print $ a + b - c

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

import Data.List
import Data.Tree
import Data.Int
import Data.Word
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  C.getLine >>= \n -> print.solve =<< (forM [1..(fst.fromJust.C.readInt) n] $ \ i -> C.getLine>>= \js -> return $ map (fst.fromJust.C.readInt) $ C.words js)
solve:: [[Int]] -> Integer
solve xs = (+) (slv1 xs) $ sum $ map (\a->comb2 $ fromIntegral $ length a) $ groupBy (\a b ->(head a) == (head b)) $ sortBy (\ a b -> (head a) `compare` (head b)) xs
slv1 xs = let ys= groupBy (\a b ->(last a) == (last b)) $ sortBy (\ a b -> (last a) `compare` (last b)) xs;
              zs = map ( \ as -> groupBy (\a b ->(head a) == (head b)) $ sortBy (\ a b -> (head a) `compare` (head b)) as ) ys in sum (map (\a->comb2 $  fromIntegral $ length a) ys) -  sum  (map (\ as-> sum $ map (\a->comb2 $  fromIntegral $ length a) as) zs)
comb2 x = (x*(x-1)) `div` 2

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import Data.List
import Data.Ord

countBy::Eq a=>(b->a)->[b]->Integer
countBy f = walk where
  walk (x:xs) = go x 1 0 xs
  walk []     = 0
  go _ _ acc [] = acc
  go y c acc (x:xs)
    | f x == f y = go x (c+1) (acc + c) xs
    | otherwise  = go x 1     acc       xs

main::IO ()
main = do
  n <-fmap  read getLine
  let m = 2^(31::Int)
      lsp [x,y] = x*m+y
      lsp _     = undefined
      sfst x = div x m
      ssnd x = mod x m
  es <- replicateM n $ fmap  (lsp .map read . words)  getLine::IO [Int]
  let xs = sort                    es
      ys = sortBy (comparing ssnd) es
  print (countBy sfst xs + countBy ssnd ys - countBy id xs)

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import Data.List
import Data.Ord
import Data.Int

countBy::Eq a=>(b->a)->[b]->Integer
countBy f = walk where
  walk (x:xs) = go x 1 0 xs
  walk []     = 0
  go _ _ acc [] = acc
  go y c acc (x:xs)
    | f x == f y = go x (c+1) (acc + c) xs
    | otherwise  = go x 1     acc       xs

main::IO ()
main = do
  n <-fmap  read getLine
  let m = 2^(31::Int)
      lsp [x,y] = x*m+y
      lsp _     = undefined
      sfst x = div x m
      ssnd x = mod x m
  es <- replicateM n $ fmap  (lsp .map read . words)  getLine::IO [Int64]
  let xs = sort                    es
      ys = sortBy (comparing ssnd) es
  print (countBy sfst xs + countBy ssnd ys - countBy id xs)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
import           Data.Array
-- import           Data.Array.ST
-- import           Data.Array.Unsafe
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
import           Data.Set (Set)
import qualified Data.Set as Set
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

out = stdout

main = do
  n <- readInt1 <$> BS.getLine
  ss <- map readInt2 <$> replicateM n BS.getLine
  print $ solve ss

solve :: [(Int,Int)] -> Int
solve ss = x + y - z where
  x = sum . map ((flip comb 2).length) . group . sort . fst . unzip $ ss
  y = sum . map ((flip comb 2).length) . group . sort . snd . unzip $ ss
  z = sum . map ((flip comb 2).length) . group . sort $ ss

comb 1 r = 0
comb n r = iterate (scanl1 (+)) [1,1..] !! (n-r) !! r

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

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

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

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

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

-- output functions

data Cell  = ByteStringC BL.ByteString
           | IntC Int
           | Int64C Int64
           deriving( Eq, Ord, Show )

data Row   = ListR [Cell]
           | TupleR (Cell,Cell)
           | TripleR (Cell,Cell,Cell)
           deriving( Eq, Ord, Show )

type Table = [Row]

infixr 4 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

putAns :: Handle -> Table -> IO ()
putAns o = hPutBuilder o . renderTable

renderTable :: Table -> Builder
renderTable rs = mconcat [renderRow r <> char8 '\n' | r <- rs]

renderRow :: Row -> Builder
renderRow (ListR []) = mempty
renderRow (ListR (c:cs)) = renderCell c <> mconcat [ char8 ' ' <> renderCell c' | c' <- cs ]
renderRow (TupleR (x,y)) = renderCell x <> char8 ' ' <> renderCell y
renderRow (TripleR (x,y,z)) = renderCell x <> char8 ' ' <> renderCell y <> char8 ' ' <> renderCell z

renderCell :: Cell -> Builder
renderCell (ByteStringC cs) = lazyByteString cs
renderCell (IntC i) = intDec i
renderCell (Int64C i) = int64Dec i

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

comb2 n = div (n*(n-1)) 2

process q=   sum $ map comb2  $ filter (>1) $ I.elems $ I.fromListWith (+) $ zip q $ repeat 1

main=do
	s<- getLine
	[t1,t2]<- transpose. map (map (fst.fromJust.C.readInt)). map C.words. C.lines <$> C.getContents ::IO [[Int]]
	let n1 = process t1 + process t2
	let n2 =  sum $ map comb2  $filter (>1) $ map length $ group $ sort (zip t1 t2)
	print $ n1-n2

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

comb2::Int->Integer

comb2 n = fromIntegral (div (n*(n-1)) 2)

process q=   sum $ map comb2  $ filter (>1) $ I.elems $ I.fromListWith (+) $ zip q $ repeat 1

main=do
	s<- getLine
	[t1,t2]<- transpose. map (map (fst.fromJust.C.readInt)). map C.words. C.lines <$> C.getContents ::IO [[Int]]
	let n1 = process t1 + process t2
	let n2 =  sum $ map comb2  $filter (>1) $ map length $ group $ sort (zip t1 t2)
	print $ n1-n2

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  C.getLine >>= \n -> putStrLn.solve =<< (forM [1..(fst.fromJust.C.readInt) n] $ \ i -> C.getLine>>= \js -> return $ map (fst.fromJust.C.readInt) $ C.words js)
solve xs = show $ (+) (slv1 xs) $ sum $ map (\a->comb2 $ length a) $ groupBy (\a b ->(head a) == (head b)) $ sortBy (\ a b -> (head a) `compare` (head b)) xs
slv1 xs = let ys= groupBy (\a b ->(last a) == (last b)) $ sortBy (\ a b -> (last a) `compare` (last b)) xs;
              zs = map ( \ as -> groupBy (\a b ->(head a) == (head b)) $ sortBy (\ a b -> (head a) `compare` (head b)) as ) ys in sum (map (\a->comb2 $ length a) ys) -  sum  (map (\ as-> sum $ map (\a->comb2 $ length a) as) zs)
comb2 x = (x*(x-1)) `div` 2


{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad
import Data.Int

{-
u x = head [ p | p <- [x,x-1..], P.isPrime p ]
v x = head [ p | p <- [x+1..], P.isPrime p ]
solve = scanl (+) 0 [ 1 % (u(x)*v(x)) | x <- [2..] ]
-}

isPrime primes n = all (\p -> n `mod` p /= 0) $ takeWhile (<n) primes

u primes x = head [ p | p <- [x,x-1..], isPrime primes p ]
v primes x = head [ p | p <- [x+1..],   isPrime primes p ]

solve' primes n = let x = fromIntegral $ u primes n :: Int64
                      y = fromIntegral $ v primes n
                      n' = fromIntegral n
                      a = 2*n' - 2*x - 2*y + 2 + x*y
                      b = 2*x*y
                      g = gcd a b
                  in (div a g, div b g)

isqrt :: Integral a => a -> Int
isqrt n = floor $ sqrt ((fromIntegral n) :: Double)

sieve arr = do
  (_,hi) <- getBounds arr
  let maxi = isqrt hi
  forM_ [2..maxi] $ \i -> do
    v <- readArray arr i
    if v == 0
      then let v = i*i in forM_ [v,v+i..hi] $ \j -> writeArray arr j (fromIntegral i)
      else return ()

genPrimes :: Integral a => Int -> IO [a]
genPrimes n = do
  parr' <- newArray (2,n) 0 :: IO (IOUArray Int Int)
  sieve parr'
  parr <- M.freeze parr' :: IO (UArray Int Int)
  let primes = map (fromIntegral.fst) $ filter (\(i,v) -> v == 0) $ I.assocs parr
  return primes

test = do
  primes <- genPrimes 100 :: IO [Int]
  return $ all (isPrime primes) [2,3,5,7,11,13]

main = do
  primes <- genPrimes 32000 :: IO [Int]
  n <- fmap  read getLine
  replicateM_ n $ do
    x <- fmap read getLine
    let (a,b) = solve' primes x
    putStrLn $ show a ++ "/" ++ show b

f::Integer->Integer->Bool
f d n
  |n<d*d=True
  |n `mod` d==0=False
  |otherwise=f (d+1) n

f2::[Integer]->[String]
f2 []=[]
f2 (2:xs)="1/6":f2 xs
f2 (3:xs)="7/30":f2 xs
f2 (4:xs)="3/10":f2 xs
f2 (x:xs)=let p1=head $ [t0|t0<-[x,(x-1)..1],f 2 t0]
              p2=head $ [t1|t1<-[(x+1)..],f 2 t1]
              u1=p1-2
              d1=p1*2
              u2=x-p1+1
              d2=p1*p2
              u3=u1*d2+u2*d1
              d3=d1*d2
              t=(gcd u3 d3)
          in ((show (u3 `div` t))++"/"++(show (d3 `div` t))):(f2 xs)

main = do
       e<-getLine
       es<-getContents
       let xs=map read (lines es)::[Integer]
       mapM_ putStrLn $ f2 xs

{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad

{-
u x = head [ p | p <- [x,x-1..], P.isPrime p ]
v x = head [ p | p <- [x+1..], P.isPrime p ]
solve = scanl (+) 0 [ 1 % (u(x)*v(x)) | x <- [2..] ]
-}

isPrime primes n = all (\p -> n `mod` p /= 0) $ takeWhile (<n) primes

u primes x = head [ p | p <- [x,x-1..], isPrime primes p ]
v primes x = head [ p | p <- [x+1..],   isPrime primes p ]

solve' primes n = let x = u primes n
                      y = v primes n
                      a = 2*n - 2*x - 2*y + 2 + x*y
                      b = 2*x*y
                      g = gcd a b
                  in (div a g, div b g)

isqrt :: Integral a => a -> Int
isqrt n = floor $ sqrt ((fromIntegral n) :: Double)

sieve arr = do
  (_,hi) <- getBounds arr
  let maxi = isqrt hi
  forM_ [2..maxi] $ \i -> do
    v <- readArray arr i
    if v == 0
      then let v = i*i in forM_ [v,v+i..hi] $ \j -> writeArray arr j (fromIntegral i)
      else return ()

genPrimes :: Integral a => Int -> IO [a]
genPrimes n = do
  parr' <- newArray (2,n) 0 :: IO (IOUArray Int Int)
  sieve parr'
  parr <- M.freeze parr' :: IO (UArray Int Int)
  let primes = map (fromIntegral.fst) $ filter (\(i,v) -> v == 0) $ I.assocs parr
  return primes

test = do
  primes <- genPrimes 100 :: IO [Int]
  return $ all (isPrime primes) [2,3,5,7,11,13]

main = do
  primes <- genPrimes 32000 :: IO [Int]
  n <- fmap  read getLine
  replicateM_ n $ do
    x <- fmap read getLine
    let (a,b) = solve' primes x
    putStrLn $ show a ++ "/" ++ show b


module Main (f, main) where

import Control.Arrow ((>>>))
import Data.Function (on, (&))
import Data.List (groupBy)

f [s, [c]] | length s & odd = c `elem` (takeEvenIndices s)
f _ = False

takeEvenIndices = takeIndicesWhich even
takeIndicesWhich predicate = enumerate >>> filter (fst >>> predicate) >>> unenumerate

main = interact $ lines >>> drop 1 >>> chunksOf 2 >>> map (f >>> boolToYesNo) >>> unlines

boolToYesNo p = if p then "YES" else "NO"

groupByKey = ((==) `on`) >>> groupBy
chunksOf n = enumerate >>> groupByKey (fst >>> (`div` n)) >>> map unenumerate

enumerate = zip [0..]
unenumerate = map snd

main=interact$unlines.map f.t.tail.lines
f[s,[c]]=b$elem c$map head$t s
t[]=[]
t(a:b:s)=[a,b]:t s
t x=[x]
b x|x="YES"
b _="NO"

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (y:z:xs) =  func y z : solve xs

func :: String -> String -> String
func y z = if poss y z then "YES" else "NO"

poss :: String -> String -> Bool
poss xs y
    | length xs == 1 = head xs == head y
    | head xs == head y = True
    | otherwise = poss (tail (tail xs)) y

main :: IO()
main = interact $ unlines.solve.tail.lines

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = (Char, String)
type OutType = Bool

solve :: InType -> OutType
solve (c, s) = c `elem` oddPos s
  where oddPos [] = []
        oddPos [a] = [a]
        oddPos (a : b : t) = a : oddPos t

receive :: [String] -> InType
receive [s, c] = (head c, s)
receive _      = error "input error"

main :: IO ()
main = interact $ unlines . map (showB . solve . receive) . chunksOf 2 . tail . lines
  where showB False = "No"
        showB True  = "Yes"


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

solve2 :: [Int] -> [Int] -> Int -> Int -> Int
solve2 ls rs ln rn =
    let t = min ((rn-ln) `div` 2) $ sum (map (`div` 2) rs)
    in
        ln + (rn-ln) - t

solve :: [Int] -> [Int] -> Int
solve ls rs =
    let ln = sum ls
        rn = sum rs
    in
        if ln < rn then
            solve2 ls rs ln rn
        else
            solve2 rs ls rn ln

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n,ln,rn] <- map parseInt . BS.words <$> BS.getLine
        cs <- map parseInt . BS.words <$> BS.getLine
        let (ls,rs) = splitAt ln cs
            qa = accumArray (+) 0 (1,n) $ map (,1) ls ++ map(,-1) rs :: UArray Int Int
            qs = elems qa
            l = filter (>0) qs
            r = map abs $ filter (<0) qs
        print $ solve l r

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed

ctArr :: Int -> [Int] -> UArray Int Int
ctArr n vs = accumArray (\v _ -> v+1) 0 (1, n) $ zip vs $ repeat ()

step :: (Int, Int, Int) -> (Int, Int) -> (Int, Int, Int)
step (!psave, !lsave, !rsave) (lct, rct)
  = (psave + min lct rct,
     lsave + div (max 0 $ lct - rct) 2,
     rsave + div (max 0 $ rct - lct) 2)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, lc, rc] <- readInts
    (lvs, rvs) <- splitAt lc <$> readInts
    let
      lcts = ctArr n lvs
      rcts = ctArr n rvs
      (psave, lsave, rsave) = foldl' step (0, 0, 0)
        $ zip (elems lcts) (elems rcts)
      qsave = if  lc >= rc
        then  min lsave $ div (lc - rc) 2
        else  min rsave $ div (rc - lc) 2
    -- Worst case, we need n spent (2 for each pair)
    -- but we save one orientation-change for each less-common sock existing
    -- one color change for each already-matching pair
    -- and one more color change for each color-matching pair left over
    -- among the more common orientation
    putInts [n - psave - qsave - min lc rc]

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = readInt >>= flip replicateM getLine >>= putStrLn . which "YES" "NO" . solve

solve rows = runST $ do
	let
		n = length rows
	board <- newListArray ( ( 0, 0 ), ( n - 1, n - 1 ) ) ( concat rows ) :: ST s ( STUArray s ( Int, Int ) Char )
	res <- newSTRef True
	cnt <- newSTRef 0
	forM_ [ 0 .. n - 1 ] $ \y -> do
		forM_ [ 0 .. n - 1 ] $ \x -> do
			found <- ( '.' == ) <$> readArray board ( y, x )
			when found $ do
				forM_ ( zip [ 0, 1, 1, 1, 2 ] [ 0, -1, 0, 1, 0 ] ) $ \( dy, dx ) -> do
					let
						ny = y + dy
						nx = x + dx
						outside = not ( 0 <= ny && ny < n && 0 <= nx && nx < n )
					when outside $ do
						writeSTRef res False
						modifySTRef cnt succ
					when ( not outside ) $ do
						failed <- ( '#' == ) <$> readArray board ( ny, nx )
						if failed
							then writeSTRef res False
							else writeArray board ( ny, nx ) '#'
	readSTRef res

import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe

type Field = M.Map (Int, Int) Char

newState :: Int -> Maybe Field -> Maybe Field
newState n mf = mf >>= newState' n

newState' :: Int -> Field -> Maybe Field
newState' n f
  | null free
  = Nothing
  | x == 0 || x == n - 1 || y == n - 2 || y == n - 1
  = Nothing
  | elem '#'
    $ map (f M.!) [(y + 1, x - 1), (y + 1, x), (y + 1, x + 1), (y + 2, x)]
  = Nothing
  | otherwise
  = Just
    $ M.insert (y    , x)     '#'
    $ M.insert (y + 1, x - 1) '#'
    $ M.insert (y + 1, x)     '#'
    $ M.insert (y + 1, x + 1) '#'
    $ M.insert (y + 2, x) '#' f
 where
  free          = M.toList $ M.filter (== '.') f
  ((y, x), _):_ = free

main :: IO ()
main = do
  n     <- read <$> getLine :: IO Int
  field <-
    M.fromList
    .   concatMap (\(i, xs) -> zip (map ((,) i) [0 ..]) xs)
    .   zip [0 ..]
    <$> replicateM n getLine :: IO (M.Map (Int, Int) Char)
  let Just f = last $ takeWhile isJust $ iterate (newState n) (Just field)
  putStrLn $ if M.null (M.filter (== '.') f) then "YES" else "NO"

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  ans_Mid <- foldr
    (\ !x contx -> do
        vx1n <- liftA2 (&&) (rdA var (x,1)) (rdA var (x,n))
        if not vx1n then return False else do
        foldr
          (\ !y conty -> do
              vxy <- rdA var (x,y)
              if vxy then conty else do
              rest <- or . map fst <$> mapM (mdA' var (const True))
                [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
              if rest then return False else conty)
          contx
          [2..n-1])
    (return True)
    [1..n-2]
  if not ans_Mid then putStrLn "NO" else do
  ans <- foldr (\ !xy cont -> do
                   vxy <- rdA var xy
                   if vxy  then cont else return False)
    (return True)
    [(x,y) | x<-[n-1,n], y <- [1..n]]
  putStrLn $ if ans then "YES" else "NO"

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

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

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

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

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  forM_ [1..n-2] $ \ !x -> do
    vx1n <- and <$> mapM (rdA var) [(x,1),(x,n)]
    unless vx1n $ reply False
    forM_ [2..n-1] $ \ !y -> do
      vxy <- rdA var (x,y)
      unless vxy $ do
        vrest <- or . map fst <$> mapM (mdA' var $ const True)
          [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
        when vrest $ reply False
  forM_ [(x,y) | x<-[n-1,n], y <- [1..n]] $ \ !xy -> do
    vxy <- rdA var xy
    unless vxy $ reply False
  reply True
  where
    reply !b = do putStrLn $ if b then "YES" else "NO"
                  exitSuccess

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

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

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

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

import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe

type Field = M.Map (Int, Int) Char

newState :: Int -> Maybe Field -> Maybe Field
newState n mf = mf >>= newState' n

newState' :: Int -> Field -> Maybe Field
newState' n f
  | null free
  = Nothing
  | x == 0 || x == n - 1 || y == n - 2 || y == n - 1
  = Nothing
  | otherwise
  = Just
    $ M.insert (y    , x)     '#'
    $ M.insert (y + 1, x - 1) '#'
    $ M.insert (y + 1, x)     '#'
    $ M.insert (y + 1, x + 1) '#'
    $ M.insert (y + 2, x) '#' f
 where
  free          = M.toList $ M.filter (== '.') f
  ((y, x), _):_ = free

main :: IO ()
main = do
  n     <- read <$> getLine :: IO Int
  field <-
    M.fromList
    .   concatMap (\(i, xs) -> zip (map ((,) i) [0 ..]) xs)
    .   zip [0 ..]
    <$> replicateM n getLine :: IO (M.Map (Int, Int) Char)
  let Just f = last $ takeWhile isJust $ iterate (newState n) (Just field)
  putStrLn $ if M.null (M.filter (== '.') f) then "YES" else "NO"

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

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

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  ans_Mid <- foldr
    (\ !x contx -> do
        vx1n <- liftA2 (&&) (rdA var (x,1)) (rdA var (x,n))
        if not vx1n then return False else do
        foldr
          (\ !y conty -> do
              vxy <- rdA var (x,y)
              if vxy then conty else do
              rest <- or . map fst <$> mapM (mdA' var (const True))
                [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
              if rest then return False else conty)
          contx
          [2..n-1])
    (return True)
    [1..n-2]
  if not ans_Mid then putStrLn "NO" else do
  ans <- foldr (\ !xy cont -> do
                   vxy <- rdA var xy
                   if vxy  then cont else return False)
    (return True)
    [(x,y) | x<-[n-1,n], y <- [1..n-1]]
  putStrLn $ if ans then "YES" else "NO"

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

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

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

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


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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  [n, k] <- getInts
  cs <- fmap (map read . words) getLine :: IO [Int64]
  ids <- getInts

  let
    a = listArray (1, length cs) cs :: Array Int Int64
    s = sum cs

    b = accumArray (flip const) True (1, length cs) $ zip ids (repeat False) :: Array Int Bool

    cs' = map (a!) ids
    s1 = sum $ zipWith (*) cs' $ map (s-) $ scanl1 (+) cs'
    s2 = sum $ map (\(i, j) -> a!i * a!j) $ filter (\(i,j) -> b!i && b!j) $ [(i, i`mod`n + 1) | i <- [1..n]]

  print $ s1 + s2

import Data.Array
import qualified Data.IntSet as S
solve :: [Integer] -> [Int] -> Integer
solve cvs ids = cproads + circroute
    where n = length cvs
          cv = listArray (1, n) cvs
          idset = S.fromList ids
          cproads = let cp = map (cv !) ids in sum $ zipWith (*) cp (tail $ scanl (-) (sum cvs) cp)
          circroute = sum $ zipWith (\x y -> if (S.notMember x idset && S.notMember y idset) then cv ! x * cv ! y else 0) (n : [1..n-1]) [1..n]
main = do _ <- getLine
          x <- getLine
          y <- getLine
          putStrLn (show $ solve (map read $ words x) (map read $ words y))

module Main where

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

data City = City { charm :: Integer
                 , capital :: Bool
                 } deriving (Show, Eq)

mkCities :: [Int] -> [Int] -> [City]
mkCities cs is = go 1 cs is
    where go _ [] [] = []
          go i (c:cs) [] = (City (fromIntegral c) False) : go (i + 1) cs []
          go i (c:cs) jss@(j:js) | i == j = (City c' True) : go (i + 1) cs js
                                 | otherwise = (City c' False) : go (i + 1) cs jss
                                 where c' = fromIntegral c

getWeight :: City -> City -> City -> Integer -> Integer -> Integer
getWeight (City c True) _ _ all _ = (all - c) * c
getWeight (City c False) (City lw lc) (City rw rc) _ capitals | lc && rc = c * capitals
                                                              | lc && (not rc) = c * (capitals + rw)
                                                              | (not lc) && rc = c * (capitals + lw)
                                                              | otherwise = c * (capitals + lw + rw)

solve :: [Int] -> [Int] -> Integer
solve cs is = (go cities (last cities : cities) (tail cities ++ [head cities]) 0) `div` 2
    where cities = mkCities cs is
          all = sum $ map charm cities
          capitals = sum . map charm $ filter capital cities

          go [] _ _ result = result
          go (c:cs) (p:ps) (n:ns) result = go cs ps ns (result + getWeight c p n all capitals)

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                               Just (x, _) -> (x, ss)
                               Nothing -> error $ "Can't parse Int: " ++ (show s)

go :: Tokenizer Integer
go = do
  n <- nextInt
  k <- nextInt
  cs <- replicateM n nextInt
  is <- replicateM k nextInt
  return $ solve cs is

main :: IO ()
main = do
  input <- liftM L.words L.getContents
  let result = evalState go input
  print result

import Data.Maybe
import Data.Array
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum (map fromIntegral costs) :: Integer
    let capitalTotalCost = sum (map (\i -> fromIntegral (costs' ! i)) capitals) :: Integer
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] (0::Integer)) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + (ci * (totalCost - ci)))
        | otherwise = f is acc'
        where
            acc' = acc + fromIntegral (ci * (cnext + cprev + capitals'))
            ci = fromIntegral (costs ! i) :: Integer
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = fromIntegral (costs ! i_next) :: Integer
            cprev = fromIntegral (costs ! i_prev) :: Integer
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0

import Data.Maybe
import Data.Array
import Data.Int
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum costs
    let capitalTotalCost = sum (map (\i -> costs' ! i) capitals)
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] (0::Int64)) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + fromIntegral (ci * (totalCost - ci)))
        | otherwise = f is acc'
        where
            acc' = acc + fromIntegral (ci * (cnext + cprev + capitals'))
            ci = costs ! i
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = costs ! i_next
            cprev = costs ! i_prev
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0

import Data.Maybe
import Data.Array
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum costs
    let capitalTotalCost = sum (map (\i -> costs' ! i) capitals)
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] 0) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + ci * (totalCost - ci))
        | otherwise = f is acc'
        where
            acc' = acc + ci * (cnext + cprev + capitals')
            ci = costs ! i
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = costs ! i_next
            cprev = costs ! i_prev
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0