Even a cat has things it can do that AI cannot.— Fei-Fei LiYou are given $$$m$$$ arrays of positive integers. Each array is of even length.You need to split all these integers into two equal multisets $$$L$$$ and $$$R$$$, that is, each element of each array should go into one of two multisets (but not both). Additionally, for each of the $$$m$$$ arrays, exactly half of its elements should go into $$$L$$$, and the rest should go into $$$R$$$.Give an example of such a division or determine that no such division exists.

The first line contains an integer $$$m$$$ ($$$1 \le m \le 10 ^ 5$$$) — the number of arrays. The next $$$2 \cdot m$$$ lines contain descriptions of the arrays. For each array, the first line contains an even integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10 ^ 5$$$) — the length of the array. The second line consists of $$$n$$$ space-separated integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10 ^ 9$$$) — array elements. It is guaranteed that the sum of $$$n$$$ over all arrays does not exceed $$$2 \cdot 10^5$$$.

If the answer exists, print "YES", and then print $$$m$$$ lines. On each line, for each element, print the letter "L" or "R" (capitalized, without spaces), depending on which multiset the element should go into. If there is no answer, print "NO" on the only line.

NoteIn the first array, we add the first element to $$$R$$$ and the second to $$$L$$$. Now $$$L = \{2\}$$$, and $$$R = \{1\}$$$.In the second array, we add the first and third elements to $$$L$$$ and the rest to $$$R$$$. Now $$$L = \{1, 2, 3\}$$$ and $$$R = \{1, 2, 3\}$$$.In the third array, we add elements 2, 3, and 6 to $$$L$$$, and others — to $$$R$$$. As a result, $$$L = R = \{1, 1, 2, 2, 3, 3\}$$$.

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

