{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromMaybe)

type Scanner = State [String]

runScanner :: Scanner a -> String -> a
runScanner = runScannerWith words

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

str :: Scanner String
str =
  get >>= \case
    s:ss -> put ss >> return s

int :: Scanner Int
int = read <$> str

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

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

-- main :: IO ()
-- main =
--   interact $
--   runScanner (numberOf singleCase) >>> map (solve >>> show) >>> unlines
--   where
--     singleCase = do
--       nlr <- times 3 int
--       xs <- times (head nlr) int
--       return [nlr, xs]
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (hs, ts) = splitAt k xs
   in hs : chunksOf k ts

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

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

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

import Prelude
import Control.Monad
import qualified Data.Map as Map

-- import Debug.Trace
-- tr s x = trace msg x  where msg = "tr: " ++ s ++ ": " ++ show x ++ "."

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

    (putStr . unlines . map solve) tcs

readTC = do
    [_n, l, r] <- readIListLn
    nums       <- readIListLn
    return (l, r, nums)

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

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

solve (l, r, nums) = show $ (`div` 2) . sum . map (count l r simap) . Map.keys $ simap
  where
    inums = zip nums [1::Int ..]
    simap = Map.fromList . (`zip` [1::Integer ..]) $ inums

count l r simap (v,i) = Map.size simapLR - fixIfInside
  where
    (_, simapR)  = Map.split (l-v  , -1) simap
    (simapLR, _) = Map.split (r-v+1, -1) simapR

    fixIfInside | (v,i) `Map.member` simapLR = 1
                | otherwise                  = 0

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Int
import Data.List

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

pmGen :: Int32 -> Int32
pmGen x = fromIntegral $! mod ((16807::Int64) * fromIntegral x) 2147483647

randoms :: Int32 -> [Int32]
randoms = iterate pmGen

