import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (replicate m '1') a b
        h0 = take m $ h (replicate m '0') a b

h _ _ [] = repeat 0
h t a ((var, x, op, y):b) =
  zipWith (+) k l
  where j "?" = t
        j x = a ! x
        k = zipWith (i op) (j x) (j y)
        k' = fmap (\x -> if x == 0 then '0' else '1') k
        l = h t (insert var k' a) b

i "AND" '1' '1' = 1 :: Int
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1

import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (insert "?" (repeat '1') a) b
        h0 = take m $ h (insert "?" (repeat '0') a) b

h _ [] = repeat 0
h a ((var, x, op, y):b) =
  zipWith (+) k s
  where k = zipWith (i op) (a ! x) (a ! y)
        l = fmap (\x -> if x == 0 then '0' else '1') k
        s = h (insert var l a) b

i "AND" '1' '1' = 1
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1

import Control.Applicative
import Control.Arrow
import Data.Either
import Data.Map.Strict

main = do
  m <- read . last . words <$> getLine
  (x, y) <- g m . first fromList . partitionEithers . fmap f . fmap words . lines <$> getContents
  putStrLn $ x
  putStrLn $ y

f [var, _, val] = Left (var, val)
f [var, _, x, op, y] = Right (var, x, op, y)

g m (a, b) =
  (x, y)
  where x = zipWith (\x y -> if x < y then '1' else '0') h1 h0
        y = zipWith (\x y -> if x > y then '1' else '0') h1 h0
        h1 = take m $ h (insert "?" (repeat '1') a) b
        h0 = take m $ h (insert "?" (repeat '0') a) b

h _ [] = repeat 0
h a ((var, x, op, y):b) =
  zipWith (+) k s
  where k = zipWith (i op) x y
        l = fmap (\x -> if x == 0 then '0' else '1') k
        s = h (insert var l a) b

i "AND" '1' '1' = 1
i "AND" _ _ = 0
i "OR" '0' '0' = 0
i "OR" _ _ = 1
i "XOR" x y | x == y = 0
            | x /= y = 1


main=interact$unlines.map(show.(\(a,b)->sum b+(maximum b)*(2^(sum a)-1)).unzip.map(until(odd.snd)(\(a,b)->(a+1,div b 2)).(,)0)).map(map read.words).t.tail.lines
t(_:x:s)=x:t s
t _=[]

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

recurse k ys [] = (k,ys)
recurse k ys (x:xs)
  | even x = recurse (k+1) ys (x`div`2 : xs)
  | odd x = recurse k (x:ys) xs

solve :: IO ()
solve = do
  ~[n] <- readv
  xs <- readv
  let
    (k,ys) = recurse 0 [] xs
    s = sum ys
    m = DL.maximum ys
    ans = s - m + (2^k)*m
  printv [ans]

printv :: [Integer] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat $  map (\x->DBB.integerDec x <> DBB.char8 ' ') xs

readv :: IO [Integer]
readv = map (maybe 0 fst . DBC.readInteger) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ (fromIntegral nTc) solve

import Control.Monad

-- pointfree style go brrrrrr

power :: Integer -> (Integer, Integer)
power = until ((/=) 0 . flip mod 2 . fst) ((,) <$> (`div` 2) . fst <*> (* 2) . snd) . ((,) <$> id <*> const 1)

solve :: [Integer] -> Integer
solve = (((. (*)) . (.) . (+) <$> ((-) <$> sum <*> maximum) <*> maximum) <$> (<$>) fst <*> product . (<$>) snd) . (<$>) power

test :: IO ()
test = getLine >> getLine >>= print . solve . (<$>) read . words

main :: IO ()
main = readLn >>= flip replicateM_ test

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

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

oe :: Int -> (Int, Int)
oe = go 0  where
  go acc x = acc `seq` if  odd x
    then  (x, acc)
    else  go (acc + 1) (quot x 2)

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    let
      (odds, p2s) = unzip $ map oe a
      lv : svs = sortOn negate odds
    pure $ putInts [foldl' (\acc x -> acc * 2 ^ x) lv p2s + sum svs]

type SP = State [P.ByteString]

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

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

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

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

import Control.Arrow ((***))

main :: IO ()
main = interact $ unlines . map (show . findMaxSumCanGetFromArray) . parseTests

findMaxSumCanGetFromArray :: [Integer] -> Integer
findMaxSumCanGetFromArray array = result
    where
        (new_array, twos_powers) = unzip $ map takeAwayTwoAsFactor array
        result = sum new_array + (maximum new_array) * (2 ^ (sum twos_powers) - 1)

takeAwayTwoAsFactor :: Integer -> (Integer, Integer)
takeAwayTwoAsFactor x = until (odd . fst) ((`div` 2) *** (+1)) (x, 0)

parseTests :: String -> [[Integer]]
parseTests = map (map read . words) . takeEverySecond . drop 1 . lines

takeEverySecond :: [a] -> [a]
takeEverySecond (x1:x2:xs) = x2 : takeEverySecond xs
takeEverySecond _ = []

import Control.Arrow ((***))

main :: IO ()
main = interact $ unlines . map (show . findMaxSumCanGetFromArray) . parseTests

findMaxSumCanGetFromArray :: [Integer] -> Integer
findMaxSumCanGetFromArray array = result
    where
        (new_array, twos_powers) = unzip $ map takeAwayTwoAsFactor array
        result = sum new_array + (maximum new_array) * (2 ^ (sum twos_powers) - 1)

takeAwayTwoAsFactor :: Integer -> (Integer, Integer)
takeAwayTwoAsFactor x
    | even x = (id *** (+1)) $ takeAwayTwoAsFactor (x `div` 2)
    | otherwise = (x, 0)

parseTests :: String -> [[Integer]]
parseTests = map (map read . words) . takeEverySecond . drop 1 . lines

takeEverySecond :: [a] -> [a]
takeEverySecond (x1:x2:xs) = x2 : takeEverySecond xs
takeEverySecond _ = []


{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs (x + y) <= 1000 ]

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let iter (x, i, ac) = let x' = S.difference (dmap x xs) ac in (x', i + 1, S.union x' ac)
        (S.size -> l, ans, _) = until (\(a, _, _) -> S.size a == 0 || S.member 0 a) iter (xs, 1, xs)
    putStrLn $ show $ if l == 0 then -1 else ans

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member,
    findMin, findMax, map, singleton, null, intersection)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (fn, fx) (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs (x + y) <= max (abs fx) (abs fn) ]

iter nx xs (x, i, ac) | S.member 0 x'                                    = (S.singleton 0, i + 1,       ac)
                      | not (S.null (S.intersection (S.map (0-) x') x))  = (S.singleton 0, 2 * i + 1,   ac)
                      | not (S.null (S.intersection (S.map (0-) x') x')) = (S.singleton 0, 2 * (i + 1), ac)
                      | otherwise = (x', i + 1, S.union x' ac) where
    x' = S.difference (dmap nx x xs) ac

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let nx = (S.findMin xs, S.findMax xs)
        end (a, _, _) = S.size a == 0 || S.member 0 a
        (_, ans, _) = until end (iter nx xs) (xs, 1, xs)
    putStrLn $ show $ if fst nx * snd nx > 0 then -1 else ans

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import Data.Maybe (fromJust)
import qualified Data.Set as S (fromList, difference, size, union, member,
    findMin, findMax, map, singleton, null, intersection)
import qualified Data.Foldable as F (toList)

readint = fst. fromJust . C.readInt

dmap (fn, fx) (F.toList -> xs) (F.toList -> ys)
    = S.fromList [ x + y | x <- xs, y <- ys, abs x + y <= max (abs fx) (abs fn) ]

iter nx xs (x, i, ac) | S.member 0 x'                             = (S.singleton 0, i + 1,       ac)
                      | not (S.null (S.intersection (S.map (0-) x') x))  = (S.singleton 0, 2 * i + 1,   ac)
                      | not (S.null (S.intersection (S.map (0-) x') x')) = (S.singleton 0, 2 * (i + 1), ac)
                      | otherwise = (x', i + 1, S.union x' ac) where
    x' = S.difference (dmap nx x xs) ac

main = do
    (map readint . C.words -> [n, k]) <- B.getLine
    (S.fromList . take k . map ((+ (-n)) . readint) . C.words -> xs) <- B.getLine
    let nx = (S.findMin xs, S.findMax xs)
        end (a, _, _) = S.size a == 0 || S.member 0 a
        (_, ans, _) = until end (iter nx xs) (xs, 1, xs)
    putStrLn $ show $ if fst nx * snd nx > 0 then -1 else ans


import Data.List

main = interact $ unlines . map (show . f) . lines

mdl f a b = f a b `mod` 1000000007

fb = 1:1:zipWith (mdl (+)) fb (tail fb)

f s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (mdl (*))
    $ map ((!!) fb . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import Data.List
import Data.Int

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c = md . product . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

fib = fst . fib2

-- | Return (fib n, fib (n + 1))
fib2 0 = (1, 1)
fib2 1 = (1, 2)
fib2 n
 | even n    = (a*a + b*b, c*c - a*a)
 | otherwise = (c*c - a*a, b*b + c*c)
 where (a,b) = fib2 (n `div` 2 - 1)
       c     = a + b

md :: Integer -> Int
md x = fromInteger $ x `mod` 1000000007

import Data.List

main = interact $ show . f

mdl f a b = f a b `mod` 1000000007

fb = 1:1:zipWith (mdl (+)) fb (tail fb)

f s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else foldl1 (mdl (*))
  $ map ((!!) fb . length)
  $ groupBy (\a b -> a `elem` "un" && a == b) s

import           Data.List

count x = length . filter (== x)

main = interact
  $ unlines
  . map (show . solve)
  . lines

modulo = 1000000007

fibs = 1:1:zipWith (\a b -> (a + b) `mod` modulo) fibs (tail fibs)

solve s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (\a b -> (a * b) `mod` modulo)
    $ map ((!!) fibs . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import           Data.List

count x = length . filter (== x)

main = interact
  $ unlines
  . map (show . solve)
  . lines

modulo = 1000000007

fibs = 1:1:zipWith (\a b -> (a + b) `mod` modulo) fibs (tail fibs)

solve :: String -> Int
solve s = if 'w' `elem` s || 'm' `elem` s
  then 0
  else
    foldl1 (\a b -> (a * b) `mod` modulo)
    $ map ((!!) fibs . length)
    $ groupBy (\a b -> a `elem` "un" && a == b) s

import Data.List

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' ((md.) . (*)) 1 l

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007

import Data.List
import Data.Int

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' (mmul) 1 l

-- mul as i64, overflow otherwise
mmul :: Int -> Int -> Int
mmul a b = md $ fromIntegral (toI64 a * toI64 b)
  where toI64 = fromIntegral :: Int -> Int64

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007

import Data.List

main = interact solve

solve str = if not g then show c else "0"
  where g = elem 'w' str || elem 'm' str
        c :: Int
        c = pr . map (fib . (+1) . length) . filter (\x -> length x /= 1 && elem (head x) "un") . group $ str

pr :: [Int] -> Int
pr l  = foldl' ((md.) . (*)) 1 l

fibs :: [Int]
fibs = 1 : 1 : zipWith ((md.) . (+)) fibs (tail fibs)

fib = (fibs!!)

md :: Int -> Int
md x = x `mod` 1000000007


import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let s = C.takeWhile isLetter line -- codeforces compatibility
    let ans = calc s
    if (length ans) == 0 then
      print (-1)
    else
      C.putStrLn $ C.unwords ans

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = tail (lines input)
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest final_string = case restoreInitialStringAndDeletionOrder final_string of
    Just (restored_string, deletion_order) -> restored_string ++ " " ++ deletion_order
    Nothing -> "-1"

restoreInitialStringAndDeletionOrder :: String -> Maybe (String, String)
restoreInitialStringAndDeletionOrder final_string = result
    where
        deletion_order = restoreDeletionOrder final_string
        initial_string = restoreInitialString final_string deletion_order
        final_string_will_get = computeFinalString initial_string deletion_order
        can_restore = final_string == final_string_will_get
        result = if can_restore then Just (initial_string, deletion_order) else Nothing

computeFinalString :: String -> String -> String
computeFinalString initial_string [] = []
computeFinalString initial_string (char_to_delete:next_deletions) =
    initial_string ++ computeFinalString next_string next_deletions
    where next_string = filter (/= char_to_delete) initial_string

restoreInitialString :: String -> String -> String
restoreInitialString final_string deletion_order = take initial_string_size final_string
    where
        initial_string_size =
            sum [countElement char final_string `div` lifetime | (char, lifetime) <- zip deletion_order [1..]]

restoreDeletionOrder :: String -> String
restoreDeletionOrder = reverse . takeFirstOccurrences . reverse

takeFirstOccurrences :: Eq a => [a] -> [a]
takeFirstOccurrences [] = []
takeFirstOccurrences (x:xs) = x : takeFirstOccurrences (filter (/= x) xs)

countElement :: Eq a => a -> [a] -> Int
countElement char string = length (filter (== char) string)

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    putStr "'"
    C.putStr line
    putStr "'"
    putStr $ show $ ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    putStr $ show $ ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    --let first = C.take 7 line
    --let second = applyRule C.empty first suffix
    --if second == (C.pack "abacabaaacaac") then
    --  C.putStrLn $ C.unwords [second, C.pack suffix]
    --else
    --  putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans
    C.putStr $ check line suffix 0 ((C.length line)-1)
    putStr " "
    putStrLn suffix

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    let first = C.take 7 line
    let second = applyRule C.empty first suffix
    if second == (C.pack "abacabaaacaac") then
      C.putStrLn $ C.unwords [second, C.pack suffix]
    else
      putStrLn "-1"
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let suffix = findSuffix line
    --print suffix
    let first = C.take 7 line
    let second = applyRule C.empty first suffix
    C.putStrLn $ C.unwords [second, C.pack suffix]
    --let ans = calc line
    --if (length ans) == 0 then
    --  print (-1)
    --else
    --  C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

findSuffix' :: Int -> C.ByteString -> S.IntSet -> String -> String
findSuffix' i str _ acc | i < 0 = acc
findSuffix' i str tree acc =
  let x = C.index str i
      code = ord x
  in
    if S.member code tree then
      findSuffix' (i-1) str tree acc
    else
      findSuffix' (i-1) str (S.insert (ord x) tree) (x:acc)

findSuffix :: C.ByteString -> String
findSuffix s = findSuffix' ((C.length s)-1) s S.empty []

applyRule :: C.ByteString -> C.ByteString -> String -> C.ByteString
applyRule t _ [] = t
applyRule t s (x:xs) =
  let newS = C.filter (/= x) s
  in
    applyRule (C.concat [t,s]) newS xs

check :: C.ByteString -> String -> Int -> Int -> C.ByteString
check _ _ l r | l > r = C.empty
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = C.take (m+1) s
      t = applyRule C.empty left suffix
  in
    if t == s then
      left
    else if (C.length t) < (C.length s) then
      check s suffix (m+1) r
    else
      check s suffix l (m-1)

calc :: C.ByteString -> [C.ByteString]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((C.length s) - 1)
  in
    if (C.length ans) == 0 then []
    else [ans, C.pack suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    --let suffix = findSuffix line
    --print suffix
    --let first = take 7 line
    --print $ applyRule [] first suffix
    let ans = calc line
    if (length ans) == 0 then
      print (-1)
    else
      C.putStrLn $ C.unwords ans

import Control.Monad
import Data.List
import Data.Char
import qualified Data.IntSet as S

findSuffix' :: String -> S.IntSet -> String -> String
findSuffix' [] _ acc = acc
findSuffix' (x:xs) tree acc =
  if S.member (ord x) tree then
    findSuffix' xs tree acc
  else
    findSuffix' xs (S.insert (ord x) tree) (x:acc)

findSuffix :: String -> String
findSuffix s = findSuffix' (reverse s) S.empty []

applyRule :: String -> String -> String -> String
applyRule t [] _ = t
applyRule t s (x:xs) =
  let newS = filter (/= x) s
  in
    applyRule (t ++ s) newS xs

check :: String -> String -> Int -> Int -> String
check _ _ l r | l >= r = []
check s suffix l r =
  let m = l+((r-l) `div` 2)
      left = take (m+1) s
      t = applyRule [] left suffix
  in
    if t == s then
      left
    else if (length t) < (length s) then
      check s suffix (m+1) r
    else
      check s suffix l m

calc :: String -> [String]
calc s =
  let suffix = findSuffix s
      ans = check s suffix 0 ((length s) - 1)
  in
    if null ans then []
    else [ans, suffix]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    --let suffix = findSuffix line
    --print suffix
    --let first = take 7 line
    --print $ applyRule [] first suffix
    let ans = calc line
    if (length ans) == 0 then
      print (-1)
    else
      putStrLn $ unwords ans


{-# LANGUAGE ForeignFunctionInterface, MultiWayIf, OverloadedStrings #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Foreign.C.String
import Foreign.C.Types
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

foreign import ccall "stdio.h printf" c_printf :: CString -> Double -> IO ()
foreign import ccall "stdio.h putchar" c_putchar :: Int -> IO ()

writeDouble x = withCString "%.9f" $ flip c_printf x

writeChar :: Char -> IO ()
writeChar = c_putchar . fromEnum

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'
  forM_ ys ((>> writeChar ' ') . writeDouble)
  writeChar '\n'

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""

{-# LANGUAGE ForeignFunctionInterface, MultiWayIf, OverloadedStrings #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Foreign.C.String
import Foreign.C.Types
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

foreign import ccall "stdio.h printf" c_printf :: CString -> Double -> IO ()
foreign import ccall "stdio.h putchar" c_putchar :: Int -> IO ()

writeDouble x = withCString "%.9f" $ flip c_printf x

writeChar :: Char -> IO ()
writeChar = c_putchar . fromEnum

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt . max 0 $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'
  forM_ xs ((>> writeChar ' ') . writeDouble)
  writeChar '\n'

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '-' -> f (i+1) (-acc) (Just 0) s
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""

{-# LANGUAGE MultiWayIf #-}
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.Functor
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as B

int = state $ fromJust . B.readInt . B.dropWhile isSpace

double :: State B.ByteString Double
double = state $ first (f 0 0 Nothing) . B.span (not . isSpace) . B.dropWhile isSpace
  where
    f i acc dot s =
      if | i == B.length s -> maybe acc ((acc/) . (10^)) dot
         | B.index s i == '.' -> f (i+1) acc (Just 0) s
         | otherwise -> f (i+1) (acc*10 + fromIntegral (fromEnum $ B.index s i) - 48) ((1+) <$> dot) s

parse = do
  n <- int
  maxs <- replicateM n double
  mins <- replicateM n double
  return (n, maxs, mins)

f [] [] _ _ _ _ = []
f (mx:maxs) (mi:mins) mxs mis xs ys = (xs'-xs, ys'-ys) : f maxs mins mxs' mis' xs' ys'
  where
    mxs' = mxs + mx
    mis' = mis + mi
    b = mxs'+mis'
    d = sqrt $ b^2 - 4 * mxs'
    xs' = (b+d)/2
    ys' = (b-d)/2

main = do
  (n, maxs, mins) <- evalState parse <$> B.getContents
  let (xs, ys) = unzip $ f maxs mins 0 0 0 0
  forM_ xs (printf "%.9f ")
  putStrLn ""
  forM_ ys (printf "%.9f ")
  putStrLn ""


{-# LANGUAGE ViewPatterns #-}
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

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch fun li ri = if  li == ri
  then  li
  else  let
  mi = li + div (ri - li) 2
  in  if  fun mi
  then  binSearch fun li mi
  else  binSearch fun (mi+1) ri

solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve aLi bLi = let
  n = length aLi
  m = length bLi
  a = listArray (1, n) aLi :: UArray Int Int
  b = listArray (1, m) bLi :: UArray Int Int
  boxesBefore pos = binSearch (\ix -> a ! ix > pos) 1 (n+1) - 1
  kthSpace k = binSearch (\pos -> pos - boxesBefore pos >= k) 1 (n + k)
  boxesAt pos = let
    ix = boxesBefore pos
    in  if  ix > 0 && a ! ix == pos  then  1  else  0
  preCovered :: UArray Int Int
  preCovered = listArray (1, m+1) $ scanr (+) 0 $ map boxesAt $ elems b
  score ix = let
    secondGap = kthSpace $ b ! ix
    gapIx = binSearch (\jx -> b ! jx >= secondGap) 1 (m+1)
    in  gapIx - ix + preCovered ! gapIx
  in  foldl' max minBound $ map score [1..m]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, _m] <- readInts
    aLi <- readInts
    bLi <- readInts
    let
      (reverse . map negate -> negAli, posAli) = span (< 0) aLi
      (reverse . map negate -> negBli, posBli) = span (< 0) bLi
    putInts [solve negAli negBli + solve posAli posBli]

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

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

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

countLessEqual :: Array Int Int -> Int -> Int -> Int -> Int
countLessEqual a l r x
  | l == r = l
  | a ! m <= x = countLessEqual a m r x
  | otherwise = countLessEqual a l (m - 1) x
  where
  m = (l + r) `quot` 2 + 1

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve as bs' = func bs 0 0
  where
  bs = dropWhile (< head as) bs'
  n = length as
  a = listArray (0, n - 1) as
  func [] _ opt = opt
  func (y : ys) i opt
    | i < n - 1 && a ! (i + 1) <= y + i + 1 = func (y : ys) (i + 1) opt
    | otherwise = func ys i $ max opt $ count y (y + i)
  count y1 y2 = countLessEqual b 0 bn y2 - countLessEqual b 0 bn (y1 - 1) + dn - countLessEqual d 0 dn y2
  bn = length bs
  b = listArray (0, bn) (0 : bs)
  f [] _ = []
  f _ [] = []
  f (x : xs) (y : ys)
    | x < y = f xs (y : ys)
    | x > y = f (x : xs) ys
    | otherwise = x : f xs ys
  ds = f as bs
  dn = length ds
  d = listArray (0, dn) (0 : ds)

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, m] <- getInts
    as <- getInts
    bs <- getInts
    let
      (a1, a2) = partition (<0) as
      (b1, b2) = partition (<0) bs
      f = reverse . map negate
      result = solve (f a1) (f b1) + solve a2 b2
    C.putStrLn $ C.pack $ show result


main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [size_y, size_x] = map read $ words input
        result = findMinBlueCellsN (size_x, size_y)
        output = show result

findMinBlueCellsN :: (Integer, Integer) -> Integer
findMinBlueCellsN (size_x, size_y)
    | not (size_y <= size_x) = findMinBlueCellsN (size_y, size_x)
    | size_x < 2 || size_y < 1 = 0
    | size_x `mod` 3 == 0 || size_y `mod` 3 == 0 = size_x * size_y `div` 3
    | size_y == 1 = size_x `div` 3 + 1
    | otherwise = minimum [findMinBlueCellsN (size_x - 1, size_y) + findMinBlueCellsN (1, size_y),
                           findMinBlueCellsN (size_x, size_y - 1) + findMinBlueCellsN (size_x, 1)]

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [size_y, size_x] = map read $ words input
        result = findMinBlueCellsN (size_x, size_y)
        output = show result

findMinBlueCellsN :: (Integer, Integer) -> Integer
findMinBlueCellsN (size_x, size_y)
    | not (size_y <= size_x) = findMinBlueCellsN (size_y, size_x)
    | size_x < 2 || size_y < 1 = 0
    | size_y < 2 = size_x `div` 3 + (if size_x `mod` 3 == 0 then 0 else 1)
    | size_x `mod` 3 == 0 || size_y `mod` 3 == 0 = size_x * size_y `div` 3
    | otherwise = minimum [findMinBlueCellsN (size_x - 1, size_y) + findMinBlueCellsN (1, size_y),
                           findMinBlueCellsN (size_x, size_y - 1) + findMinBlueCellsN (size_x, 1)]

import qualified Control.Monad as CM

solve :: IO ()
solve = do
  ~[x,y] <- readv
  printv [(x*y+2)`div`3]

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [n, m] = (n * m + 2) `div` 3


import Data.List

main = interact $ show.g.pick.f.lines
f xs = map (\x -> (map read (words x)) :: [Integer]) xs
pick (a:b:c:d:[]) = [(sort b), (sort d)]
g (x:y:[]) = merge x y 0
merge [] ys ans = ans
merge xs [] ans = ans
merge (x:xs) (y:ys) ans
  | abs (x - y) <= 1 = merge xs ys (ans + 1)
  | x < y = merge xs (y:ys) ans
  | otherwise = merge (x:xs) ys ans

import           Control.Applicative
import           Control.Monad
import           Data.List
import qualified Data.Map            as Map
import qualified Data.Set            as Set

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve (b:bs) (g:gs)
  | abs (b - g) <= 1 = 1 + solve bs gs
  | b < g = solve bs (g:gs)
  | otherwise = solve (b:bs) gs

main = do
  _ <- getLine
  b <- sort . (map read) . words <$> getLine
  _ <- getLine
  g <- sort . (map read) . words <$> getLine
  print $ solve b g

import Data.List

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

solve :: [Int] -> Int
solve (n:s) =
    let a = take n s
        b = drop (n + 1) s
    in  solve' (sort a) (sort b)
    where
        solve' :: [Int] -> [Int] -> Int
        solve' [] _ = 0
        solve' _ [] = 0
        solve' (a:ax) (b:bx) | abs (a - b) <= 1 = 1 + (solve' ax bx)
                             | a < b            = solve' ax (b:bx)
                             | otherwise        = solve' (a:ax) bx

-- reading the tutorials is how to get better!!!
-- read a ton of the tutorials!!!!
import Data.List

pairthem one two pairs
  | (null one) || (null two) = pairs
  | ((head one) - (head two)) < (-1) = pairthem (tail one) two pairs
  | ((head one) - (head two)) > 1 = pairthem one (tail two) pairs
  | ((head one) - (head two)) <= 1 && ((head two) - (head one)) >= -1 =
      pairthem (tail one) (tail two) (pairs+1)

conv lst uu
  | (null lst) = uu
  | otherwise = conv (tail lst) (((read (head lst))::Int) : uu)

main = do
  ff <- getLine
  gg <- getLine
  ss <- getLine
  zz <- getLine

  let aa = conv (words gg) []
      bb = conv (words zz) []

      cc = sort aa
      dd = sort bb

  let    ans = pairthem cc dd 0
  putStrLn (show ans)

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

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

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

main = do
  n <- readLn
  xs ::UArray Int Int <- listArray (1, n) . sort <$> getInts
  m <- readLn
  ys :: UArray Int Int <- listArray (1, m) . sort <$> getInts

  let
    r = listArray ((0, 0), (n, m)) $ map (uncurry f) [(i, j) | i <- [0..n], j <- [0..m]] :: Array (Int, Int) Int
      where
        f 0 _ = 0
        f _ 0 = 0

        f i j
          | abs (xs!i - ys!j) <= 1 = max (1 + r!(i-1, j-1)) (max (r!(i-1, j)) (r!(i, j-1)))
          | otherwise = max (r!(i-1, j)) (r!(i, j-1))

  print $ r!(n, m)

module Main where

import Control.Applicative
import Control.Monad
import Data.List           (sort)
import System.IO

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

solve :: Integral t => [t] -> [t] -> t
solve boys_skills girls_skills = process (sort boys_skills) (sort girls_skills)
  where
    process (x:xs) (y:ys)
        | x - y > 1 = process (x : xs) ys
        | x - y < -1 = process xs (y : ys)
        | otherwise = 1 + process xs ys
    process _ _ = 0

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering Nothing
    hSetBuffering stdout $ BlockBuffering Nothing
    getLine
    boys_skills <- map read . words <$> getLine
    getLine
    girls_skills <- map read . words <$> getLine
    print $ solve boys_skills girls_skills

import Data.List
import Data.Maybe
import Data.Char
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.map ( map read. words). (\[a,b,c,d]->[b,d]) . take 4. lines
solve :: [[Integer]]->String
solve [xs,ys] =  show $ slv1 (sort xs) (sort ys)
slv1 [] (y:ys) =0
slv1 (x:xs) [] =0
slv1 [] []     =0
slv1 (x:xs) (y:ys) | x-y>1    = slv1 (x:xs) (ys)
                   | y-x>1    = slv1 (xs) (y:ys)
                   |otherwise = 1+slv1 xs ys

import Control.Applicative
import Data.List

solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve [] _ = 0
solve (x:xs) (y:ys)
    | abs (x - y) < 2 = 1 + solve xs ys
    | x < y = solve xs (y:ys)
    | otherwise = solve (x:xs) ys

main = do
    getLine
    bs <- sort.(fmap read).words <$> getLine
    getLine
    gs <- sort.(fmap read).words <$> getLine
    print $ solve bs gs

-- Codeforces 489B

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine
    ns <- fmap (map read . words) getLine
    m <- fmap read getLine
    ms <- fmap (map read . words) getLine
    print $ solve n m (sort ns) (sort ms)

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve n m ns ms = snd $ foldl (\(mss, acc) b -> case (findIndex (\a -> (-1 <= b-a) && (1 >= b-a)) mss)
    of {
        Nothing -> (mss, acc);
        Just k -> (drop (k+1) mss, acc+1) ;
    }) (ms, 0) ns

import Control.Applicative
import Data.List

process [] _ n = n
process _ [] n = n
process (q1:q1s) (q2:q2s) n | abs (q1-q2) <=1 = process q1s q2s (n+1)
                            | q1 <q2 = process q1s (q2:q2s) n
                            | otherwise  = process (q1:q1s) q2s n

main = do
  n1<- read <$> getLine ::IO Int
  q1<-   sort <$> map read  <$>   words  <$> getLine ::IO [Int]
  n2<- read <$> getLine ::IO Int
  q2<-   sort <$> map read  <$>   words  <$> getLine ::IO [Int]
  print $ process q1 q2 0

import Data.List

f :: [Int] -> [Int] -> Int
f [] x = 0
f x [] = 0
f (b:bs) (g:gs)
    | b<g       = if (b==g-1) then 1 + f bs gs else f bs (g:gs)
    | otherwise = if (b-g<=1) then 1 + f bs gs else f (b:bs) gs

main = do
    getLine
    b <- getLine
    getLine
    g <- getLine
    putStrLn $ show $ f (sort (map read (words b))) (sort (map read (words g)))

import Data.List (sort)

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

solve :: [[Integer]] -> Integer
solve [_, as, _, bs] = go (sort as) (sort bs)
  where go xxs@(x:xs) yys@(y:ys) | x + 1 < y = go xs yys
                                 | y + 1 < x = go xxs ys
                                 | otherwise = 1 + go xs ys
        go _ _ = 0
solve _ = undefined

import Data.List (sort)
main = interact $ show . length . uncurry merge . parse
parse = go . map read . words where
  go (n:xs) = (sort bs,sort gs)
    where (bs,(_:gs)) = splitAt n xs
merge as@(a:as') bs@(b:bs')
  | abs (a-b) <= 1 = a : merge as' bs'
  | a < b = merge as' bs
  | a > b = merge as bs'
merge _ _ = []

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Data.List

-- Meat

solve :: [Int] -> [Int] -> Int
solve as bs = answer (sort as) (sort bs)

answer :: [Int] -> [Int] -> Int
answer [] _ = 0
answer _ [] = 0
answer (b:bs) (g:gs)
    | abs (b - g) <= 1 = 1 + answer bs gs
    | b < g = answer bs (g:gs)
    | b > g = answer (b:bs) gs

answer _ _ = error "Sucker"
-- Shit
main :: IO ()
main = do
        [_, bs, _, gs] <- readShit
        printShit [solve bs gs]

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

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

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

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

import Control.Applicative
import Data.List
import Data.Char

count [] _ n = n
count _ [] n = n
count (a:as) (b:bs) n | abs (a-b) <=1 = count as bs (n+1)
                      | a<b = count as (b:bs) n
                      | otherwise = count (a:as) bs n

main= do
		getLine
 		a<- sort.map read. words <$> getLine::IO [Int]
		getLine
 		b<- sort.map read. words <$> getLine::IO [Int]
	        print $ count a b 0

import Data.List (sort)

process :: [Int] -> [Int] -> Int
process as bs = f (sort as) (sort bs)
    where
        f [] _ = 0
        f _ [] = 0
        f as@(a:as') bs@(b:bs')
            | abs (a-b) <= 1 = 1 + f as' bs'
            | a < b = f as' bs
            | otherwise = f as bs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    m <- fmap readInt getLine
    bs <- fmap (map readInt.words) getLine
    print $ process as bs

import qualified Data.List as List

solve :: [Int] -> [Int] -> Int
solve [] _ = 0
solve _ [] = 0
solve ax@(x : xs) ay@(y : ys)
    | abs (x - y) <= 1 = 1 + solve xs ys
    | x < y = solve xs ay
    | x > y = solve ax ys

main = do
    getLine
    boy <- getLine
    getLine
    girl <- getLine
    let a = List.sort $ map read $ words boy
        b = List.sort $ map read $ words girl
    print $ solve a b

import Data.List

solve [] _ = 0
solve _ [] = 0
solve (x:xs) (y:ys) | abs (x - y) <= 1 = 1 + solve xs ys
                    | x < y        = solve xs (y : ys)
                    | otherwise    = solve (x : xs) ys

parseInput input = [sort xs, sort ys] where
    ls = lines input
    xs = map read $ words $ ls !! 1 :: [Int]
    ys = map read $ words $ ls !! 3 :: [Int]

main = do
    input <- getContents
    let [xs, ys] = parseInput input
    print $ solve xs ys

module Main where

import Control.Applicative
import Control.Monad
import Data.List           (foldl', sort)
import System.IO

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

solve :: Integral t => [t] -> [t] -> t
solve boys_skills girls_skills = process (sort boys_skills) (sort girls_skills)
  where
    process xs ys = foldl' (\acc (x, y) -> acc + is_matching x y) 0 $ zip xs ys
    is_matching x y = toNum $ abs (x - y) <= 1

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering Nothing
    hSetBuffering stdout $ BlockBuffering Nothing
    getLine
    boys_skills <- map read . words <$> getLine
    getLine
    girls_skills <- map read . words <$> getLine
    print $ solve boys_skills girls_skills

-- Codeforces 489B

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine
    ns <- fmap (map read . words) getLine
    m <- fmap read getLine
    ms <- fmap (map read . words) getLine
    print $ solve n m ns ms

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve n m ns ms = snd $ foldl (\(mss, acc) b -> case (findIndex (\a -> (-1 <= b-a) && (1 >= b-a)) mss)
    of {
        Nothing -> ([], acc);
        Just k -> (drop (k+1) mss, acc+1) ;
    }) (ms, 0) ns


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

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

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

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

makeLine lst = BS.unwords (map (BS.pack.show) lst)
solve pts = case listToMaybe lst of
    Nothing -> BS.pack "NO"
    Just order -> BS.unlines [ BS.pack "YES"
                             , makeLine (take 4 order)
                             , makeLine (drop 4 order)
                             ]
  where
    lst = [ order
          | (order, pts) <- unzip <$> permutations (zip [1..] pts)
          , checkRect (take 4 pts) && checkRect (drop 4 pts)
          , checkEq (take 4 pts)
          ]

-- a  b
-- d  c
checkRect [a, b, c, d] = and [ dot a b d == 0
                             , dot b a c == 0
                             , dot c b d == 0
                             , dot d a c == 0
                             ]

checkEq [a, b, c, d] = all (==head dists) dists
  where
    dists = [dist a b, dist b c, dist c d, dist d a]

dot (x0, y0) (x1, y1) (x2, y2) = (x1 - x0) * (x2 - x0) + (y1 - y0) * (y2 - y0)
dist (x1, y1) (x2, y2) = (x1 - x2)^2 + (y1 - y2)^2

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

import Data.List

separate      a 0 = [([],a)]
separate     [] _ = []
separate (a:as) n =  [ (a : fst cs, snd cs) | cs <- separate as (n-1) ]
                  ++ [ (fst cs, a : snd cs) | cs <- separate as n ]

isRectangle ps is = x && y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = (b `sub` a) `dotPro` (c `sub` a) == 0
         y = a `add` d == b `add` c

isRhombus ps is = x == y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = size2 (b `sub` a)
         y = size2 (c `sub` a)

solve ps (x, y)  = isRectangle ps x
                && isRhombus ps x
                && isRectangle ps y

add (a,b) (c,d) = (a+c, b+d)
sub (a,b) (c,d) = (a-c, b-d)
dotPro (a,b) (c,d) = a*c + b*d
size2 (a,b) = a*a + b*b

printAns (Just x) = do
   putStrLn "YES"
   putStrLn (unwords . map (show . (+1)) $ fst x)
   putStrLn (unwords . map (show . (+1)) $ snd x)
printAns Nothing = putStrLn "NO"

main = do
   ps <- mapM (fmap ((\[x,y] -> (x,y)) . map read . words)) $ map (\_ -> getLine) [1..8] :: IO [(Int, Int)]
   printAns $ find (solve ps) (separate [0..7] 4)

-- vim: set expandtab:

import List

type Point = (Int, Int)
type P4 = (Point, Point, Point, Point)
type P8 = (Point, Point, Point, Point, Point, Point, Point, Point)
type I4 = (Int, Int, Int, Int)

fromP4 :: P4 -> [Point]
fromP4 (p1, p2, p3, p4) = [p1, p2, p3, p4]

fromP8 :: P8 -> [Point]
fromP8 (p1, p2, p3, p4, p5, p6, p7, p8) = [p1, p2, p3, p4, p5, p6, p7, p8]

toP8 :: [Point] -> P8
toP8 [p1, p2, p3, p4, p5, p6, p7, p8] = (p1, p2, p3, p4, p5, p6, p7, p8)

fromI4 :: I4 -> [Int]
fromI4 (i1, i2, i3, i4) = [i1, i2, i3, i4]

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

distSquare :: (Point, Point) -> Int
distSquare ((x1, y1), (x2, y2)) = (x1 - x2)^2 + (y1 - y2)^2

getDistances :: P4 -> [Int]
getDistances p4 =
  map distSquare [(ps !! i, ps !! j) | i <- [0..3], j <- [0..3], i < j]
  where
    ps = fromP4 p4

checkSquare :: P4 -> Bool
checkSquare p4 =
  a1 > 0  &&  a1 == a4  &&  a5 == 2 * a1  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

equalDistances :: ((Point, Point), (Point, Point)) -> Bool
equalDistances (ps1, ps2)  =  distSquare ps1 == distSquare ps2

checkParas :: P4 -> Bool
checkParas (p1, p2, p3, p4)
    = and (map equalDistances [((p1, p2), (p3, p4)), ((p1, p3), (p2, p4)), ((p1, p4), (p2, p3))])

checkRectangle :: P4 -> Bool
checkRectangle p4 =
  a1 > 0  &&  a1 == a2  &&  a3 == a4  &&  a5 == a1 + a3  &&  a5 == a6
  &&
  checkParas p4
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

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

next :: Maybe I4 -> Maybe I4
next  Nothing             =  Nothing
next (Just (4, 5, 6, 7))  =  Nothing
next (Just (a, 5, 6, 7))  =  Just (a + 1, a + 2, a + 3, a + 4)
next (Just (a, b, 6, 7))  =  Just (a, b + 1, b + 2, b + 3)
next (Just (a, b, c, 7))  =  Just (a, b, c + 1, c + 2)
next (Just (a, b, c, d))  =  Just (a, b, c, d + 1)

firstSelection :: I4
firstSelection = (0, 1, 2, 3)

generateSelections :: [Maybe I4]
generateSelections = takeWhile (/= Nothing) (iterate next (Just firstSelection))

otherElements :: I4 -> I4
otherElements i4 = (j1, j2, j3, j4)
  where
    [j1, j2, j3, j4] = filter (\x -> not (elem x (fromI4 i4))) [0..7]

checkSelection :: P8 -> Maybe I4 -> Bool
checkSelection p8 (Just is) =
    checkSquare (ps !! i1, ps !! i2, ps !! i3, ps !! i4)
    &&
    checkRectangle (ps !! j1, ps !! j2, ps !! j3, ps !! j4)
  where
    ps = fromP8 p8
    (i1, i2, i3, i4) = is
    (j1, j2, j3, j4) = otherElements is

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

solve :: P8 -> Maybe I4
solve ps
  |  null solution  =  Nothing
  |  otherwise      =  head solution
  where
    solution = filter (checkSelection ps) generateSelections

printAns :: Maybe I4 -> IO ()
printAns Nothing   = putStrLn "NO"
printAns (Just i4) = do
    putStrLn "YES"
    sequence_ (map (\x -> putStr (show (xs !! x + 1) ++ " ")) [0..3])
    putStrLn ""
    sequence_ (map (\x -> putStr (show (ys !! x + 1) ++ " ")) [0..3])
    putStrLn ""
  where
    xs = fromI4 i4
    ys = fromI4 (otherElements i4)

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

parsePoint :: String -> Point
parsePoint line = (x, y)
  where
    [x, y] = map read (words line)

readPoint :: IO Point
readPoint = do
    getLine >>= return . parsePoint

readPoints :: IO P8
readPoints = do
    ps <- sequence (map (\x -> readPoint) [1..8])
    return (toP8 ps)

main :: IO ()
main = readPoints >>= printAns . solve

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]

sDist :: Point -> Point -> Int
sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isSquare :: [Point] -> Bool
isSquare ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6 && d1 + d3 == d5

isRectangle :: [Point] -> Bool
isRectangle [p1, p2, p3, p4]
  =  a1 > 0 && a1 == a2
  && b1 > 0 && b1 == b2
  && c1 > 0 && c1 == c2
  && sum [a1, b1, c1]  -  2 * maximum [a1, b1, c1] == 0
  where
    a1  =  sDist p1 p2
    a2  =  sDist p3 p4
    b1  =  sDist p1 p3
    b2  =  sDist p2 p4
    c1  =  sDist p1 p4
    c2  =  sDist p2 p3

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import Data.List

separate      a 0 = [([],a)]
separate     [] _ = []
separate (a:as) n =  [ (a : fst cs, snd cs) | cs <- separate as (n-1) ]
                  ++ [ (fst cs, a : snd cs) | cs <- separate as n ]

isRectangle ps is = x && y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = (b `sub` a) `dotPro` (c `sub` a) == 0
         y = a `add` d == b `add` c

isRectangle2 ps (x, y) = isRectangle ps x && isRectangle ps y

add (a,b) (c,d) = (a+c, b+d)
sub (a,b) (c,d) = (a-c, b-d)
dotPro (a,b) (c,d) = a*c + b*d

printAns (Just x) = do
   putStrLn "YES"
   putStrLn (unwords . map (show . (+1)) $ fst x)
   putStrLn (unwords . map (show . (+1)) $ snd x)
printAns Nothing = putStrLn "NO"

main = do
   ps <- mapM (fmap ((\[x,y] -> (x,y)) . map read . words)) $ map (\_ -> getLine) [1..8] :: IO [(Int, Int)]
   printAns $ find (isRectangle2 ps) (separate [0..7] 4)

-- vim: set expandtab:

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d3 == d4 && d5 == d6 && d1 + d3 == d5
isSquare    ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6 && d1 + d3 == d5

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

sortAndNub :: [Point] -> [Int]
sortAndNub  =  sort . nub . getSDists

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sortAndNub ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps (\ds -> head ds > 0 && length ds <= 3)
isSquare    ps  =  isFigure ps (\ds -> head ds > 0 && length ds == 2)

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d3 == d4 && d5 == d6
isSquare    ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import List

type Point = (Int, Int)
type P4 = (Point, Point, Point, Point)
type P8 = (Point, Point, Point, Point, Point, Point, Point, Point)
type I4 = (Int, Int, Int, Int)

fromP4 :: P4 -> [Point]
fromP4 (p1, p2, p3, p4) = [p1, p2, p3, p4]

fromP8 :: P8 -> [Point]
fromP8 (p1, p2, p3, p4, p5, p6, p7, p8) = [p1, p2, p3, p4, p5, p6, p7, p8]

toP8 :: [Point] -> P8
toP8 [p1, p2, p3, p4, p5, p6, p7, p8] = (p1, p2, p3, p4, p5, p6, p7, p8)

fromI4 :: I4 -> [Int]
fromI4 (i1, i2, i3, i4) = [i1, i2, i3, i4]

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

distSquare :: (Point, Point) -> Int
distSquare ((x1, y1), (x2, y2)) = (x1 - x2)^2 + (y1 - y2)^2

getDistances :: P4 -> [Int]
getDistances p4 =
  map distSquare [(ps !! i, ps !! j) | i <- [0..3], j <- [0..3], i < j]
  where
    ps = fromP4 p4

checkSquare :: P4 -> Bool
checkSquare p4 =
  a1 > 0  &&  a1 == a4  &&  a5 == 2 * a1  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

checkRectangle :: P4 -> Bool
checkRectangle p4 =
  a1 > 0  &&  a1 == a2  &&  a3 == a4  &&  a5 == a1 + a3  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

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

next :: Maybe I4 -> Maybe I4
next  Nothing             =  Nothing
next (Just (4, 5, 6, 7))  =  Nothing
next (Just (a, 5, 6, 7))  =  Just (a + 1, a + 2, a + 3, a + 4)
next (Just (a, b, 6, 7))  =  Just (a, b + 1, b + 2, b + 3)
next (Just (a, b, c, 7))  =  Just (a, b, c + 1, c + 2)
next (Just (a, b, c, d))  =  Just (a, b, c, d + 1)

firstSelection :: I4
firstSelection = (0, 1, 2, 3)

generateSelections :: [Maybe I4]
generateSelections = takeWhile (/= Nothing) (iterate next (Just firstSelection))

otherElements :: I4 -> I4
otherElements i4 = (j1, j2, j3, j4)
  where
    [j1, j2, j3, j4] = filter (\x -> not (elem x (fromI4 i4))) [0..7]

checkSelection :: P8 -> Maybe I4 -> Bool
checkSelection p8 (Just is) =
    checkSquare (ps !! i1, ps !! i2, ps !! i3, ps !! i4)
    &&
    checkRectangle (ps !! j1, ps !! j2, ps !! j3, ps !! j4)
  where
    ps = fromP8 p8
    (i1, i2, i3, i4) = is
    (j1, j2, j3, j4) = otherElements is

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

solve :: P8 -> Maybe I4
solve ps
  |  null solution  =  Nothing
  |  otherwise      =  head solution
  where
    solution = filter (checkSelection ps) generateSelections

printAns :: Maybe I4 -> IO ()
printAns Nothing   = putStrLn "NO"
printAns (Just i4) = do
    putStrLn "YES"
    sequence_ (map (\x -> putStr (show (xs !! x + 1) ++ " ")) [0..3])
    putStrLn ""
    sequence_ (map (\x -> putStr (show (ys !! x + 1) ++ " ")) [0..3])
    putStrLn ""
  where
    xs = fromI4 i4
    ys = fromI4 (otherElements i4)

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

parsePoint :: String -> Point
parsePoint line = (x, y)
  where
    [x, y] = map read (words line)

readPoint :: IO Point
readPoint = do
    getLine >>= return . parsePoint

readPoints :: IO P8
readPoints = do
    ps <- sequence (map (\x -> readPoint) [1..8])
    return (toP8 ps)

main :: IO ()
main = readPoints >>= printAns . solve


import qualified Data.Map as M
main = interact $ unlines . map show . f . lines
f (nk:a:nq:q) = g k m la (map (\(x,y) -> x*y) l) (map read q)
  where m = foldl (\m' (x,y) -> M.insertWith' min (x*y) x m') (M.singleton 0 0) l
        l = concatMap (\x -> map (\y -> (x,y)) la) [1..k]
        la = map read $ words a
        k = read . last $ words nk
g k m a l = map (\x -> z . minimum $ zipWith (+) v (h $ map ((-)x) l))
  where v = h l
        h = map (t . flip M.lookup m)
        t Nothing = k+1
        t (Just x) = x
        z x | x > k = -1 | True = x