binSearch :: (Int -> Bool) -> Int -> Int -> Int
{-# INLINE binSearch #-}
binSearch fun = let
  go li ri = if  li == ri
    then  li
    else  let
    mi = li + (ri - li) `div` 2
    in  if  fun mi
    then  go li mi
    else  go (mi + 1) ri
  in  go

solve :: Int -> Array Int [(Int, Int)] -> Maybe (UArray Int Bool)
solve nEdges adj0 = runST $ do
  adj :: STArray s Int [(Int, Int)]
      <- thaw adj0 :: ST s (STArray s Int [(Int, Int)])
  used :: STUArray s Int Bool <- newArray (1, nEdges) False
  ans :: STUArray s Int Bool <- newArray (1, nEdges) False
  let
    (minu, maxu) = bounds adj0
    go :: Int -> ST s ()
    go u = do
      nextE <- readArray adj u
      case  nextE  of
        [] -> pure ()
        (eix, v) : es -> do
          writeArray adj u es
          eused <- readArray used eix
          if  eused
            then  go u
            else  do
            writeArray used eix True
            when (u < v) $ writeArray ans eix True
            go v

    tryGo :: Int -> ST s Bool
    tryGo u = if  u > maxu
      then  pure  True
      else  do
      nextE <- readArray adj u
      case  nextE  of
        [] -> tryGo (u + 1)
        (eix, v) : es
          | u < v  -> go u >> tryGo (u + 1)
          | otherwise -> do
              eused <- readArray used eix
              if  eused
                then  writeArray adj u es >> tryGo u
                else  pure False

  ok <- tryGo minu
  if  ok
    then  Just <$> freeze ans
    else  pure Nothing

mainFun :: SP Builder
mainFun = do
  m <- getInt
  arrs :: Array Int (UArray Int Int)
    <- fmap (listArray (1, m)) $ replicateM m $ do
    n <- getInt
    listArray (1, n) <$> replicateM n getInt
  let
    valLi :: [Int]
    valLi = map head $ group $ sort $ concatMap elems arrs
    nvals = length valLi
    vals :: UArray Int Int
    vals = listArray (1, nvals) valLi
    getIx v = binSearch (\i -> vals ! i >= v) 1 nvals

    es :: [(Int, Int)]
    es = do
      (i, arr) <- assocs arrs
      w <- elems arr
      pure (i, m + getIx w)

    numEs :: Int
    numEs = foldl' (+) 0 $ map (snd . bounds) $ elems arrs

    adj :: Array Int [(Int, Int)]
    adj = accumArray (flip (:)) [] (1, m + nvals) $ do
      (eix, (u, v)) <- zip [1..] es
      [(u, (eix, v)), (v, (eix, u))]

    ans = solve numEs adj
  pure $ case  ans  of
    Nothing -> string7 "NO\n"
    Just ansArr -> string7 "YES\n" <> let
      go ansIx arrIx = let
        toC i = bool 'L' 'R' $ ansArr ! (i + ansIx)
        (1, tot) = bounds (arrs ! arrIx)
        in  if  arrIx > m
        then  []
        else  map toC [1 .. tot] : go (ansIx + tot) (arrIx + 1)
      in  foldMap (\cs -> string7 cs <> char7 '\n') $ go 0 1

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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


I wonder, does the falling rain Forever yearn for it's disdain?Effluvium of the MindYou are given a positive integer $$$n$$$.Find any permutation $$$p$$$ of length $$$n$$$ such that the sum $$$\operatorname{lcm}(1,p_1) + \operatorname{lcm}(2, p_2) + \ldots + \operatorname{lcm}(n, p_n)$$$ is as large as possible. Here $$$\operatorname{lcm}(x, y)$$$ denotes the least common multiple (LCM) of integers $$$x$$$ and $$$y$$$.A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1\,000$$$). Description of the test cases follows. The only line for each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print $$$n$$$ integers $$$p_1$$$, $$$p_2$$$, $$$\ldots$$$, $$$p_n$$$ — the permutation with the maximum possible value of $$$\operatorname{lcm}(1,p_1) + \operatorname{lcm}(2, p_2) + \ldots + \operatorname{lcm}(n, p_n)$$$. If there are multiple answers, print any of them.

NoteFor $$$n = 1$$$, there is only one permutation, so the answer is $$$[1]$$$.For $$$n = 2$$$, there are two permutations:   $$$[1, 2]$$$ — the sum is $$$\operatorname{lcm}(1,1) + \operatorname{lcm}(2, 2) = 1 + 2 = 3$$$.  $$$[2, 1]$$$ — the sum is $$$\operatorname{lcm}(1,2) + \operatorname{lcm}(2, 1) = 2 + 2 = 4$$$.

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t ri
    mapM_ (putStrLn.showL.solve) tcs

showL = unwords . map show

solve [n] = map (fixOrder n) [1..n]
solve _   = error "Bad input single int"

fixOrder n | (even n)   = f
           | otherwise  = g
  where
    f x | (even x)   = x-1
        | otherwise  = x+1

    g 1 = 1
    g x | (even x)   = x+1
        | otherwise  = x-1

module Main where
import Control.Monad

sign::Bool->Int->Int
sign True x
  |odd x=x+1
  |otherwise=x-1
sign False x
  |odd x=x-1
  |otherwise=x+1
pt::Int->IO()
pt=putStrLn.show

solve::Int->Bool->[IO()]
solve 1 True =[pt 2]
solve n True =(pt (sign True n)):(solve (n-1) True)

solve 1 False =[pt 1]
solve n False =(pt (sign False n)):(solve (n-1) False)
main = do
  line<-getLine
  let nTerm=read line::Int
  replicateM_ nTerm$do
    list<-getLine
    let n=read list::Int
    let test=even n
    sequence$reverse (solve n test)


Arkady coordinates rounds on some not really famous competitive programming platform. Each round features $$$n$$$ problems of distinct difficulty, the difficulties are numbered from $$$1$$$ to $$$n$$$.To hold a round Arkady needs $$$n$$$ new (not used previously) problems, one for each difficulty. As for now, Arkady creates all the problems himself, but unfortunately, he can't just create a problem of a desired difficulty. Instead, when he creates a problem, he evaluates its difficulty from $$$1$$$ to $$$n$$$ and puts it into the problems pool.At each moment when Arkady can choose a set of $$$n$$$ new problems of distinct difficulties from the pool, he holds a round with these problems and removes them from the pool. Arkady always creates one problem at a time, so if he can hold a round after creating a problem, he immediately does it.You are given a sequence of problems' difficulties in the order Arkady created them. For each problem, determine whether Arkady held the round right after creating this problem, or not. Initially the problems pool is empty.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^5$$$) — the number of difficulty levels and the number of problems Arkady created. The second line contains $$$m$$$ integers $$$a_1, a_2, \ldots, a_m$$$ ($$$1 \le a_i \le n$$$) — the problems' difficulties in the order Arkady created them.

Print a line containing $$$m$$$ digits. The $$$i$$$-th digit should be $$$1$$$ if Arkady held the round after creation of the $$$i$$$-th problem, and $$$0$$$ otherwise.

NoteIn the first example Arkady held the round after the first three problems, because they are of distinct difficulties, and then only after the last problem.

-- Codeforces Round #532 (A), Contest 1100, Problem set ?.
-- UNDONE

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  xs <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let mdn = m `div` n
  probsForRound <- A.newArray (0,mdn) n :: IO (IOUArray Int Int)
  probsWithDiff <- A.newArray (1,n) 0 :: IO (IOUArray Int Int)
  forM_ xs $ \x -> do
    px <- A.readArray probsWithDiff x
    A.writeArray probsWithDiff x (px+1)
    if px <= mdn then do
      rest <- A.readArray probsForRound px
      A.writeArray probsForRound px (rest-1)
      putChar $ if rest <= 1 then '1' else '0'
    else putChar '0'
  putStrLn ""