type Key = Int32
type RandomValue  = Int32
data TreapSet = Node {-# UNPACK #-} !Key {-# UNPACK #-} !RandomValue {-# UNPACK #-} !Int32 TreapSet TreapSet | Nil

key :: TreapSet -> Key
key (Node x _ _ _ _) = x

size :: TreapSet -> Int32
size Nil = 0
size (Node _ _ sz _ _) = sz

_relax :: Key -> RandomValue -> TreapSet -> TreapSet -> TreapSet
_relax !x !y l@(Node _ _ ls _ _) r@(Node _ _ rs _ _) = Node x y (succ $! ls + rs) l r
_relax !x !y l@(Node _ _ sz _ _) Nil = Node x y (succ sz) l Nil
_relax !x !y Nil r@(Node _ _ sz _ _) = Node x y (succ sz) Nil r
_relax !x !y Nil Nil = Node x y 1 Nil Nil

split :: Key -> TreapSet -> (TreapSet, TreapSet)
split _ Nil = (Nil, Nil)

split !key (Node x y _ left right)
  | key < x = let (l', r') = split key left in (l', _relax x y r' right)
  | otherwise = let (l', r') = split key right in (_relax x y left l', r')

tsInsert :: Key -> RandomValue -> TreapSet -> TreapSet
tsInsert !x !y Nil = Node x y 1 Nil Nil
tsInsert !x !y t@(Node x' y' sz' left' right')
  | y' >= y = if x < x' then Node x' y' (succ sz') (tsInsert x y left') right'
                        else Node x' y' (succ sz') left' (tsInsert x y right')
  | otherwise = let (l'', r'') = split x t in _relax x y l'' r''

merge :: TreapSet -> TreapSet -> TreapSet
merge Nil r = r
merge l Nil = l
merge l@(Node x' y' sz' l' r') r@(Node x'' y'' sz'' l'' r'')
  | y' > y'' = _relax x' y' l' (merge r' r)
  | otherwise = _relax x'' y'' (merge l l'') r''

tsRemove :: Key -> TreapSet -> TreapSet
tsRemove _ Nil = Nil
tsRemove !x (Node x' y' sz' l' r')
  | x < x' = _relax x' y' (tsRemove x l') r'
  | x > x' = _relax x' y' l' (tsRemove x r')
  | otherwise = merge l' r'

tsRemoveExistingKey :: Key -> TreapSet -> TreapSet
tsRemoveExistingKey !x (Node x' y' sz' l' r')
  | x < x' = Node x' y' (pred sz') (tsRemoveExistingKey x l') r'
  | x > x' = Node x' y' (pred sz') l' (tsRemoveExistingKey x r')
  | otherwise = merge l' r'

tsCount :: Key -> TreapSet -> Int32
tsCount !x = count' 0
  where
    count' !c Nil = c
    count' !c (Node x' _ _ l' r')
      | x' < x = count' (succ $! c + size l') r'
      | otherwise = count' c l'

ru, ri :: C.ByteString -> Int

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

test' :: Int -> Int32 -> Int32 -> [Int32] -> [Int32] -> Int64
test' n l r a r1 = f Nil 0 a r1
  where
    f t !acc [] _ = acc
    f t !acc (x:xs) (y:ys) = f (tsInsert x y t) (acc + (fromIntegral $ tsCount (r - x + 1) t) - (fromIntegral $ tsCount (l - x) t)) xs ys

nl = char7 '\n'

test :: Builder -> Int -> [Int] -> [Int32] -> Builder
test buf 0 _ _ = buf
test buf nt (n:l:r:a) r0 = test (buf <> int64Dec (test' n (fromIntegral l) (fromIntegral r) (map fromIntegral b) r1) <> nl) (pred nt) c r2
  where
    (b, c) = splitAt n a
    (r1, r2) = splitAt n r0

solve :: [Int32] -> [Int] -> Builder
solve r (nt:xs) = test mempty nt xs r

main :: IO ()
main = do
  seed <- getSeed
  c <- C.getContents
  hPutBuilder stdout $ solve (randoms seed) $ map ri $ C.words c

import Control.Arrow ((>>>))
import Data.List (sort)

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

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

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromMaybe)

type Scanner = State [String]

runScanner :: Scanner a -> String -> a
runScanner = runScannerWith words

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

str :: Scanner String
str =
  get >>= \case
    s:ss -> put ss >> return s

int :: Scanner Int
int = read <$> str

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

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

main :: IO ()
main =
  interact $
  runScanner (numberOf singleCase) >>> map (solve >>> show) >>> unlines
  where
    singleCase = do
      nlr <- times 3 int
      xs <- times (head nlr) int
      return [nlr, xs]

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs


main = interact (ans)
ans theInput = answer where
  theLines = lines theInput
  n = read (head theLines) ::Int
  a = zip (map (read ::String->Int) (take n $ words $ theLines !! 1)) [1..]
  triple = [[u,v,w]|(x,u)<-a,(y,v)<-a,u/=v,(z,w)<-a,w/=u,w/=v,x==y+z]
  answer = if null triple then "-1" else unwords $ map show (head triple)

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check
	              | ans!!1==ans!!2 = if (getNums2 (res!!1) v)==ans!!2 then [-1]
	                                 else [ans!!0,getNums2 (res!!1) v,ans!!2]
	              | otherwise = ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = if res2 == length dr then res1
	             else res2+res1+1
      where res1=length(takeWhile (/=ans) m)+1
            dr  = drop res1 m
            res2=length(takeWhile (/=ans) dr)

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: [Int] -> [(Int, Int, Int)]
solve xs  =  [(i, j, k) | i <- [1..n], j <- [1..n], k <- [1..n],
    i /= j, i /= k, j /= k,
    xs !! (i-1) == xs !! (j-1) + xs !! (k-1)]
  where
    n  =  length xs

printAns :: [(Int, Int, Int)] -> IO ()
printAns []  =  print (-1)
printAns ((i, j, k):xs)  =  putStrLn $ concat [show i, " ", show j, " ", show k]

main :: IO ()
main  =  getLine >> Main.reads >>= printAns . solve

prettyPrint (a,b,c) = show (a+1) ++ " " ++ show (b+1) ++ " " ++ show (c+1)

isCorrect list (a,b,c) = a /= b && b /= c && c /= a && (list !! a) == (list !! b) + (list !! c)

findAllSolutions worms = filter (isCorrect worms) [(a,b,c) | a <- [0..n-1], b <- [0..n-1], c <- [0..n-1]]
    where n = length worms

solve worms = if (length sol == 0) then "-1" else prettyPrint (head sol)
    where sol = findAllSolutions worms

main = do
       dummy <- getLine
       inputLine <- getLine
       let tmp = words inputLine
       let worms = map read tmp :: [Int]
       putStrLn (solve worms)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf

main :: IO ()
main = do
  n <- readLn
  xs <- take n . map read . words <$> getLine :: IO [Int]
  let answer = do
        let forms = zip ([1 .. ] :: [Int]) xs
        (i, ai) <- forms
        (j, aj) <- forms
        (k, ak) <- forms
        guard $ i /= j
        guard $ j /= k
        guard $ k /= i
        guard $ ai == aj + ak
        return (i, j, k)
  case answer of
    (i, j, k) : _ -> printf "%d %d %d\n" i j k
    _             -> print (-1)

main = do getLine
          a <- fmap (map read . words) getLine
          let n = length a
              lst = [(i,j,k) | i <- [0..n-1], j <- [0..n-1], k <-[0..n-1],
                     i /= j, j /= k, i /= k, (a!!i) == (a!!j) + (a!!k)]
              (i,j,k) = head lst
          if null lst
            then putStrLn "-1"
            else putStrLn . unwords . map show . map (+1) $ [i,j,k]

main = do
	n <- fmap read getLine
	a <- fmap (map read . words) getLine
	putStr $ unwords $ map show $ last $ [-1]:[[i, j, k] | i <- [1 .. n], j <- [1 .. n], k <- [1 .. n], i /= j, i /= k, j /= k, a!!(i-1) == a!!(j-1) + a!!(k-1)]

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show (ch n v)
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<3 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<3 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (v2) == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v (v2)) v
	       where n = head m
	             v = tail m
	             v2 = sort v

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<2 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check
	              | ans!!1==ans!!2 = if (getNums2 (res!!1) v)==0 then [-1]
	                                 else [ans!!0,getNums2 (res!!1) v,ans!!2]
	              | otherwise = ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = length(takeWhile (/=ans) (tail(drop res1 m)))+res1
      where res1=length(takeWhile (/=ans) m)+1

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (sort v) == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v (sort v)) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | n<2 = [-1]
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (v2) == [-1] then "-1"
	       else if check then init $concat$ map (++" ") $map show $ ans
	       	    else [head ""]
	       where n = head m
	             v = tail m
	             v2 = sort v
	             ans= getNums (ch n v (v2)) v
	             check = if v!!(ans!!0-1) == v!!(ans!!1-1)+v!!(ans!!2-1) then True
	             	     else False

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check = if ans!!1==ans!!2 then [ans!!0,getNums2 (res!!1) v,ans!!2]
	             	     else ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = length(takeWhile (/=(ans)) (tail(dropWhile (/=ans) m)))+1


{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List
import qualified Data.Set as Set

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    unused  = Set.toList $ Set.fromList [1..length xs] Set.\\ Set.fromList (filter (/= 0) xs)
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff (a:b:[]) (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as)   (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _        (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

import Data.Map (Map)
import qualified Data.Map.Strict as Map

import Data.IntSet (IntSet)
import qualified Data.IntSet as Set

-- g: not knowing who to give to
-- a: not recving
solve :: Int -> [Int] -> Map Int Int
solve n fs =
    let (g, a, fs') = foldl (\(g, a, fs') (i, f) -> if f == 0 then (i : g, a, fs') else (g, Set.delete f a, Map.insert i f fs')) (mempty, Set.fromAscList [1..n], mempty) (zip [1..n] fs)
    in head $ dfs fs' g a

dfs :: Map Int Int -> [Int] -> IntSet -> [Map Int Int]
dfs f []     as = [f]
dfs f (g:gs) as = [Map.insert g a f' | a <- Set.elems as, a /= g, f' <- dfs f gs (Set.delete a as)]

main = do
    n <- fmap read getLine
    fs <- fmap (fmap read . words) getLine
    let ans = solve n fs
    putStrLn $ foldr (\i s -> show i ++ " " ++ s) "" ans

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List
import qualified Data.Set as Set

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    s = Set.fromList (filter (/= 0) xs)
    unused  = filter (flip Set.notMember s) [1..length xs]
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = listArray (1, length xs) (replicate (length xs) False) // [(x, True) | x <- xs, x /= 0]
    unused  = map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import Control.Monad
import Control.Monad.State
import Data.Array

solve :: [Int] -> [Int]
solve xs = flip evalState init $ traverse (\a -> state $ if a == 0 then getFirstDiff a  else (a, )) xs
  where getFirstDiff :: Int -> [Int] -> (Int, [Int])
        getFirstDiff a (x:xs)   | x /= a = (x, xs)
        getFirstDiff a (x:y:xs)          = (y, x:xs)
        arr :: Array Int Bool
        arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs , x /= 0]
        init :: [Int]
        init = reverse . map fst . filter (not . snd) $ assocs arr

main :: IO ()
main = unwords . map show . solve . map read . words <$> (getLine *> getLine) >>= putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import Data.List

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x /= 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == x = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _ (x:xs) = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import Data.List

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst $ filter (\(_, x) -> x /= 0) (zip [1 ..] xs)
    getFirstDiff [a, b] (x:y:xs) | a == x || b == x = (y, x:xs)
    getFirstDiff _ (x:xs) = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x /= 0) $ zip [1 ..] xs
    getFirstDiff (a:b:[]) (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as)   (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _        (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn


process :: String -> String
process [x] = [x]
process (x:y:[]) = if y ==x then  [x, head [ k | k <- ['a'..'z'], k /= y, k /= x]] else [x,y]
process (x:y:z:xs) = if x == y then x:y': process (z:xs) else x:process (y:z:xs)
  where
    y' = head [ k | k <- ['a'..'z'], k /= x, k /= y, k /= z]

main = do
  aa <- getLine
  putStrLn $ process aa

import Data.Char

next :: Char -> Char
next c = chr $ (ord 'a') + (mod ((ord c) - (ord 'a') + 1) ((ord 'z') - (ord 'a') + 1))

foo :: String -> String
foo (x1:x2:xs) =
	if x1==x2 then
		let
			x2n = next x2
		in if (null xs) then
			x1 : foo (x2n:xs)
		else
			if x2n == head xs then
				x1 : foo (next x2n : xs)
			else
				x1 : foo (x2n:xs)

	else
		x1 : foo (x2:xs)
foo x = x

main :: IO ()
main = interact foo

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

withTokens :: [(Char, Int)] -> String
withTokens = concat . map withTokens'
  where
    withTokens' :: (Char, Int) -> String
    withTokens' (char, 1) = [char]
    withTokens' (char, count)
      | even count =
          concat $ replicate (count `div` 2) ['T', char]
    withTokens' (char, count) =
      char:withTokens' (char, count - 1)

alphabet :: String
alphabet = ['a'..'z']

replaceTokens :: String -> String
replaceTokens (x:'T':y:rst) =
  x:head (alphabet \\ [x, y]):replaceTokens (y:rst)
replaceTokens ('T':y:rst) =
  head (alphabet \\ [y]):replaceTokens (y:rst)
replaceTokens (x:rst) = x:replaceTokens rst
replaceTokens [] = []

computeSimpleString :: String -> String
computeSimpleString str' =
  let lengthGroups = map (head &&& length) $ group str'
      tokenizedStr = withTokens lengthGroups
  in replaceTokens tokenizedStr

{-
runChecks :: IO ()
runChecks =
  let genInput = listOf $ elements ['a'..'e']
      propReplacecounts = forAll genInput $ \str ->
        let strCmp = zip str (computeSimpleString str)
            numDifferences = length $ filter (\(x, y) -> x /= y) strCmp
            groupLengths = map length $ group str
            numReplacements x = x `div` 2
        in numDifferences == sum (map numReplacements groupLengths)

      propNoAdjacencies = forAll genInput $ \str ->
        let simpleStr = computeSimpleString str
        in 0 == length (filter (\(x, y) -> x == y) $ zip simpleStr (drop 1 simpleStr))
  in do
    quickCheck propReplacecounts
    quickCheck propNoAdjacencies
-}

main :: IO ()
main = interact $ \str ->
  let str' = filter (`elem` alphabet) str
  in computeSimpleString str'

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

withTokens :: [(Char, Int)] -> String
withTokens = concat . map withTokens'
  where
    withTokens' :: (Char, Int) -> String
    withTokens' (char, 1) = [char]
    withTokens' (char, count)
      | even count =
          concat $ replicate (count `div` 2) ['T', char]
    withTokens' (char, count) =
      char:withTokens' (char, count - 1)

alphabet :: String
alphabet = ['a'..'z']

replaceTokens :: String -> String
replaceTokens (x:'T':y:rst) =
  x:head (alphabet \\ [x, y]):y:replaceTokens rst
replaceTokens ('T':y:rst) =
  head (alphabet \\ [y]):y:replaceTokens rst
replaceTokens (x:rst) = x:replaceTokens rst
replaceTokens [] = []

computeSimpleString :: String -> String
computeSimpleString str' =
  let lengthGroups = map (head &&& length) $ group str'
      tokenizedStr = withTokens lengthGroups
  in replaceTokens tokenizedStr

{-
runChecks :: IO ()
runChecks =
  let genInput = listOf $ elements ['a'..'b']
      propReplacecounts = forAll genInput $ \str ->
        let strCmp = zip str (computeSimpleString str)
            numDifferences = length $ filter (\(x, y) -> x /= y) strCmp
            groupLengths = map length $ group str
            numReplacements x = x `div` 2
        in numDifferences == sum (map numReplacements groupLengths)
  in quickCheck propReplacecounts
-}

main :: IO ()
main = interact $ \str ->
  let str' = filter (`elem` alphabet) str
  in computeSimpleString str'


module Main where

   solve :: IO ()
   solve = do
       s <- getLine
       let n = read s :: Int
       putStrLn $ if n <= 30 then
           "NO"
       else if n `elem` [36, 40, 44] then
           "YES\n6 10 15 " ++ show (n - 31)
       else
           "YES\n6 10 14 " ++ show (n - 30)

   iter :: Int -> IO ()
   iter 1 = solve
   iter n = do
       solve
       iter $ n - 1

   main :: IO ()
   main = do
       s <- getLine
       iter (read s :: Int)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  if n > 30
    then
      if (n - 30) `notElem` [6, 10, 14]
        then putStrLn "YES" >> putStrLn ("6 10 14 " ++ show (n - 30))
        else putStrLn "YES" >> putStrLn ("6 10 15 " ++ show (n - 31))
    else putStrLn "NO"

import Data.Char
import Control.Monad
import Data.List

--6 10 14 15

answer x = if (x==36) then [6, 10, 15, 5]
           else if(x==40) then [6, 10, 15, 9]
           else if(x==44) then [6, 10, 15, 13]
           else [6, 10, 14, x-30]

get_ans h = if null h then ""
            else (show (head h)) ++ " " ++  (get_ans (tail h))

result x = if (x <= 30) then "NO"
           else "YES" ++ "\n" ++ ((get_ans . answer) x)

main = do
    tests <- getLine
    l <- getContents
    let l2 = words l
--    print l2
    let l3 = [ read w :: Int | w <- l2 ]
    let ans = [ result x | x <- l3]
    let ans2 = intercalate "\n" ans
    putStr ans2

import Data.Char
import Control.Monad
import Data.List

--6 10 14 15

answer 36 = [6, 10, 15, 5]
answer 40 = [6, 10, 15, 9]
answer 44 = [6, 10, 15, 13]
answer x = [6, 10, 14, x-30]

get_ans h = if null h then ""
            else (show (head h)) ++ " " ++  (get_ans (tail h))

result x = if (x <= 30) then "NO"
           else "YES" ++ "\n" ++ ((get_ans . answer) x)

main = do
    tests <- getLine
    l <- getContents
    let l2 = [ read w :: Int | w <- words l ]
    putStr(intercalate "\n" [result x | x <- l2])

import Control.Monad

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

putList :: (Show a) => [a] -> IO ()
putList = sequence_ . (map (\el -> putStr (show el) >> putChar ' '))

main :: IO ()
main = do
  t <- getOne
  -- let t = 1
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- getOne :: IO Int
  let ans = countAns n
  if null ans then
    putStrLn "NO"
  else do
    putStrLn "YES"
    putList ans
    putChar '\n'

countAns :: (Ord a, Num a) => a -> [a]
countAns n
  | sum f3 >= n = []
  | n - sum f3 `elem` f3 = (n - sum f4) : f4
  | otherwise = (n - sum f3) : f3
  where
    f3 = [6, 10, 14]
    f4 = [6, 10, 15]

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ if x<31  then "NO"
			   else if not(elem x [36,40,44])  then "YES\n"++ (intercalate " " (map show [14,10,6,x-30]))
							   else "YES\n"++ (intercalate " " (map show [15,10,6,x-31]))

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  if n > 30
    then
      if (n - 30) `notElem` [6, 10, 14]
        then putStrLn "YES" >> putStrLn ("6 10 14 " ++ show (n - 30))
        else putStrLn "YES" >> putStrLn ("6 10 15 " ++ show (n - 30))
    else putStrLn "NO"

import Data.Char
import Control.Monad
import Data.List

--6 10 14 15

answer x = if (x==36) then [6, 10, 15, 5]
           else if(x==40) then [6, 10, 15, 9]
           else if(x==44) then [6, 10, 15, 13]
           else [6, 10, 14, x-30]

get_ans h = if null h then ""
            else (show (head h)) ++ " " ++  (get_ans (tail h))

result x = if (x <= 30) then "NO"
           else "YES" ++ "\n" ++ ((get_ans . answer) x)

main = do
    tests <- getLine
    l <- getContents
    let l2 = words l
    print l2
    let l3 = [ read w :: Int | w <- l2 ]
    let ans = [ result x | x <- l3]
    let ans2 = intercalate "\n" ans
    putStr ans2

module Main where

   solve :: IO ()
   solve = do
       s <- getLine
       let n = read s :: Int
       putStrLn $ if n <= 30 then
           "NO"
       else if n `elem` [36, 40, 44] then
           "YES\n6 10 15" ++ show (n - 31)
       else
           "YES\n6 10 14" ++ show (n - 30)

   iter :: Int -> IO ()
   iter 1 = solve
   iter n = do
       solve
       iter $ n - 1

   main :: IO ()
   main = do
       s <- getLine
       iter (read s :: Int)

module Main where

   solve :: IO ()
   solve = do
       s <- getLine
       let n = read s :: Int
       putStrLn $ if n <= 30 then
           "NO"
       else if n `elem` [36, 40, 44] then
           "6 10 15" ++ show (n - 31)
       else
           "6 10 14" ++ show (n - 30)

   iter :: Int -> IO ()
   iter 1 = solve
   iter n = do
       solve
       iter $ n - 1

   main :: IO ()
   main = do
       s <- getLine
       iter (read s :: Int)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ if x<31  then "NO"
			   else if not(elem x [36,40,46])  then "YES\n"++ (intercalate " " (map show [14,10,6,x-30]))
							   else "YES\n"++ (intercalate " " (map show [15,10,6,x-31]))

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase


import List
import Data.IntSet as Set
main = interact solve
solve input = output where
  n = read input :: Int
  nodes :: Int -> IntSet -> [Int] -> [[Int]]
  nodes 1 s _ = [[x]|x<-toList s]
  nodes x s xs = [y:ys|y<-toList s, ys<-nodes (x-1) (del0 s y xs) (y:xs)] where
    del0 s z zs = del (Set.delete z s) $
      concat [[u+v-z,z+u-v,z+v-u]|u<-zs, v<-zs, u<v, w<-s0]
    del :: IntSet -> [Int] -> IntSet
    del ys [] = ys
    del ys (z:zs) = Set.delete z $ del ys zs
    s0 = toList s
  table = head $ nodes n (fromList [1..1000]) []
  output = unlines [unwords [show $ edge i j|j<-[0..n-1]]|i<-[0..n-1]]
  edge x y = if x==y then 0 else table!!x + table!!y

main = interact solve
solve input = output where
  n = read input :: Int
  nodes = [1,2,3,5,8,13,21,30,39,53,74,95,128,152,182,212,258,316,374,413]
  output = unlines [unwords [show $ edge i j|j<-[0..n-1]]|i<-[0..n-1]]
  edge x y = if x==y then 0 else nodes!!x + nodes!!y


import Control.Applicative
import Data.List

process _ [] [] _ _ = putStrLn ""
process i (a:as) (b:bs) c d | elem a c || elem b d = process (i+1) as bs c d
                            | otherwise = do
                                            putStr (show i ++" ")
                                            process (i+1) as bs (a:c) (b:d)

main::IO ()
main=do
    n<- read <$> getLine::IO Int
    [a1,a2]<- transpose <$> map(map read) <$> map words <$> lines <$> getContents :: IO [[Int]]
    process 1 a1 a2 [] []

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Control.Monad.State
import Data.Set
-- Meat

solve :: [[Int]] -> [Int]
solve as = [ snd x | x <- bools `zip` [1..], fst x]
    where bools = evalState (mapM feed as) noHistory

data RoadHistory = RoadHistory (Set Int) (Set Int) deriving (Show)

noHistory :: RoadHistory
noHistory = RoadHistory Data.Set.empty Data.Set.empty

feed :: [Int] -> State RoadHistory Bool
feed (h:v:_ )= state $ transform h v
feed _ = error "You suck"

transform :: Int -> Int -> RoadHistory -> (Bool, RoadHistory)
transform h v (RoadHistory horH verH) = (shouldWork, RoadHistory newHorH newVerH)
    where shouldWork = h `notMember` horH && v `notMember` verH
          newHorH = if shouldWork then insert h horH else horH
          newVerH = if shouldWork then insert v verH else verH

-- Shit
main :: IO ()
main = do
        _:as <- readShit
        printShit $ solve as

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

import Data.List
import qualified Data.Set as Set

main :: IO()
main = putStrLn . intercalate " " . map show . solve 1 Set.empty Set.empty . map read . tail . words =<< getContents

solve :: Int -> Set.Set Int -> Set.Set Int -> [Int] -> [Int]
solve _ _ _ [] = []
solve i h v (x:y:s) | (Set.member x h) || (Set.member y v) = solve (i + 1) h v s
                    | otherwise = i : solve (i + 1) (Set.insert x h) (Set.insert y v) s

import Control.Monad
import Data.Set (empty,insert,member)
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- forM [1..(n*n)] $ \_ -> do
        [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
        return (x,y)
    mapM_ (\x -> putStr ((show x)++" ")) (solve 1 a empty empty)

solve _ [] _ _ = []
solve i ((x,y):xs) mh mv
 |or [member x mh,member y mv] = solve (i+1) xs mh mv
 |otherwise = i:solve (i+1) xs (insert x mh) (insert y mv)

{-# 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.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
  ijs <- replicateM (n^2) getInts

  let
    rs = snd $ mapAccumL f ([], []) $ zip ijs [1..]
      where
        f (is, js) ([i, j], k)
          | i `elem` is || j `elem` js = ((is, js), 0)
          | otherwise = ((i:is, j:js), k)

  putStrLn $ unwords $ map show $ filter (/= 0) rs

import Data.Set hiding (map)

main = interact $ solver

into_pairs [] = []
into_pairs (h:v:t) = (h, v) : into_pairs t

solver str = unwords $ map show res where
             ws = words str
             (_: list) = ws
             order = into_pairs $ map (read :: String->Int) list
             res = solve order empty empty 1

solve [] _ _ _ = []
solve ((h, v) : t) removedHorizontal removedVertical i =
         if member h removedHorizontal || member v removedVertical
         then solve t removedHorizontal removedVertical (i + 1)
         else i : solve t (insert h removedHorizontal) (insert v removedVertical) (i + 1)

import Control.Applicative
f xl yl [] sch n m= []
f xl yl (schx:schxs) (schy:schys) n m| n == 0 = []
                                     | (elem schx xl) || (elem schy yl) = f xl yl schxs schys n (m+1)
                                     | otherwise = (m+1):(f (schx:xl) (schy:yl) schxs schys (n-1) (m+1))
toTup a = ((w !! 0),(w !! 1))
  where w = [read n::Int|n <- (words a)]
main = do
  n <- (read::String ->Int) <$> getLine
  (xl,yl) <- unzip.(map toTup).lines <$> getContents
  putStrLn $ unwords $ map show $ f [] [] xl yl n 0

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInt x
someFunc::IO()
someFunc = C.getLine>>= (\(n) ->solve=<<forM [1..(rIn n)^2] (\i->map rIn.C.words <$>C.getLine) )
solve xs= putStrLn $ unwords $ map show $ reverse $ foldl (\ bs (c,(a,_)) ->if a then c:bs else bs)[] $ zip [0..] $ scanl (slv1) (False,[Set.empty,Set.empty]) xs
slv1 (_,[s1,s2]) [x,y]= if Set.member x s1 || Set.member y s2 then (False, [s1,s2]) else (True,[Set.insert x s1,Set.insert y s2])

-- Codeforces 583A

import Control.Monad
import qualified Data.Set as Set
import Data.List (intercalate)

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getContents >>= putStrLn . intercalate " " . map show . solve 1 (Set.empty, Set.empty) . map read . words

solve :: Int -> (Set.Set Int, Set.Set Int) -> [Int] -> [Int]
solve _ _ [] = []
solve d (h, v) (i:j:xs)
    | (Set.member i h) || (Set.member j v) = solve (d+1) (h, v) xs
    | otherwise = d : solve (d+1) (Set.insert i h, Set.insert j v) xs

import Data.List (mapAccumL)
import Data.Maybe (catMaybes)

main :: IO ()
main = putStrLn . unwords . map show . solve . map (map read . words) . tail . lines =<< getContents

solve :: [[Int]] -> [Int]
solve = catMaybes . snd . mapAccumL f ([], [], 1)
  where f (xs, ys, t) [x, y]
          | x `elem` xs || y `elem` ys = ((xs, ys, t + 1), Nothing)
          | otherwise = ((x:xs, y:ys, t + 1), Just t)
        f _ _ = undefined

import Data.Bits (setBit,testBit)
import Data.Word (Word64)
main = do
  n <- readLn
  putStrLn . unwords . map show =<< solve (0 :: Word64,0 :: Word64) [1..n^2]
solve _ [] = return []
solve (h,v) (i:is) = do
  [a,b] <- fmap (map read . words) getLine
  if (h `testBit` a) || (v `testBit` b)
    then solve (h,v) is
    else fmap (i:) $ solve (h `setBit` a, v `setBit` b) is

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import qualified Data.Set as S

process _ _ _ [] x = reverse x
process d h v (a:b:c) x | S.notMember a h  && S.notMember b v = process (d+1) (S.insert a h) (S.insert b v) c (d:x)
	                | otherwise = process (d+1) h v c x

main=do
	n<- read <$> getLine::IO Int
	s<-map (fst.fromJust.C.readInt). C.words<$> C.getContents::IO [Int]
	putStrLn $ intercalate " " $ map show $ process 1 S.empty S.empty s []

import Control.Monad
import Data.Set (empty,insert,member)
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- forM [1..(n*n)] $ \_ -> do
        [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
        return (x,y)
    mapM_ (\x -> putStr ((show x)++" ")) (solve 1 a empty empty)

solve _ [] _ _ = []
solve i ((x,y):xs) mh mv
 |or [member x mh,member y mv] = solve (i+1) xs mh mv
 |otherwise = i:solve (i+1) xs (insert x mh) (insert x mv)

import Control.Monad
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- forM [1..(n*n)] $ \_ -> do
        [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
        return (x,y)
    mapM_ (\x -> putStr ((show x)++" ")) (solve 1 a)

solve _ [] = []
solve i ((x,y):xs)
 |x==y = i:solve (i+1) xs
 |otherwise = solve (i+1) xs

import Control.Monad
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- forM [1..(n*n)] $ \_ -> do
        [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
        return (x,y)
    mapM_ (\x -> putStr ((show x)++" ")) (solve 1 a)
    putStrLn ""

solve _ [] = []
solve i ((x,y):xs)
 |x==y = i:solve (i+1) xs
 |otherwise = solve (i+1) xs

import Control.Monad
import Data.Set (empty,insert,member)
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- forM [1..(n*n)] $ \_ -> do
        [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
        return (x,y)
    mapM_ (\x -> putStr ((show x)++" ")) (solve 1 a empty)

solve _ [] _ = []
solve i ((x,y):xs) m
 |or [member x m,member y m] = solve (i+1) xs m
 |otherwise = i:solve (i+1) xs (insert x . insert y $ m)

import Control.Applicative
import Data.List

main::IO ()
main=do
    n<- read <$> getLine::IO Int
    putStrLn $ intercalate " " $ map show [i*i|i<-[1..n]]

import Data.Bits (setBit,testBit)
import Control.Monad (when,foldM_)
main = do
  n <- readLn
  foldM_ solve (0 :: Int,0 :: Int) [1..n]
solve (h,v) i = do
  [a,b] <- fmap (map read . words) getLine
  when ((not (h `testBit` a)) && (not (v `testBit` b))) (print i)
  return (h `setBit` a, v `setBit` b)

import Data.Bits (setBit,testBit)
main = do
  n <- readLn
  putStrLn . unwords . map show =<< solve (0 :: Int,0 :: Int) [1..n^2]
solve _ [] = return []
solve (h,v) (i:is) = do
  [a,b] <- fmap (map read . words) getLine
  if (h `testBit` a) || (v `testBit` b)
    then solve (h,v) is
    else fmap (i:) $ solve (h `setBit` a, v `setBit` b) is

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main) where
import Control.Monad.State
import Data.Set
-- Meat

solve :: [[Int]] -> [Int]
solve as = [ snd x | x <- bools `zip` [1..], fst x]
    where bools = evalState (mapM feed as) noHistory

data RoadHistory = RoadHistory (Set Int) (Set Int) deriving (Show)

noHistory :: RoadHistory
noHistory = RoadHistory Data.Set.empty Data.Set.empty

feed :: [Int] -> State RoadHistory Bool
feed (h:v:_ )= state $ transform h v
feed _ = error "You suck"

transform :: Int -> Int -> RoadHistory -> (Bool, RoadHistory)
transform h v (RoadHistory horH verH) = (shouldWork, RoadHistory newHorH newVerH)
    where shouldWork = h `notMember` horH && v `notMember` verH
          newHorH = if shouldWork then insert h horH else horH
          newVerH = if shouldWork then insert v horH else verH

-- Shit
main :: IO ()
main = do
        _:as <- readShit
        printShit $ solve as

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


module Main (main) where

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe

main :: IO ()
main = do
    n <- readLn
    xs <- map (map readInt.words) <$> replicateM n getLine
    let ans = solve xs
    print ans

readInt :: String -> Int
readInt = read

solve :: [[Int]] -> Int
solve = foldl update 0

update :: Int -> [Int] -> Int
update s (a:b:_) = fromJust $ find (> s) [a + d * b | d <- [0..]]

main = getContents >>= print . exec
exec = solve 0 . map read . tail . words
solve m (s:d:xs) = solve (s + k * d) xs
  where k = max 0 $ ceiling $ fromIntegral (m + 1 - s) / fromIntegral d
solve m _ = m

main = getContents >>= print . exec
exec = solve 0 . map read . tail . words
solve m (s:d:xs) = solve (s + k * d) xs
  where k = max 0 $ ceiling $ fromIntegral (m - s) / fromIntegral d
solve m _ = m


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

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

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

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

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

  currentValue :: [(Int, Int)] -> Int
  currentValue xs =
    let (ps, qs) = unzip xs
        in (sum ps) - (sum qs)

  parseTuple :: String -> (Int, Int)
  parseTuple xs =
    let [x, y] = (map readInt . words) xs
        in (x, y)

  changes :: Int -> (Int, Int) -> Int
  changes current (l, r) = current + 2 * (r - l)

  indexOfMostValue :: Int -> Int -> Int -> [Int] -> Int
  indexOfMostValue midx _ _ [] = midx
  indexOfMostValue midx most idx (x:xs)
    | abs most < abs x = indexOfMostValue idx (abs x) (idx + 1) xs
    | otherwise = indexOfMostValue midx most (idx + 1) xs

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- readMultilineInput n (return . parseTuple)
    let cv = currentValue xs
        chgs = map (changes cv) xs
    print $ (1+) $ indexOfMostValue (-1) (abs cv) 0 chgs
-}
import Control.Monad
import Data.Array
import Data.List
import Data.Ord
test :: Int -> Int
test n = n
parseInts :: String -> [Int]
parseInts str = map read (words str)
toArray :: [a] -> Array Int a
toArray xs =
  let ls = length xs - 1
    in array (0, ls) $ zip [0..ls] xs
toTuple :: [a] -> (a, a)
toTuple (a : b : _) = (a,b)
solve :: [(Int, Int)] -> Int
solve xs =
  let diff = sum $ map (\(a, b) -> a - b) xs
      trans = map (\(a, b) -> diff + 2 * (b - a)) xs
      in snd $ maximumBy (comparing fst) (zip (map abs (diff:trans)) [0..])

main :: IO ()
main = do
  (n : _) <- getLine >>= return . parseInts
  arr <- replicateM n (getLine >>= return . toTuple . parseInts)
  print $ solve arr

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
parseInts :: String -> [Int]
parseInts str = map read (words str)
toTuple :: [a] -> (a, a)
toTuple (a : b : _) = (a,b)
solve :: [(Int, Int)] -> Int
solve xs =
  let diff = sum $ map (\(a, b) -> a - b) xs
      trans = map (\(a, b) -> diff + 2 * (b - a)) xs
      in snd $ maximumBy (comparing fst) (zip (map abs (diff:trans)) [0..])
{-fuck-}
main :: IO ()
main = do
  (n : _) <- getLine >>= return . parseInts
  arr <- replicateM n (getLine >>= return . toTuple . parseInts)
  print $ solve arr

import Data.Ord
import Data.List
main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve lrs | m < update (0,0) = 0
          | otherwise = i
  where (m,i) = maximum $ flip zip [1..] $ map update lrs
        (ls,rs) = unzip lrs
        update (l,r) = abs ((sum ls + r - l) - (sum rs + l - r))

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

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

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

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

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

  currentValue :: [(Int, Int)] -> Int
  currentValue xs =
    let (ps, qs) = unzip xs
        in (sum ps) - (sum qs)

  parseTuple :: String -> (Int, Int)
  parseTuple xs =
    let [x, y] = (map readInt . words) xs
        in (x, y)

  changes :: Int -> (Int, Int) -> Int
  changes current (l, r) = current + 2 * (r - l)

  indexOfMostValue :: Int -> Int -> Int -> [Int] -> Int
  indexOfMostValue midx _ _ [] = midx
  indexOfMostValue midx most idx (x:xs)
    | abs most < abs x = indexOfMostValue idx (abs x) (idx + 1) xs
    | otherwise = indexOfMostValue midx most (idx + 1) xs

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- readMultilineInput n (return . parseTuple)
    let cv = currentValue xs
        chgs = map (changes cv) xs
    print $ (1+) $ indexOfMostValue (-1) (abs cv) 0 chgs
-}
import Control.Monad
import Data.Array
import Data.List
import Data.Ord
test :: Int -> Int
test n = n
parseInts :: String -> [Int]
parseInts str = map read (words str)
toArray :: [a] -> Array Int a
toArray xs =
  let ls = length xs - 1
    in array (0, ls) $ zip [0..ls] xs
toTuple :: [a] -> (a, a)
toTuple (a : b : _) = (a,b)
solve :: [(Int, Int)] -> Int
solve xs =
  let diff = sum $ map (\(a, b) -> a - b) xs
      trans = map (\(a, b) -> abs $ diff + 2 * (b - a)) xs
      in snd $ minimumBy (comparing fst) (zip (diff:trans) [0..])

main :: IO ()
main = do
  (n : _) <- getLine >>= return . parseInts
  arr <- replicateM n (getLine >>= return . toTuple . parseInts)
  print $ solve arr

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
parseInts :: String -> [Int]
parseInts str = map read (words str)
toTuple :: [a] -> (a, a)
toTuple (a : b : _) = (a,b)
solve :: [(Int, Int)] -> Int
solve xs =
  let diff = sum $ map (\(a, b) -> a - b) xs
      trans = map (\(a, b) -> diff - (a - b) + (b - a)) xs
      in snd $ minimumBy (comparing fst) (zip (diff:trans) [0..])

main :: IO ()
main = do
  (n : _) <- getLine >>= return . parseInts
  arr <- replicateM n (getLine >>= return . toTuple . parseInts)
  print $ solve arr

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

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

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

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

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

  currentValue :: [(Int, Int)] -> Int
  currentValue xs =
    let (ps, qs) = unzip xs
        in (sum ps) - (sum qs)

  parseTuple :: String -> (Int, Int)
  parseTuple xs =
    let [x, y] = (map readInt . words) xs
        in (x, y)

  changes :: Int -> (Int, Int) -> Int
  changes current (l, r) = current + 2 * (r - l)

  indexOfMostValue :: Int -> Int -> Int -> [Int] -> Int
  indexOfMostValue midx _ _ [] = midx
  indexOfMostValue midx most idx (x:xs)
    | abs most < abs x = indexOfMostValue idx (abs x) (idx + 1) xs
    | otherwise = indexOfMostValue midx most (idx + 1) xs

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- readMultilineInput n (return . parseTuple)
    let cv = currentValue xs
        chgs = map (changes cv) xs
    print $ (1+) $ indexOfMostValue (-1) 0 0 chgs


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

readInts = fmap (map read.words) getLine :: IO [Integer]
printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

divisible a t n
    | a == "" = True
    | take n a == t = divisible (drop n a) t n
    | otherwise = False

printS = do
    ss<-getLine
    tt<-getLine
    let s = if (length ss > length tt) then ss else tt
        t = if (length ss > length tt) then tt else ss
        l = (div (lcm (length s) (length t)) (length s))
        a = concat $ replicate l s
    putStrLn $ if (divisible a t (length t)) then a else "-1"

main = do
    t<-readLn
    replicateM_ t printS

import           Control.Monad
import qualified Data.List       as L
import qualified Data.Map.Strict as M
import           Data.Ord
import qualified Data.Set        as S

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C8
import           Data.Maybe            (fromJust)

getInt :: IO Int
getInt = read <$> getLine

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

getInteger :: IO Integer
getInteger = read <$> getLine

getIntegers :: IO [Integer]
getIntegers = fmap (fst . fromJust . C8.readInteger) . C8.words <$> C8.getLine

--
-- MAIN
--

main :: IO ()
main = do
    q <- getInt
    replicateM_ q $ do
        s <- getLine
        t <- getLine
        let fs = factors s
        let ft = factors t
        let commonFactors = [(ds, dt, fs') | (ds, fs') <- fs, (dt, ft') <- ft, fs' == ft']
        putStrLn $ ans commonFactors

ans :: [(Int, Int, String)] -> String
ans [] = "-1"
ans cf = concat $ replicate (lcm ds dt) fs
  where
    (ds, dt, fs) = L.maximumBy (comparing (\(_, _, a) -> a)) cf

factors :: String -> [(Int, String)]
factors str = do
    let l = length str
    s <- tail $ L.inits str
    let (d, m) = l `divMod` length s
    guard (m == 0)
    guard (concat (replicate d s) == str)
    pure (d, s)

import Control.Monad

solve xs n = head [s|i<-[1..20],
                   mod n i == 0,
                   let d = div n i,
                   let s = take i xs,
                   let ts = concat $ replicate d s,
                   ts == xs]

printResult = do
    s <- getLine
    t <- getLine
    let
        n = length s
        m = length t
        s1 = solve s n
        t1 = solve t m
        n1 = div n $ length s1
        m1 = div m $ length t1
        r = if s1 == t1 then concat $ replicate (lcm m1 n1) s1 else show (-1)
    putStrLn r

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

import Control.Monad
import Data.List
import Data.Array

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Integer]
readInts = readArray

readInt :: IO Integer
readInt = readLn

startsWith :: String -> String -> Bool
startsWith s t = length s <= length t && s == take (length s) t

divides :: String -> String -> Bool
divides s [] = True
divides s t = startsWith s t && divides s (drop (length s) t)

solve :: String -> String -> Maybe String
solve s t =
    let u = concat $ replicate ((lcm (length s) (length t)) `div` (length s)) s in
    if divides s u && divides t u then Just u else Nothing

ans :: Maybe String -> String
ans = maybe "-1" id

solveCase :: IO String
solveCase = do
    s <- getLine
    t <- getLine
    pure $ ans $ solve s t

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

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

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace)
-- debug = flip trace

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

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

solve :: String -> String -> Maybe String
solve s t = if sLcmString == tLcmString then Just sLcmString else Nothing
    where
        sLength = length s
        tLength = length t
        gcdLength = gcd sLength tLength
        sLcmString = join . replicate (tLength `div` gcdLength) $ s
        tLcmString = join . replicate (sLength `div` gcdLength) $ t

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [s, t] <- replicateM 2 $ B8.getLine <&> head . B8.words <&> B8.unpack
        let answer = solve s t
        putStrLn $ fromMaybe "-1" answer

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

isDivisible :: (String, String) -> (Bool)
isDivisible (pattern, txt) = (cpyString((length txt) `div` length (pattern), pattern)==txt)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    let solutions1 = [cpyString(cnt, s) | cnt <- [1..20], isDivisible(t, cpyString(cnt, s))]
    let solutions2 = [cpyString(cnt, t) | cnt <- [1..20], isDivisible(s, cpyString(cnt, t))]

    putStrLn ((solutions1++solutions2++["-1"])!!0)
    solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

-- isDiv :: String -> String -> Bool
-- isDiv a "" = True
-- isDiv "" a = True
-- isDiv a b =
--   let
--     lenA = length a
--     lenB = length b
--     sl = if lenA <= lenB then lenA else lenB
--     ll = lenA + lenB - sl
--     rmd = ll `rem` sl
--   in
--     if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    -- possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    -- fc = head sa
    -- fcb = head sb
    -- (possbl, ans) =
    --   if fc == fcb && all (==fc) sa && all (==fc) sb
    --   then (True, duplicate (lcm lsa lsb) [fc])
    --   else (False, "-1")
    -- (possbl2, ans2) =
    --   if (take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl) then (True, duplicate (lcmab `div` bl) bgl) else (False, "-1")
    -- already = if (bl `rem` sl == 0)
    --           then if (duplicate (bl `div` sl) sgl) == bgl
    --                then True
    --                else False
    --           else False
    opta = duplicate (lcmab `div` lsa) sa
    optb = duplicate (lcmab `div` lsb) sb
    possibl3 = if opta == optb then opta else "-1"
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    -- (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    -- (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    possibl3
    -- if already || possbl || possbl2
    -- then if already
    --       then bgl
    --       else if possbl
    --       then ans
    --       else ans2
    -- else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

isDivisible :: (String, String) -> (Bool)
isDivisible (pattern, txt) = (cpyString((length txt) `div` length (pattern), pattern)==txt)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    let solutions1 = [cpyString(cnt, s) | cnt <- [1..20], isDivisible(t, cpyString(cnt, s))]
    let solutions2 = [cpyString(cnt, t) | cnt <- [1..20], isDivisible(s, cpyString(cnt, t))]

    print ((solutions1++solutions2++["-1"])!!0)
    solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    if(s==(cpyString((length s) `div` (length t), t)))
        then do
            putStrLn s
            solveTestcase(testId-1)
    else if(t==(cpyString((length t) `div` (length s), s)))
        then do
            putStrLn t
            solveTestcase(testId-1)
    else if(isSignleCharacter(s)==True && isSignleCharacter(t)==True && (s!!0)==(t!!0))
        then do
            putStrLn (replicate (lcm (length s) (length t)) (s!!0))
            solveTestcase(testId-1)
    else do
        putStrLn "-1"
        solveTestcase(testId-1)

    --solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    if(s==(cpyString((length s) `div` (length t), t)))
        then do
            putStrLn s
            solveTestcase(testId-1)
    else if(t==(cpyString((length t) `div` (length s), s)))
        then do
            putStrLn t
            solveTestcase(testId-1)
    else if(isSignleCharacter(s)==True && isSignleCharacter(t)==True)
        then do
            putStrLn (replicate (lcm (length s) (length t)) (s!!0))
            solveTestcase(testId-1)
    else do
        putStrLn "-1"
        solveTestcase(testId-1)

    --solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    if(s==(cpyString((length s) `div` (length t), t)))
        then do
            putStr s
            solveTestcase(testId-1)
    else if(t==(cpyString((length t) `div` (length s), s)))
        then do
            putStr t
            solveTestcase(testId-1)
    else if(isSignleCharacter(s)==True && isSignleCharacter(t)==True)
        then do
            putStr (replicate (lcm (length s) (length t)) (s!!0))
            solveTestcase(testId-1)
    else do
        putStr "-1"
        solveTestcase(testId-1)

    --solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

readString :: () -> (IO[Char])
readString () = do
    c <- getChar

    if (c==' ' || c=='\n')
        then return [c]
    else
        do
            rest <- readString()
            return ([c]++rest)

readInt :: () -> IO Int
readInt () = do
    help <- readString()
    let x = read help :: Int

    return x

printer :: () -> IO()
printer () = do
    putStr "1\n"
    printer()

isSignleCharacter :: (String) -> (Bool)
isSignleCharacter (s) = ((replicate (length s) (s!!0))==s)

cpyString :: (Int, String) -> (String)
cpyString (0, s) = ""
cpyString (cnt, s) = s++cpyString(cnt-1, s)

solveTestcase :: (Int) -> IO()
solveTestcase 0 = return ()
solveTestcase (testId) = do
    s <- getLine
    t <- getLine

    if(s==(cpyString((length s) `div` (length t), t)))
        then do
            print s
            solveTestcase(testId-1)
    else if(t==(cpyString((length t) `div` (length s), s)))
        then do
            print t
            solveTestcase(testId-1)
    else if(isSignleCharacter(s)==True && isSignleCharacter(t)==True)
        then do
            print (replicate (lcm (length s) (length t)) (s!!0))
            solveTestcase(testId-1)
    else do
        print "-1"
        solveTestcase(testId-1)

    --solveTestcase(testId-1)

main = do
    t <- readInt()
    solveTestcase(t)

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

-- isDiv :: String -> String -> Bool
-- isDiv a "" = True
-- isDiv "" a = True
-- isDiv a b =
--   let
--     lenA = length a
--     lenB = length b
--     sl = if lenA <= lenB then lenA else lenB
--     ll = lenA + lenB - sl
--     rmd = ll `rem` sl
--   in
--     if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    -- possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    fc = head sa
    fcb = head sb
    (possbl, ans) =
      if fc == fcb && all (==fc) sa && all (==fc) sb
      then (True, duplicate (lcm lsa lsb) [fc])
      else (False, "-1")
    (possbl2, ans2) =
      if (take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl) then (True, duplicate (lcmab `div` bl) bgl) else (False, "-1")
    already = if (bl `rem` sl == 0)
              then if (duplicate (bl `div` sl) sgl) == bgl
                   then True
                   else False
              else False
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    if already || possbl || possbl2
    then if already
          then bgl
          else if possbl
          then ans
          else ans2
    else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

-- isDiv :: String -> String -> Bool
-- isDiv a "" = True
-- isDiv "" a = True
-- isDiv a b =
--   let
--     lenA = length a
--     lenB = length b
--     sl = if lenA <= lenB then lenA else lenB
--     ll = lenA + lenB - sl
--     rmd = ll `rem` sl
--   in
--     if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    -- possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    fc = head sa
    fcb = head sb
    (possbl, ans) =
      if fc == fcb && all (==fc) sa && all (==fc) sb
      then (True, duplicate (lcm lsa lsb) [fc])
      else (False, "-1")
    (possbl2, ans2) =
      if (take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl) then (True, duplicate 2 bgl) else (False, "-1")
    already = if (bl `rem` sl == 0)
              then if (duplicate (bl `div` sl) sgl) == bgl
                   then True
                   else False
              else False
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    if already || possbl || possbl2
    then if already
          then bgl
          else if possbl
          then ans
          else ans2
    else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

-- isDiv :: String -> String -> Bool
-- isDiv a "" = True
-- isDiv "" a = True
-- isDiv a b =
--   let
--     lenA = length a
--     lenB = length b
--     sl = if lenA <= lenB then lenA else lenB
--     ll = lenA + lenB - sl
--     rmd = ll `rem` sl
--   in
--     if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    -- possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    fc = head sa
    fcb = head sb
    (possbl, ans) =
      if fc == fcb && all (==fc) sa && all (==fc) sb
      then (True, duplicate (lcm lsa lsb) [fc])
      else (False, "-1")
    (possbl2, ans2) =
      if (take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl) then (True, duplicate 2 bgl) else (False, "-1")
    already = if (bl `rem` sl == 0)
              then if (duplicate (bl `div` sl) sgl) == bgl
                   then True
                   else False
              else False
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    if already || possbl || possbl2
    then if already
          then bgl
          else if possbl2
          then ans2
          else ans
    else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

-- isDiv :: String -> String -> Bool
-- isDiv a "" = True
-- isDiv "" a = True
-- isDiv a b =
--   let
--     lenA = length a
--     lenB = length b
--     sl = if lenA <= lenB then lenA else lenB
--     ll = lenA + lenB - sl
--     rmd = ll `rem` sl
--   in
--     if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    -- possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    fc = head sa
    fcb = head sb
    (possbl, ans) =
      if fc == fcb && all (==fc) sa && all (==fc) sb
      then (True, duplicate (lcm lsa lsb) [fc])
      else (False, "-1")
    already = if (bl `rem` sl == 0)
              then if (duplicate (bl `div` sl) sgl) == bgl
                   then True
                   else False
              else False
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    if already || possbl
    then if already
          then bgl
          else ans
    else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

module Main where
import Data.Foldable (traverse_)
import Data.List (sort)

duplicate :: Int ->  String -> String
duplicate n string = concat $ replicate n string

getTestCases :: Int -> IO [(String, String)]
getTestCases n = go n []
  where
    go 0 ret = return ret
    go n ret = do
      line <- getLine
      line2 <- getLine
      let tcase = (line, line2)
      -- print tcase
      -- print n
      go (n-1) (ret ++ [tcase])

isDiv :: String -> String -> Bool
isDiv a "" = True
isDiv "" a = True
isDiv a b =
  let
    lenA = length a
    lenB = length b
    sl = if lenA <= lenB then lenA else lenB
    ll = lenA + lenB - sl
    rmd = ll `rem` sl
  in
    if rmd == 0 then True else False

solve :: (String, String) -> String
solve ("",s) = s
solve (s,"") = s
solve (sa, sb) =
  let
    possbl = take (2 * sl) (duplicate 2 bgl) == duplicate 2 sgl
    already = if (bl `rem` sl == 0)
              then if (duplicate (bl `div` sl) sgl) == bgl
                   then True
                   else False
              else False
    lcmab = lcm lsa lsb
    lsa = length sa
    lsb = length sb
    (bl, bgl) = if (lsa >= lsb) then (lsa, sa) else (lsb, sb)
    (sl, sgl) = if (bgl == sa) then (lsb, sb) else (lsa, sa)
    -- nrp = lcmab `div` (length bgl)
    -- ans = duplicate bgl nrp

  in
    if already || possbl
    then if already
          then bgl
          else (duplicate 2 bgl) else "-1"

main :: IO ()
main = do
  ts <- getLine
  let t = read ts :: Int
  testCases <- getTestCases t
  traverse_ (putStrLn . solve) testCases

import           Control.Monad
import qualified Data.List             as L
import qualified Data.Map.Strict       as M
import qualified Data.Set              as S

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C8
import           Data.Maybe            (fromJust)

getInt :: IO Int
getInt = read <$> getLine

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

getInteger :: IO Integer
getInteger = read <$> getLine

getIntegers :: IO [Integer]
getIntegers = fmap (fst . fromJust . C8.readInteger) . C8.words <$> C8.getLine

--
-- MAIN
--

main :: IO ()
main = do
    q <- getInt
    replicateM_ q $ do
        s@(s1:_) <- getLine
        t <- getLine
        let ls = length s
        let lt = length t
        let result | all (==s1) s && all (==s1) t = Just (replicate (lcm ls lt) s1)
                   | ls < lt && t `consistsOf` s = Just t
                   | lt < ls && s `consistsOf` t = Just s
                   | otherwise = Nothing
        case result of
          Just s -> putStrLn s
          _ -> putStrLn "-1"

consistsOf :: String -> String -> Bool
consistsOf "" _ = True
consistsOf s ref = ref `L.isPrefixOf` s && drop (length ref) s `consistsOf` ref


{-# LANGUAGE TypeApplications #-}
module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.List                      ( genericReplicate
                                                , scanl'
                                                )

-- infinite list of prime numbers
primes :: [Integer]
primes = 2 : filter isPrime [3, 5 ..]
  where
    isPrime n = not (any (divides n) (takeWhile (\p -> p * p <= n) primes))
    divides n p = n `mod` p == 0

-- calculateBase :: Int -> [Int] -> [(Int, Int)]
calculateBase k xs = scanr (\x (q, y) -> (x * k, (q + 1) * y)) (last xs * k, 1) (take (length xs - 1) xs)

-- >>> calculateBase 3 [2,3]
-- [(2,10),(9,1)]

-- convertToBase :: Int -> Int -> [(Int, Int)] -> [Int]
convertToBase k a = fmap snd . tail . scanl' (\(rest, _) (q, x) -> let len = min q (rest `div` x) in (rest - len * x, len)) (a, 0)

-- >>> convertToBase 3 19 (calculateBase 3 [2,3])
-- [1,9]

-- | @replaceBase bases k n str@ replaces each segment of asterisks in @str@ with the corresponding digit of 'b' as @n@.
-- replaceBase :: [(Int, Int)] -> Int -> Int -> String -> String
replaceBase bases k n = phi [] (convertToBase k n bases)
  where
    phi acc digits           []         = concat acc
    phi acc (digit : digits) ('*' : xs) = phi (acc ++ [genericReplicate digit 'b']) digits xs
    phi acc digits           (x   : xs) = phi (acc ++ [[x]]) digits xs

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [_, k, x]       <- fmap (map (read @Integer) . words) getLine
        (str, segments) <- readStr
        putStrLn $ replaceBase (calculateBase k segments) k (x - 1) str
  where
    readStr = go "" [] 0 <$> getLine
    go acc segments current [] =
        ( case reverse acc of
            acc'@('*' : _) -> acc'
            acc'           -> '*' : acc'
        , reverse (current : segments)
        )
    go acc segments current (x : xs)
        | x == '*' = case acc of
            ('*' : _) -> go acc segments (current + 1) xs
            _         -> go ('*' : acc) segments 1 xs
        | otherwise = go (x : acc) (if current > 0 || null acc then current : segments else segments) 0 xs

import Control.Monad (replicateM)

main :: IO ()
main = do
    t <- read <$> getLine
    res <- replicateM t $ do
        [n, k, x] <- map read . words <$> getLine :: IO [Integer]
        solve n k x <$> getLine
    putStrLn . unlines $ res

solve :: Integer -> Integer -> Integer -> String -> String
solve n k x s = ans
    where
        stars   = words [if c == '*' then c else ' ' | c <- s]
        as      = words [if c == 'a' then c else ' ' | c <- 'a':s]
        bases   = reverse $  map ((1 +) . (fromInteger k *) .  length) stars
        num     = reverse $ convert bases (x-1)
        _:ans   = blend as (map (`replicate` 'b') num)

convert :: [Int] -> Integer -> [Int]
convert [] _        = []
convert (b:bs) x    = fromInteger m : convert bs q
    where
        (q, m) = divMod x (toInteger b)

blend :: [String] -> [String] -> String
blend (x:xs) ys = x ++ blend ys xs
blend [] ys = concat ys

{-# LANGUAGE TypeApplications #-}
module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.List                      ( scanl' )

-- infinite list of prime numbers
primes :: [Integer]
primes = 2 : filter isPrime [3, 5 ..]
  where
    isPrime n = not (any (divides n) (takeWhile (\p -> p * p <= n) primes))
    divides n p = n `mod` p == 0

calculateBase :: Int -> [Int] -> [(Int, Int)]
calculateBase k xs = scanr (\x (q, y) -> (x * k, (q + 1) * y)) (last xs * k, 1) (take (length xs - 1) xs)

-- >>> calculateBase 3 [2,3]
-- [(2,10),(9,1)]

convertToBase :: Int -> Int -> [(Int, Int)] -> [Int]
convertToBase k a = fmap snd . tail . scanl' (\(rest, _) (q, x) -> let len = min q (rest `div` x) in (rest - len * x, len)) (a, 0)

-- >>> convertToBase 3 19 (calculateBase 3 [2,3])
-- [1,9]

-- | @replaceBase bases k n str@ replaces each segment of asterisks in @str@ with the corresponding digit of 'b' as @n@.
replaceBase :: [(Int, Int)] -> Int -> Int -> String -> String
replaceBase bases k n = phi [] (convertToBase k n bases)
  where
    phi acc digits           []         = concat acc
    phi acc (digit : digits) ('*' : xs) = phi (acc ++ [replicate digit 'b']) digits xs
    phi acc digits           (x   : xs) = phi (acc ++ [[x]]) digits xs

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [_, k, x]       <- fmap (map (read @Int) . words) getLine
        (str, segments) <- readStr
        putStrLn $ replaceBase (calculateBase k segments) k (x - 1) str
  where
    readStr = go "" [] 0 <$> getLine
    go acc segments current [] =
        ( case reverse acc of
            acc'@('*' : _) -> acc'
            acc'           -> '*' : acc'
        , reverse (current : segments)
        )
    go acc segments current (x : xs)
        | x == '*' = case acc of
            ('*' : _) -> go acc segments (current + 1) xs
            _         -> go ('*' : acc) segments 1 xs
        | otherwise = go (x : acc) (if current > 0 || null acc then current : segments else segments) 0 xs

{-# LANGUAGE TypeApplications #-}
module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.List                      ( scanl' )
import           Debug.Trace                    ( traceShow )

-- infinite list of prime numbers
primes :: [Integer]
primes = 2 : filter isPrime [3, 5 ..]
  where
    isPrime n = not (any (divides n) (takeWhile (\p -> p * p <= n) primes))
    divides n p = n `mod` p == 0

calculateBase :: Int -> [Int] -> [(Int, Int)]
calculateBase k xs = scanr (\x (q, y) -> (x, (q + 1) * y)) (last xs * k, 1) (take (length xs - 1) xs)

-- >>> calculateBase 3 [2,3]
-- [(2,10),(9,1)]

convertToBase :: Int -> Int -> [(Int, Int)] -> [Int]
convertToBase k a = fmap snd . tail . scanl' (\(rest, _) (q, x) -> let len = min (q * k) (rest `div` x) in (rest - len * x, len)) (a, 0)

-- >>> convertToBase 3 19 (calculateBase 3 [2,3])
-- [1,9]

-- | @replaceBase bases k n str@ replaces each segment of asterisks in @str@ with the corresponding digit of 'b' as @n@.
replaceBase :: [(Int, Int)] -> Int -> Int -> String -> String
replaceBase bases k n = phi [] (convertToBase k n bases)
  where
    phi acc digits           []         = concat acc
    phi acc (digit : digits) ('*' : xs) = phi (acc ++ [replicate digit 'b']) digits xs
    phi acc digits           (x   : xs) = phi (acc ++ [[x]]) digits xs

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [_, k, x]       <- fmap (map (read @Int) . words) getLine
        (str, segments) <- readStr
        putStrLn $ replaceBase (calculateBase k segments) k (x - 1) str
  where
    readStr = go "" [] 0 <$> getLine
    go acc segments current [] =
        ( case reverse acc of
            acc'@('*' : _) -> acc'
            acc'           -> '*' : acc'
        , reverse (current : segments)
        )
    go acc segments current (x : xs)
        | x == '*' = case acc of
            ('*' : _) -> go acc segments (current + 1) xs
            _         -> go ('*' : acc) segments 1 xs
        | otherwise = go (x : acc) (if current > 0 || null acc then current : segments else segments) 0 xs

{-# LANGUAGE TypeApplications #-}
module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.List                      ( scanl' )
import           Debug.Trace                    ( traceShow )

-- infinite list of prime numbers
primes :: [Integer]
primes = 2 : filter isPrime [3, 5 ..]
  where
    isPrime n = not (any (divides n) (takeWhile (\p -> p * p <= n) primes))
    divides n p = n `mod` p == 0

calculateBase :: Int -> [Int] -> [(Int, Int)]
calculateBase k xs = scanr (\x (q, y) -> (x, (q + 1) * y)) (last xs * k, 1) (take (length xs - 1) xs)

-- >>> calculateBase 3 [2,3]
-- [(2,10),(9,1)]

convertToBase :: Int -> Int -> [(Int, Int)] -> [Int]
convertToBase k a = fmap snd . tail . scanl' (\(rest, _) (q, x) -> let len = min (q * k) (rest `div` x) in (rest - len * x, len)) (a, 0)

-- >>> convertToBase 3 19 (calculateBase 3 [2,3])
-- [1,9]

-- | @replaceBase bases k n str@ replaces each segment of asterisks in @str@ with the corresponding digit of 'b' as @n@.
replaceBase :: [(Int, Int)] -> Int -> Int -> String -> String
replaceBase bases k n = phi [] (convertToBase k n bases)
  where
    phi acc digits           []         = concat acc
    phi acc (digit : digits) ('*' : xs) = phi (acc ++ [replicate digit 'b']) digits xs
    phi acc digits           (x   : xs) = phi (acc ++ [[x]]) digits xs

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [_, k, x]       <- fmap (map (read @Int) . words) getLine
        (str, segments) <- readStr
        putStrLn $ replaceBase (calculateBase k segments) k (x - 1) str
  where
    readStr = go "" [] 0 <$> getLine
    go acc segments current [] =
        ( case reverse acc of
            acc'@('*' : _) -> acc'
            acc'           -> '*' : acc'
        , reverse (current : segments)
        )
    go acc segments current (x : xs)
        | x == '*' = case acc of
            ('*' : _) -> go acc segments (current + 1) xs
            _         -> go ('*' : acc) segments 1 xs
        | otherwise = go (x : acc) (current : segments) 0 xs

{-# LANGUAGE TypeApplications #-}
module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.List                      ( scanl' )

-- infinite list of prime numbers
primes :: [Integer]
primes = 2 : filter isPrime [3, 5 ..]
  where
    isPrime n = not (any (divides n) (takeWhile (\p -> p * p <= n) primes))
    divides n p = n `mod` p == 0

calculateBase :: Int -> [Int] -> [(Int, Int)]
calculateBase k xs = scanr (\x (q, y) -> (x, (q + 1) * y)) (last xs * k, 1) (take (length xs - 1) xs)

-- >>> calculateBase 3 [2,3]
-- [(2,10),(9,1)]

convertToBase :: Int -> Int -> [(Int, Int)] -> [Int]
convertToBase k a = fmap snd . tail . scanl' (\(rest, _) (q, x) -> let len = min q (a `div` x) in (rest - len * x, len)) (a, 0)

-- >>> convertToBase 3 19 (calculateBase 3 [2,3])
-- [1,9]

-- | @replaceBase bases k n str@ replaces each segment of asterisks in @str@ with the corresponding digit of 'b' as @n@.
replaceBase :: [(Int, Int)] -> Int -> Int -> String -> String
replaceBase bases k n = phi [] (convertToBase k n bases)
  where
    phi acc digits           []         = concat acc
    phi acc (digit : digits) ('*' : xs) = phi (acc ++ [replicate digit 'b']) digits xs
    phi acc digits           (x   : xs) = phi (acc ++ [[x]]) digits xs

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [_, k, x]       <- fmap (map (read @Int) . words) getLine
        (str, segments) <- readStr
        putStrLn $ replaceBase (calculateBase k segments) k (x - 1) str
  where
    readStr = go "" [] 0 <$> getLine
    go acc segments current [] =
        ( case reverse acc of
            acc'@('*' : _) -> acc'
            acc'           -> '*' : acc'
        , reverse (current : segments)
        )
    go acc segments current (x : xs)
        | x == '*' = case acc of
            ('*' : _) -> go acc segments (current + 1) xs
            _         -> go ('*' : acc) segments 1 xs
        | otherwise = go (x : acc) (current : segments) 0 xs