{-# LANGUAGE ScopedTypeVariables #-}

import Prelude
import Data.Maybe
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor
import Control.Monad.ST.Safe
import Data.STRef
import qualified Data.Array.IArray as IA
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as A
import qualified Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8

solve :: Int -> Int -> [Int] -> ST s [Int]
solve n m lst = do
    cnt <- A.newArray (1, n) 0 :: ST s (A.STUArray s Int Int)
    contests <- A.newArray (1, m) 0 :: ST s (A.STUArray s Int Int)
    answer <- forM lst $ \elem -> do
        cnt_val <- A.readArray cnt elem
        A.writeArray cnt elem (cnt_val + 1)
        contests_val <- A.readArray contests (cnt_val + 1)
        A.writeArray contests (cnt_val + 1) (contests_val + 1)
        return $ if contests_val == n - 1 then 1 else 0
    return answer

main :: IO ()
main = do
    ([n, m] :: [Int]) <- (map (fst . fromJust . B8.readInt) . B8.words) <$> B8.getLine
    (arr :: [Int]) <- (map (fst . fromJust . B8.readInt) . B8.words) <$> B8.getLine
    let answer = runST $ solve n m arr
    forM_ answer $ printf "%d"
    printf "\n"

import Data.Array.ST.Safe
import Data.Array.IArray
import Data.STRef
import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.ST
main = putStrLn . solve . map readI . B.words =<< B.getContents
solve (n:m:as) = elems $ runSTUArray $ do
  t <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
  r <- newArray_ (1,m)
  c <- newSTRef 0
  forM_ (zip [1..] as) $ \(i,a) -> do
    prev <- readArray t a
    when (prev == 0) $ modifySTRef' c succ
    writeArray t a (prev + 1)
    c' <- readSTRef c
    writeArray r i $ if c' == n then '1' else '0'
    when (c' == n) $ do
      forM_ [1..n] $ \j -> writeArray t j . pred =<< readArray t j
      writeSTRef c . length . filter (> 0) =<< getElems t
  return r
readI b = i where Just (i,_) = B.readInt b


Today, hedgehog Filya went to school for the very first time! Teacher gave him a homework which Filya was unable to complete without your help.Filya is given an array of non-negative integers a1, a2, ..., an. First, he pick an integer x and then he adds x to some elements of the array (no more than once), subtract x from some other elements (also, no more than once) and do no change other elements. He wants all elements of the array to be equal.Now he wonders if it's possible to pick such integer x and change some elements of the array using this x in order to make all elements equal.

The first line of the input contains an integer n (1 ≤ n ≤ 100 000) — the number of integers in the Filya's array. The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 109) — elements of the array.

If it's impossible to make all elements of the array equal using the process given in the problem statement, then print "NO" (without quotes) in the only line of the output. Otherwise print "YES" (without quotes).

NoteIn the first sample Filya should select x = 1, then add it to the first and the last elements of the array and subtract from the second and the third elements.

-- ID:  714B (Filya and Homework)
-- URL: http://codeforces.com/problemset/problem/714/B

import Data.List

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    xs <- (map read . take n . words) `fmap` getContents :: IO [Int]
    putStrLn $ (judge . collect) xs

collect xs = f xs [] where
    f [] acc = Just acc
    f (x:xs) acc
        | x `elem` acc    = f xs acc
        | length acc == 3 = Nothing
        | otherwise       = f xs (x:acc)

judge Nothing = "NO"
judge (Just [x]) = "YES"
judge (Just [x,y]) = "YES"
judge (Just [x,y,z])
    | arithmeticSeq (sort [x,y,z]) = "YES"
    | otherwise = "NO"

arithmeticSeq [x,y,z]
    | y-x == z-y = True
    | otherwise  = False

import Data.List

main :: IO ()
main = output . solve [] . map read . tail . words =<< getContents

output :: Bool -> IO ()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> [Int] -> Bool
solve final [] | length final <= 2  = True
               | length final == 3 = let [a, b, c] = sort final
                                     in a + c == b + b
solve s (a:ax) | a `elem` s = solve s ax
               | length s == 3 = False
               | otherwise = solve (a:s) ax

import Data.List

main = getContents >>= putStrLn . solve . map head . group . sort . map (read :: String -> Int) . tail . words

solve [a, b, c] = if b - a == c - b then "YES" else "NO"
solve as = if length as < 3 then "YES" else "NO"

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

  check :: [Int] -> String
  check xs
    | length xs < 3 = "YES"
    | length xs == 3 =
      let (a:b:c:[]) = sort xs
          in case b - a == c - b of
            True -> "YES"
            False -> "NO"

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . (map readInt) . words
    let ys = S.toList $ S.fromList xs
        ans = case length ys <= 3 of
          False -> "NO"
          True -> check ys
    putStrLn ans

import Data.List(nub,sort)
main = do
    getLine
    aaa <- return . map read . words =<< getLine
    let kinds [] _ = []
	kinds _ 4   = []
	kinds (c:cs) n	= c:remain
	      where	    remain = kinds [x| x<-cs, x/=c] $ n+1
	washed = kinds aaa 0
    case  washed 	of
      [_,_,_]		->  let	[i,j,k] = sort washed
				(half,m) = divMod (k-i) 2
			    in	if m==0 && half+i==j
				    then putStr "YES"
				    else putStr "NO"
      [_,_]		-> putStr "YES"
      [_]		-> putStr "YES"
      _			-> putStr "NO"

import Data.List

main :: IO ()
main = output . solve [] . map read . tail . words =<< getContents

output :: Bool -> IO ()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> [Int] -> Bool
solve final [] | length final == 1 = True
               | length final == 2 = even ((head final) + (final !! 1))
               | length final == 3 = let [a, b, c] = sort final
                                     in a + c == b + b
solve s (a:ax) | a `elem` s = solve s ax
               | length s == 3 = False
               | otherwise = solve (a:s) ax

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 -> Integer
  readInt s = read s :: Integer

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

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

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . (map readInt) . words
    let happenable = (<=3) $ length $ S.toList $ S.fromList xs
        ans = case happenable of
                True -> "YES"
                False -> "NO"
    putStrLn ans

import Data.List(nub,sort)
main = do
    getLine
    as <- return . map read . words =<< getLine
    case sort $ nub as	of
      [x,y,z]		-> if even (z-x)
			    then putStr "YES"
			    else putStr "NO"
      [x,y]		-> if even (y-x)
			    then putStr "YES"
			    else putStr "NO"
      [x]		-> putStr "YES"
      _			-> putStr "NO"

import Data.List(nub,sort)
main = do
    getLine
    aaa <- return . map read . words =<< getLine
    let kinds [] _ = []
	kinds (c:cs) n
	  | n==4	= []
	  | otherwise	= c:(kinds [x| x<-cs, x/=c] (n+1))
	ks = kinds aaa 0
    case length ks 	of
      3		-> let	[i,j,k] = sort ks
		   in	if even (k-i)
			    then putStr "YES"
			    else putStr "NO"
      2		-> putStr "YES"
      1		-> putStr "YES"
      _		-> putStr "NO"


You're given an array $$$a$$$ of length $$$n$$$. You can perform the following operation on it as many times as you want:  Pick two integers $$$i$$$ and $$$j$$$ $$$(1 \le i,j \le n)$$$ such that $$$a_i+a_j$$$ is odd, then swap $$$a_i$$$ and $$$a_j$$$. What is lexicographically the smallest array you can obtain?An array $$$x$$$ is lexicographically smaller than an array $$$y$$$ if there exists an index $$$i$$$ such that $$$x_i<y_i$$$, and $$$x_j=y_j$$$ for all $$$1 \le j < i$$$. Less formally, at the first index $$$i$$$ in which they differ, $$$x_i<y_i$$$

The first line contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of elements in the array $$$a$$$. The second line contains $$$n$$$ space-separated integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_{n}$$$ ($$$1 \le a_i \le 10^9$$$) — the elements of the array $$$a$$$.

The only line contains $$$n$$$ space-separated integers, the lexicographically smallest array you can obtain.

NoteIn the first example, we can swap $$$1$$$ and $$$4$$$ since $$$1+4=5$$$, which is odd.

import Data.List
solve a = if any odd a && any even a then sort a else a
main=interact$unwords.map show.solve.map read.words.last.lines


As the guys fried the radio station facilities, the school principal gave them tasks as a punishment. Dustin's task was to add comments to nginx configuration for school's website. The school has n servers. Each server has a name and an ip (names aren't necessarily unique, but ips are). Dustin knows the ip and name of each server. For simplicity, we'll assume that an nginx command is of form "command ip;" where command is a string consisting of English lowercase letter only, and ip is the ip of one of school servers.  Each ip is of form "a.b.c.d" where a, b, c and d are non-negative integers less than or equal to 255 (with no leading zeros). The nginx configuration file Dustin has to add comments to has m commands. Nobody ever memorizes the ips of servers, so to understand the configuration better, Dustin has to comment the name of server that the ip belongs to at the end of each line (after each command). More formally, if a line is "command ip;" Dustin has to replace it with "command ip; #name" where name is the name of the server with ip equal to ip.Dustin doesn't know anything about nginx, so he panicked again and his friends asked you to do his task for him.

The first line of input contains two integers n and m (1 ≤ n, m ≤ 1000). The next n lines contain the names and ips of the servers. Each line contains a string name, name of the server and a string ip, ip of the server, separated by space (1 ≤ |name| ≤ 10, name only consists of English lowercase letters). It is guaranteed that all ip are distinct. The next m lines contain the commands in the configuration file. Each line is of form "command ip;" (1 ≤ |command| ≤ 10, command only consists of English lowercase letters). It is guaranteed that ip belongs to one of the n school servers.

Print m lines, the commands in the configuration file after Dustin did his task.

{-# LANGUAGE ViewPatterns #-}
import Control.Monad
import qualified Data.Map.Strict as M
main = do
  [n, m] <- fmap (map read . words) getLine
  s <- M.fromList `fmap` replicateM n (fmap ((\[a, b] -> (b, a)) . words) getLine)
  replicateM m $ putStrLn . (\l -> let [_, flip M.lookup s . init -> Just n] = words l in l ++ " #" ++ n) =<< getLine

main = interact $ unlines . solve . lines

solve (nl:cs) = map process $ drop n cs
    where n = (read . head . words) nl
          table = foldl tolist [] $ take n cs
          tolist acc x = let ws = words x in (last ws ++ ";", head ws):acc
          process s = case lookup (last $ words s) table of Just ans -> s ++ " #" ++ ans

import qualified Data.Map as Map
import Control.Monad

f::[String]->[(String,String)]
f []=[]
f (s:strs)=let (a:b:[])=words s
           in (b++";",a):f strs

f2::[String]->Map.Map String String->[String]
f2 [] _=[]
f2 (s:strs) ms=let (a:b:[])=words s
                   Just c=Map.lookup b ms
               in (s++" #"++c):(f2 strs) ms

main = do
       e1<-getLine
       let (n:m:[])=map read (words e1)::[Int]
       e2<-replicateM n getLine
       e3<-replicateM m getLine
       let xs=f e2
       mapM_ putStrLn $ f2 e3 $ Map.fromList xs


The $$$\text{$$$gcdSum$$$}$$$ of a positive integer is the $$$gcd$$$ of that integer with its sum of digits. Formally, $$$\text{$$$gcdSum$$$}(x) = gcd(x, \text{ sum of digits of } x)$$$ for a positive integer $$$x$$$. $$$gcd(a, b)$$$ denotes the greatest common divisor of $$$a$$$ and $$$b$$$ — the largest integer $$$d$$$ such that both integers $$$a$$$ and $$$b$$$ are divisible by $$$d$$$.For example: $$$\text{$$$gcdSum$$$}(762) = gcd(762, 7 + 6 + 2)=gcd(762,15) = 3$$$.Given an integer $$$n$$$, find the smallest integer $$$x \ge n$$$ such that $$$\text{$$$gcdSum$$$}(x) > 1$$$.

The first line of input contains one integer $$$t$$$ $$$(1 \le t \le 10^4)$$$ — the number of test cases.  Then $$$t$$$ lines follow, each containing a single integer $$$n$$$ $$$(1 \le n \le 10^{18})$$$. All test cases in one test are different.

Output $$$t$$$ lines, where the $$$i$$$-th line is a single integer containing the answer to the $$$i$$$-th test case.

import Control.Monad

sumDigits :: Integer -> Integer
sumDigits x
    | x < 10 = x
    | otherwise = sumDigits (div x 10) + mod x 10

solve :: Integer -> Integer
solve x = if gcd x (sumDigits x) == 1 then solve (x+1) else x

main = do
    line <- getLine
    let tc = read line :: Integer
    ans <- forM_ [1..tc] (\a -> do
            line <- getLine
            let x = read line :: Integer
            print (solve x)
        )
    return ()

{-# LANGUAGE BangPatterns #-}

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM, forM) -- foldM est un foldl
import Data.Maybe
import Data.Int

bezout :: (Integral n) => n -> n -> (n, n)
bezout _ 0 = (1, 0)
bezout _ 1 = (0, 1)
bezout a b = (y, x-y*q)
	where
		(q, r) = a `divMod` b
		(x, y) = bezout b r

sumDigit 0 = 0
sumDigit x = mod x 10 + sumDigit (div x 10)

gcdSum :: Integer -> Integer
gcdSum x = let (a, b) = bezout x y in x*a+y*b where y = sumDigit x

solve :: Integer -> Integer
solve n
	| gcdSum n == 1 = solve (n+1)
	| otherwise = n

plotResult :: Integer -> IO ()
plotResult = print

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n


Let $$$a$$$ be a matrix of size $$$r \times c$$$ containing positive integers, not necessarily distinct. Rows of the matrix are numbered from $$$1$$$ to $$$r$$$, columns are numbered from $$$1$$$ to $$$c$$$. We can construct an array $$$b$$$ consisting of $$$r + c$$$ integers as follows: for each $$$i \in [1, r]$$$, let $$$b_i$$$ be the greatest common divisor of integers in the $$$i$$$-th row, and for each $$$j \in [1, c]$$$ let $$$b_{r+j}$$$ be the greatest common divisor of integers in the $$$j$$$-th column. We call the matrix diverse if all $$$r + c$$$ numbers $$$b_k$$$ ($$$k \in [1, r + c]$$$) are pairwise distinct. The magnitude of a matrix equals to the maximum of $$$b_k$$$.For example, suppose we have the following matrix: $$$\begin{pmatrix} 2 & 9 & 7\\ 4 & 144 & 84 \end{pmatrix}$$$ We construct the array $$$b$$$:  $$$b_1$$$ is the greatest common divisor of $$$2$$$, $$$9$$$, and $$$7$$$, that is $$$1$$$;  $$$b_2$$$ is the greatest common divisor of $$$4$$$, $$$144$$$, and $$$84$$$, that is $$$4$$$;  $$$b_3$$$ is the greatest common divisor of $$$2$$$ and $$$4$$$, that is $$$2$$$;  $$$b_4$$$ is the greatest common divisor of $$$9$$$ and $$$144$$$, that is $$$9$$$;  $$$b_5$$$ is the greatest common divisor of $$$7$$$ and $$$84$$$, that is $$$7$$$. So $$$b = [1, 4, 2, 9, 7]$$$. All values in this array are distinct, so the matrix is diverse. The magnitude is equal to $$$9$$$.For a given $$$r$$$ and $$$c$$$, find a diverse matrix that minimises the magnitude. If there are multiple solutions, you may output any of them. If there are no solutions, output a single integer $$$0$$$.

The only line in the input contains two space separated integers $$$r$$$ and $$$c$$$ ($$$1 \leq r,c \leq 500$$$) — the number of rows and the number of columns of the matrix to be found.

If there is no solution, output a single integer $$$0$$$. Otherwise, output $$$r$$$ rows. The $$$i$$$-th of them should contain $$$c$$$ space-separated integers, the $$$j$$$-th of which is $$$a_{i,j}$$$ — the positive integer in the $$$i$$$-th row and $$$j$$$-th column of a diverse matrix minimizing the magnitude. Furthermore, it must hold that $$$1 \leq a_{i,j} \leq 10^9$$$. It can be shown that if a solution exists, there is also a solution with this additional constraint (still having minimum possible magnitude).

NoteIn the first example, the GCDs of rows are $$$b_1 = 4$$$ and $$$b_2 = 1$$$, and the GCDs of columns are $$$b_3 = 2$$$ and $$$b_4 = 3$$$. All GCDs are pairwise distinct and the maximum of them is $$$4$$$. Since the GCDs have to be distinct and at least $$$1$$$, it is clear that there are no diverse matrices of size $$$2 \times 2$$$ with magnitude smaller than $$$4$$$.In the second example, no matter what $$$a_{1,1}$$$ is, $$$b_1 = b_2$$$ will always hold, so there are no diverse matrices.

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

main = do
  line <- getLine
  let [r, c] = map read $ words line; b = r?c
  putStrLn $ unlines $ (unwords.map show) <$> b

1?1 = [[0]]
c?1 = transpose $ 1?c
r?c = [(m *) <$> [2..c + 1] | m <- 1:[c + 2..r + c]]


Polycarp often uses his smartphone. He has already installed $$$n$$$ applications on it. Application with number $$$i$$$ takes up $$$a_i$$$ units of memory.Polycarp wants to free at least $$$m$$$ units of memory (by removing some applications).Of course, some applications are more important to Polycarp than others. He came up with the following scoring system — he assigned an integer $$$b_i$$$ to each application:   $$$b_i = 1$$$ — regular application;  $$$b_i = 2$$$ — important application. According to this rating system, his phone has $$$b_1 + b_2 + \ldots + b_n$$$ convenience points.Polycarp believes that if he removes applications with numbers $$$i_1, i_2, \ldots, i_k$$$, then he will free $$$a_{i_1} + a_{i_2} + \ldots + a_{i_k}$$$ units of memory and lose $$$b_{i_1} + b_{i_2} + \ldots + b_{i_k}$$$ convenience points.For example, if $$$n=5$$$, $$$m=7$$$, $$$a=[5, 3, 2, 1, 4]$$$, $$$b=[2, 1, 1, 2, 1]$$$, then Polycarp can uninstall the following application sets (not all options are listed below):   applications with numbers $$$1, 4$$$ and $$$5$$$. In this case, it will free $$$a_1+a_4+a_5=10$$$ units of memory and lose $$$b_1+b_4+b_5=5$$$ convenience points;  applications with numbers $$$1$$$ and $$$3$$$. In this case, it will free $$$a_1+a_3=7$$$ units of memory and lose $$$b_1+b_3=3$$$ convenience points.  applications with numbers $$$2$$$ and $$$5$$$. In this case, it will free $$$a_2+a_5=7$$$ memory units and lose $$$b_2+b_5=2$$$ convenience points. Help Polycarp, choose a set of applications, such that if removing them will free at least $$$m$$$ units of memory and lose the minimum number of convenience points, or indicate that such a set does not exist.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le m \le 10^9$$$) — the number of applications on Polycarp's phone and the number of memory units to be freed. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the number of memory units used by applications. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le 2$$$) — the convenience points of each application. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output on a separate line:    -1, if there is no set of applications, removing which will free at least $$$m$$$ units of memory;  the minimum number of convenience points that Polycarp will lose if such a set exists.

NoteIn the first test case, it is optimal to remove applications with numbers $$$2$$$ and $$$5$$$, freeing $$$7$$$ units of memory. $$$b_2+b_5=2$$$.In the second test case, by removing the only application, Polycarp will be able to clear only $$$2$$$ of memory units out of the $$$3$$$ needed.In the third test case, it is optimal to remove applications with numbers $$$1$$$, $$$2$$$, $$$3$$$ and $$$4$$$, freeing $$$10$$$ units of memory. $$$b_1+b_2+b_3+b_4=6$$$.In the fourth test case, it is optimal to remove applications with numbers $$$1$$$, $$$3$$$ and $$$4$$$, freeing $$$12$$$ units of memory. $$$b_1+b_3+b_4=4$$$.In the fifth test case, it is optimal to remove applications with numbers $$$1$$$ and $$$2$$$, freeing $$$5$$$ units of memory. $$$b_1+b_2=3$$$.

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.Array.Unboxed
import Data.Int
import Data.List

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

pSums :: [Int] -> UArray Int Int64
pSums li = listArray (0, length li) . scanl (+) 0 $ map fromIntegral li

opts :: UArray Int Int64 -> UArray Int Int64 -> Int64 -> [(Int, Int)]
opts a1 a2 m = let
  [n1, n2] = snd . bounds <$> [a1, a2]
  start = [(n1, j) | j <- indices a2, a1 ! n1 + a2 ! j >= m]
  step i j
    | i < 0 || j > n2  = []
    | a1 ! i + a2 ! j < m = step i (j+1)
    | otherwise = (i, j) : step (i-1) j
  in  case  start  of
  [] -> []
  (i, j) : _ -> step i j

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, m] <- readInts
    a <- readInts
    b <- readInts
    let
      a1 = pSums . reverse $ sort [ai | (ai, bi) <- zip a b, bi == 1]
      a2 = pSums . reverse $ sort [ai | (ai, bi) <- zip a b, bi == 2]
    outLine . P.pack . show $ case  opts a1 a2 (fromIntegral m)  of
      [] -> -1
      ok -> minimum [i + 2*j | (i, j) <- ok]


Little Petya learns how to write. The teacher gave pupils the task to write the letter A on the sheet of paper. It is required to check whether Petya really had written the letter A.You are given three segments on the plane. They form the letter A if the following conditions hold:  Two segments have common endpoint (lets call these segments first and second), while the third segment connects two points on the different segments.  The angle between the first and the second segments is greater than 0 and do not exceed 90 degrees.  The third segment divides each of the first two segments in proportion not less than 1 / 4 (i.e. the ratio of the length of the shortest part to the length of the longest part is not less than 1 / 4).

The first line contains one integer t (1 ≤ t ≤ 10000) — the number of test cases to solve. Each case consists of three lines. Each of these three lines contains four space-separated integers — coordinates of the endpoints of one of the segments. All coordinates do not exceed 108 by absolute value. All segments have positive length.

Output one line for each test case. Print «YES» (without quotes), if the segments form the letter A and «NO» otherwise.

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Debug.Trace

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

intersect :: Segment -> Segment -> Maybe (Ratio Scalar, Ratio Scalar)
intersect (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
  in mayts

cond3 :: Segment -> Segment -> Bool
cond3 s1 s2 =
  case intersect s1 s2 of
    Nothing    -> False
    Just (t,_) -> middlin' t

joins :: Segment -> Segment -> Bool
joins s1 s2 =
  case intersect s1 s2 of
    Nothing    -> False
    Just (t,s) -> (s == 0 || s == 1) && middlin' t

parallel :: Point -> Point -> Bool
parallel (P x1 y1) (P x2 y2) = x1*y2 == x2*y1

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && not (parallel v1 v2)
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | joins s1 s3 && joins s2 s3 = True
 -- | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main = do
  n <- getLine --> read
  let _ = n :: Int
  forM_ [1..n] $ \i -> do
    [s1,s2,s3] <- replicateM 3 readSegment
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && notParallel
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2
        notParallel = len2 v1 * len2 v2 > dot*dot

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  replicateM_ n $ do
    [s1,s2,s3] <- replicateM 3 readSegment
    print [s1,s2,s3]
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && notParallel
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2
        notParallel = len2 v1 * len2 v2 > dot*dot

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  replicateM_ n $ do
    [s1,s2,s3] <- replicateM 3 readSegment
    if n > 9000 then print [s1,s2,s3] else return ()
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Debug.Trace

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

parallel :: Point -> Point -> Bool
parallel (P x1 y1) (P x2 y2) = x1*y2 == x2*y1

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && not (parallel v1 v2)
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  let _ = n :: Int
  replicateM_ n $ do
    [s1,s2,s3] <- replicateM 3 readSegment
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

s1 = S (P 1489606 78929109) (P (-347076) 76240991)
s2 = S (P 1489606 78929109) (P 309706 76646901)
s3 = S (P 604681 77217453) (P 571265 77585050)
S p1 p2 = s1
S q1 q2 = s2
d1 = p2 .-. p1
d2 = q2 .-. p1

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && notParallel
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2
        notParallel = len2 v1 * len2 v2 > dot*dot

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  let _ = n :: Int
  forM_ [1..n] $ \i -> do
    [s1,s2,s3] <- replicateM 3 readSegment
    if n > 9000 && i >= 18 then print [s1,s2,s3] else return ()
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Debug.Trace

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

parallel :: Point -> Point -> Bool
parallel (P x1 y1) (P x2 y2) = x1*y2 == x2*y1

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && not (parallel v1 v2)
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  let _ = n :: Int
  forM_ [1..n] $ \i -> do
    [s1,s2,s3] <- replicateM 3 readSegment
    if n > 9000
      then if i >= 18 then do print s1; print s2; print s3
                      else return ()
      else
        if solve s1 s2 s3
          then putStrLn "YES"
          else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

s1 = S (P 1489606 78929109) (P (-347076) 76240991)
s2 = S (P 1489606 78929109) (P 309706 76646901)
s3 = S (P 604681 77217453) (P 571265 77585050)
S p1 p2 = s1
S q1 q2 = s2
d1 = p2 .-. p1
d2 = q2 .-. p1

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && notParallel
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2
        notParallel = len2 v1 * len2 v2 > dot*dot

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  let _ = n :: Int
  forM_ [1..n] $ \i -> do
    [s1,s2,s3] <- replicateM 3 readSegment
    if n > 9000
      then if i >= 18 then do print s1; print s2; print s3
                      else return ()
      else
        if solve s1 s2 s3
          then putStrLn "YES"
          else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && notParallel
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2
        notParallel = len2 v1 * len2 v2 > dot*dot

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  replicateM_ n $ do
    [s1,s2,s3] <- replicateM 3 readSegment
    if solve s1 s2 s3
      then putStrLn "YES"
      else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'

import Data.Ratio
import Control.Monad (replicateM_,replicateM,forM_,liftM3)
import Text.Printf (printf)
import Data.Int (Int64)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Debug.Trace

type Scalar = Int64

data Point =  P Scalar Scalar
  deriving (Show,Eq)
data Segment = S Point Point
  deriving (Show,Eq)

swap :: Segment -> Segment
swap (S a b) = (S b a)

(.-.) :: Point -> Point -> Point
(.-.) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)

(.*.) :: Point -> Point -> Scalar
(.*.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

len2 :: Point -> Scalar
len2 p = p .*. p

solve22 :: Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Scalar -> Maybe (Ratio Scalar,Ratio Scalar)
solve22 a b c d e f
  | det /= 0 = Just $ ( x % det, y % det )
  | otherwise = Nothing
  where
    a /. b = fromIntegral a / fromIntegral b
    det = a*d - b*c
    x   = e*d - f*b
    y   = a*f - c*e

middlin' :: (Ord a, Num a) => a -> Bool
middlin' x = 1 <= 5*x  && 5*x <= 4

cond3 :: Segment -> Segment -> Bool
cond3 (S p1 p2) (S r1 r2) =
  let P dx dy   = r1 .-. p1
      P dx1 dy1 = p2 .-. p1
      P dx2 dy2 = r1 .-. r2
      mayts     = solve22 dx1 dx2 dy1 dy2 dx dy
   in case mayts of
        Nothing    -> False
        Just (t,_) -> middlin' t

parallel :: Point -> Point -> Bool
parallel (P x1 y1) (P x2 y2) = x1*y2 == x2*y1

apex :: Point -> Point -> Point -> Bool
apex p q r = dot >= 0 && not (parallel v1 v2)
  where v1 = q .-. p
        v2 = r .-. p
        dot = v1 .*. v2

apex' :: Segment -> Segment -> Bool
apex' (S p1 p2) (S _ q2) = apex p1 p2 q2

isLetterA :: Segment -> Segment -> Segment -> Bool
isLetterA s1@(S p1 p2) s2@(S q1 q2) s3@(S r1 r2)
 | p1 /= q1            = False
 | not $ apex p1 p2 q2 = False
 | cond3 s1 s3 && cond3 s2 s3 = True
 | otherwise           = False

isLetterA' :: (Segment,Segment,Segment) -> Bool
isLetterA' (s1,s2,s3) = isLetterA s1 s2 s3

solve :: Segment -> Segment -> Segment -> Bool
solve s1 s2 s3 = any isLetterA' choices
  where choices = choose s1 s2 s3 ++ choose s1 s3 s2 ++ choose s2 s3 s1
        choose t1 t2 t3 = [ (t1,t2,t3), (t1',t2,t3), (t1,t2',t3), (t1',t2',t3) ]
          where t1' = swap t1
                t2' = swap t2

readSegment :: IO Segment
readSegment = do
  -- (x1:y1:x2:y2:_) <- getLine --> words --> map read
  line <- BS.getLine
  let Just (x1, r1) = BS.readInt line
      Just (y1, r2) = BS.readInt (BS.dropWhile isSpace r1)
      Just (x2, r3) = BS.readInt (BS.dropWhile isSpace r2)
      Just (y2, _)  = BS.readInt (BS.dropWhile isSpace r3)
  let p1 = P (fromIntegral x1) (fromIntegral y1)
  let p2 = P (fromIntegral x2) (fromIntegral y2)
  return $ S p1 p2

(-->) = flip fmap

main' = do
  n <- getLine --> read
  let _ = n :: Int
  forM_ [1..n] $ \i -> do
    [s1,s2,s3] <- replicateM 3 readSegment
    if n > 9000
      then if i >= 7 then do print s1; print s2; print s3
                     else return ()
      else
        if solve s1 s2 s3
          then putStrLn "YES"
          else putStrLn "NO"

printSegment :: Segment -> IO ()
printSegment (S (P x y) (P u v)) = putStrLn $ printf "%d %d %d %d" x y u v

s1 = S (P 1489606 78929109) (P (-347076) 76240991)
s2 = S (P 1489606 78929109) (P 309706 76646901)
s3 = S (P 604681 77217453) (P 571265 77585050)
S p1 p2 = s1
S q1 q2 = s2
d1 = p2 .-. p1
d2 = q2 .-. p1

gen = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 4 1) (P 5 2)
      s3 = S (P 4 0) (P 4 4)
      s1' = swap s1
      s2' = swap s2
      s3' = swap s3
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
      triples = liftM3 (,,) [s1,s1'] [s2,s2'] [s3,s3']
  forM_ triples foo

gen1 = do
  let s1 = S (P 4 4) (P 6 0)
      s2 = S (P 6 0) (P 5 2)
      s3 = S (P 5 2) (P 4 4)
      foo (a,b,c) = printSegment a >> printSegment b >> printSegment b
  putStrLn "10000"
  replicateM_ 10000 $ foo (s1,s2,s3)

main = main'