A tourist hiked along the mountain range. The hike lasted for n days, during each day the tourist noted height above the sea level. On the i-th day height was equal to some integer hi. The tourist pick smooth enough route for his hike, meaning that the between any two consecutive days height changes by at most 1, i.e. for all i's from 1 to n - 1 the inequality |hi - hi + 1| ≤ 1 holds.At the end of the route the tourist rafted down a mountain river and some notes in the journal were washed away. Moreover, the numbers in the notes could have been distorted. Now the tourist wonders what could be the maximum height during his hike. Help him restore the maximum possible value of the maximum height throughout the hike or determine that the notes were so much distorted that they do not represent any possible height values that meet limits |hi - hi + 1| ≤ 1.

The first line contains two space-separated numbers, n and m (1 ≤ n ≤ 108, 1 ≤ m ≤ 105) — the number of days of the hike and the number of notes left in the journal. Next m lines contain two space-separated integers di and hdi (1 ≤ di ≤ n, 0 ≤ hdi ≤ 108) — the number of the day when the i-th note was made and height on the di-th day. It is guaranteed that the notes are given in the chronological order, i.e. for all i from 1 to m - 1 the following condition holds: di < di + 1.

If the notes aren't contradictory, print a single integer — the maximum possible height value throughout the whole route. If the notes do not correspond to any set of heights, print a single word 'IMPOSSIBLE' (without the quotes).

NoteFor the first sample, an example of a correct height sequence with a maximum of 2: (0, 0, 1, 2, 1, 1, 0, 1).In the second sample the inequality between h7 and h8 does not hold, thus the information is inconsistent.

import Control.Monad
import Data.List
isOk (i0,h0) (i1,h1) | h1 < h0 = isOk (i0,h1) (i1,h0)
                     | otherwise = (i1-i0) >= (h1-h0)
getMaxHeight (i0,h0) (i1,h1) | h1 < h0 = getMaxHeight (i0,h1) (i1,h0)
                             | h0 < h1 = getMaxHeight (i0+d,h0+d) (i1,h1)
                             | otherwise = h0 + (s `div` 2)
                             where d = h1-h0
                                   s = i1-i0

mapPair::(a -> a-> b)->[a] -> [b]
mapPair f (a0:ts) | null ts = []
                 | otherwise = ((f a0 a1):(mapPair f ts))
                          where a1 = head ts
getMax1Height (i0,h0) = h0+i0-1
getMaxNHeight n (i0,h0) = h0+(n-i0)
readInput 0 = return []
readInput m = do
  w0 <- getLine
  let w = words w0
  next <- readInput (m-1)
  let h = (read (w !! 0)::Int,read (w !! 1)::Int)
  return (h:next)
toTup a = ((w !! 0),(w !! 1))
  where w = [read n::Int| n <-(words a)]
main = do
  w <- getLine
  let w0 = words w
  let n = read (w0 !! 0)::Int
  let m = read (w0 !! 1)::Int
  contents <- getContents
  let s = lines contents
  let route = map toTup s
  if not $ all id $ mapPair isOk route
  then putStrLn "IMPOSSIBLE"
  else do
  print $ maximum $ (getMax1Height (head route)):(getMaxNHeight n (last route)):(mapPair getMaxHeight route)

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.Bits
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

getInts :: IO [Int]
getInts = map readInt . words <$> getLine

solve :: [(Integer, Integer)] -> Integer -> Maybe Integer
solve xs@((t, h):_) m = loop ((max `F.on` snd) first end) ([first] ++ xs ++ [end])
  where
    first = (1, t + h - 1)
    end = (m, m - t' + h')
    (t', h') = last xs

-- loop acc xs
--   | trace (show acc ++ " " ++ show (xs)) False = undefined
loop acc [(t1, h1), (t2, h2)] =
  if abs (h2 - h1) <= t2 - t1 then Just acc else Nothing
loop acc ((t1, h1):(xs@((t2, h2):_))) =
  if abs (h2 - h1) <= t2 - t1
  then loop (maximum [h1, h2, acc, fff t1 t2 h1 h2]) xs
  else Nothing

fff t1 t2 h1 h2 = (max h1 h2) + ((t2 - t1) - abs (h2 - h1)) `div` 2

main :: IO ()
main = do
  [n, m] <- map toInteger <$> getInts
  diary <- forM [1..m] $ \_ -> do
    [a, b] <- getInts
    return (toInteger a, toInteger b)
  putStrLn $ case solve (L.sort diary) n of
    Nothing -> "IMPOSSIBLE"
    Just x -> show x

isOk (i0,h0) (i1,h1) | h1 < h0 = isOk (i0,h1) (i1,h0)
                     | otherwise = (i1-i0) >= (h1-h0)
getMaxHeight (i0,h0) (i1,h1) | h1 < h0 = getMaxHeight (i0,h1) (i1,h0)
                             | h0 > h1 = getMaxHeight (i0+d,h0+d) (i1,h1)
                             | otherwise = h0 + (s `div` 2)
                             where d = h1-h0
                                   s = i1-i0
mapPair::(a -> a-> b)->[a] -> [b]
mapPair f a | (length a) == 1 = []
            | otherwise = ((f a0 a1):(mapPair f ta))
                          where a0 = head a
                                ta = tail a
                                a1 = head ta
getMax1Height (i0,h0) = h0+i0-1
getMaxNHeight n (i0,h0) = h0+(n-i0)
readInput 0 = return []
readInput m = do
  w0 <- getLine
  let w = words w0
  next <- readInput (m-1)
  let h = (read (w !! 0)::Int,read (w !! 1)::Int)
  return (h:next)
main = do
  w <- getLine
  let w0 = words w
  let n = read (w0 !! 0)::Int
  let m = read (w0 !! 1)::Int
  route <- readInput m
  if not $ all id $ mapPair isOk route
  then putStrLn "IMPOSSIBLE"
  else do
  print $ maximum $ (getMax1Height (head route)):(getMaxNHeight n (last route)):(mapPair getMaxHeight route)

isOk (i0,h0) (i1,h1) | h1 < h0 = isOk (i0,h1) (i1,h0)
                     | otherwise = (i1-i0) >= (h1-h0)
getMaxHeight (i0,h0) (i1,h1) | h1 < h0 = getMaxHeight (i0,h1) (i1,h0)
                             | h0 > h1 = getMaxHeight (i0+d,h0+d) (i1,h1)
                             | otherwise = h0 + (s `div` 2)
                             where d = h1-h0
                                   s = i1-i0
mapPair::(a -> a-> b)->[a] -> [b]
mapPair f a | (length a) == 1 = []
            | otherwise = ((f a0 a1):(mapPair f ta))
                          where a0 = head a
                                ta = tail a
                                a1 = head ta
getMax0Height (i0,h0) = h0+i0
getMaxNHeight n (i0,h0) = h0+(n-i0)
readInput 0 = return []
readInput m = do
  w0 <- getLine
  let w = words w0
  next <- readInput (m-1)
  let h = (read (w !! 0)::Int,read (w !! 1)::Int)
  return (h:next)
main = do
  w <- getLine
  let w0 = words w
  let n = read (w0 !! 0)::Int
  let m = read (w0 !! 1)::Int
  route <- readInput m
  if not $ all id $ mapPair isOk route
  then putStrLn "IMPOSSIBLE"
  else do
    print $ maximum $ (getMax0Height (head route)):(getMaxNHeight n (last route)):(mapPair getMaxHeight route)

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.Bits
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

getInts :: IO [Int]
getInts = map readInt . words <$> getLine

solve :: [(Integer, Integer)] -> Integer -> Maybe Integer
solve xs@((t, h):_) m = loop ((max `F.on` snd) first end) ([first] ++ xs ++ [end])
  where
    first = (0, t + h)
    end = (m - 1, m - 1 - t' + h')
    (t', h') = last xs

-- loop acc xs
--  | trace (show acc ++ " " ++ show (xs)) False = undefined
loop acc [(t1, h1), (t2, h2)] =
  if abs (h2 - h1) <= t2 - t1 then Just acc else Nothing
loop acc ((t1, h1):(xs@((t2, h2):_))) =
  if abs (h2 - h1) <= t2 - t1
  then loop (maximum [h1, h2, acc, fff t1 t2 h1 h2]) xs
  else Nothing

fff t1 t2 h1 h2 = (max h1 h2) + ((t2 - t1) - abs (h2 - h1)) `div` 2

main :: IO ()
main = do
  [n, m] <- map toInteger <$> getInts
  diary <- forM [1..m] $ \_ -> do
    [a, b] <- getInts
    return (toInteger a, toInteger b)
  putStrLn $ case solve (L.sort diary) n of
    Nothing -> "IMPOSSIBLE"
    Just x -> show x


Theofanis really likes sequences of positive integers, thus his teacher (Yeltsa Kcir) gave him a problem about a sequence that consists of only special numbers.Let's call a positive number special if it can be written as a sum of different non-negative powers of $$$n$$$. For example, for $$$n = 4$$$ number $$$17$$$ is special, because it can be written as $$$4^0 + 4^2 = 1 + 16 = 17$$$, but $$$9$$$ is not.Theofanis asks you to help him find the $$$k$$$-th special number if they are sorted in increasing order. Since this number may be too large, output it modulo $$$10^9+7$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first and only line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 10^9$$$; $$$1 \le k \le 10^9$$$).

For each test case, print one integer — the $$$k$$$-th special number in increasing order modulo $$$10^9+7$$$.

import Control.Monad

modp = 10^9 + 7

_bp :: Int -> Int -> Int -> Int -> Int
_bp a b p res
    | b == 0 = res
    | otherwise = _bp newa newb p newres
    where newa = a * a `mod` p
          newb = if even b then b `div` 2 else (b - 1) `div` 2
          newres = if even b then res else (res * a) `mod` p

bp :: Int -> Int -> Int
bp a b = _bp a b modp 1

cal :: Int -> Int -> Int -> Int -> Int
cal n k res cur
    | k == 0 = res
    | otherwise = cal n newk newres (cur + 1)
    where newk = if even k then k `div` 2 else (k - 1) `div` 2
          newres = if even k then res else (res + bp n cur) `mod` modp

solve :: IO ()
solve = do
    [n, k] <- map read.words <$> getLine :: IO [Int]
    print(cal n k 0 0)

main = do
    line <- getLine
    let tc = read line :: Int
    forM_ [1..tc] $ \_ -> do
        solve

import Control.Monad
_bp :: Int -> Int -> Int -> Int -> Int
_bp a b p res
    | b == 0 = res
    | otherwise = _bp newa newb p newres
    where newa = a * a `mod` p
          newb = if even b then b `div` 2 else (b - 1) `div` 2
          newres = if even b then res else (res * a) `mod` p

bp :: Int -> Int -> Int
bp a b = _bp a b 1000000007 1

cal :: Int -> Int -> Int -> Int -> Int
cal n k res cur
    | k == 0 = res
    | otherwise = cal n newk newres (cur + 1)
    where newk = if even k then k `div` 2 else (k - 1) `div` 2
          newres = if even k then res else (res + bp n cur) `mod` 1000000007

solve :: IO ()
solve = do
    [n, k] <- map read.words <$> getLine :: IO [Int]
    print(cal n k 0 0)

main = do
    line <- getLine
    let tc = read line :: Int
    forM_ [1..tc] $ \_ -> do
        solve

import Control.Monad
import Data.Int ( Int64 )
_bp :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
_bp a b p res
    | b == 0 = res
    | otherwise = _bp newa newb p newres
    where newa = a * a `mod` p
          newb = if even b then b `div` 2 else (b - 1) `div` 2
          newres = if even b then res else (res * a) `mod` p

bp :: Int64 -> Int64 -> Int64
bp a b = _bp a b 1000000007 1

cal :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
cal n k res cur
    | k == 0 = res
    | otherwise = cal n newk newres (cur + 1)
    where newk = if even k then k `div` 2 else (k - 1) `div` 2
          newres = if even k then res else (res + bp n cur) `mod` 1000000007

solve = do
    [n, k] <- map read.words <$> getLine :: IO [Int64]
    print(cal n k 0 0)

main = do
    line <- getLine
    let tc = read line :: Int64
    forM_ [1..tc] $ \_ -> do
        solve

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu -- Lazy.Builder deprecated
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import Data.Bits
import Data.List (unfoldr)
type St = StateT [B8.ByteString] Identity

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

data Input = Input {nk :: [Int]}
data Output = Output Int deriving Show

solve :: Input -> Output
solve (Input [n,k]) = let
  powers = 1 : map (mult n) powers
  ks = k : map (flip shiftR 1) ks
  lsbs = (`mod` 2) <$> ks
  prime = 1000000007
  long x = fromIntegral x :: Integer
  short x = fromIntegral x :: Int
  mult a b = short $ (long a * long b) `mod` (long prime)
  add a b = short $ (long a + long b) `mod` (long prime)
  in
    Output $ foldr1 add $ zipWith const (zipWith mult powers lsbs) (takeWhile (/=0) ks)

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n,k] <- getIntegrals 2
  return $ Input [n,k]

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output n) = dec n <> nl
  --go (Yes l xs) = mconcat $ (<>nl) <$> [str "Yes", dec l, (mconcat $ fmap ((<> sp).dec) xs)]

doTestcase :: StateT [B8.ByteString] Identity Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> StateT [B8.ByteString] Identity [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext `const` B8.putStrLn

implicit :: St [Int]
implicit = return [1]
explicit :: St [Int]
explicit = getIntegrals 1

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.List
import Data.Bits

modulo = 10 ^ 9 + 7

timer :: Int -> Int
timer 1 = 0
timer n = 1 + timer (n `div` 2)

bpow :: Int -> Int -> Int -> Int -> Int
bpow a b modu acc
  | b == 0 = acc
  | otherwise = bpow na nb modu nacc
  where na = a * a `mod` modu
        nb = b `div` 2
        nacc = if even b then acc else (acc * a) `mod` modu

fastPow :: Int -> Int -> Int -> Int
fastPow a b c = bpow a b c 1

process :: Int -> Int -> Int -> Int -> Int
process n k timer acc | k == 0 = acc | otherwise = process n nk (timer + 1) nacc
                      where nk = div k 2
                            nacc = if even k then acc else mod (acc + fastPow n timer modulo) modulo

solve = do
  a <- getLine
  let arr = words a
      n = read (head arr) :: Int
      k = read (last arr) :: Int
  print(process n k 0 0 )

main = do
  entry <- getLine
  let timer = read entry :: Int
  forM_ [1..timer] $ \_ -> do
    solve

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

bound :: Int64
bound = 1000000007

calc1 :: Int64->Int64->Int64->Int64->Int64
calc1 _ 0 _ acc = acc
calc1 n k p acc | k `mod` 2 == 1
  = calc1 n (k `div` 2) ((p*n) `mod` bound) ((p+acc) `mod` bound)
calc1 n k p acc
  = calc1 n (k `div` 2) ((p*n) `mod` bound) acc

calc :: Int64->Int64->Int64
calc n k =
  calc1 n k 1 0

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,k] = map read $ words line
    print $ calc n k

--
-- 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

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t (map read . words <$> getLine)  :: IO [[Integer]]

    (putStr . unlines . map solve) tcs

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

solve [n, k] = show $ fromBin n . toBin $ k
solve _      = error "bad TC"

toBin 0 = []
toBin n = (n `mod` 2) : toBin (n `div` 2)

fromBin n bits = (`mod` theMod) . sum . zipWith (*) bits $ (iterate (*n) 1)

theMod = 10^(9::Int) + 7

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import           Control.Arrow             ((>>>))
import           Control.Monad             as M (guard, liftM, liftM3,
                                                 replicateM, replicateM_, when, ap)
import qualified Control.Monad.ST          as ST
import qualified Control.Monad.Trans       as MS
import           Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Data.Array                as A (elems)
import qualified Data.Array.IArray         as IA
import qualified Data.Array.MArray         as MA
import qualified Data.Array.ST             as STA
import qualified Data.Array.Unboxed        as UA
import qualified Data.ByteString.Char8     as B8
import qualified Data.Foldable             as F
import           Data.Functor              ((<&>))
import           Data.Int                  (Int64)
import           Data.Ix                   (Ix (range))
import           Data.List                 (sort)
import           Data.Maybe                (fromJust, isJust)
import           Data.Ratio                (denominator, numerator)
import qualified Data.Traversable          as T
import           Data.Word                 (Word32)
import           Debug.Trace               as D
import           System.IO
import           Text.Printf               (printf)

readInt :: B8.ByteString -> Int
readInt = B8.readInt >>> fromJust >>> fst

readInt64 :: B8.ByteString -> Int64
readInt64 = B8.readInteger >>> fromJust >>> fst >>> fromInteger

updateArray :: (MA.MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
updateArray arr i func =
    MA.readArray arr i >>=
    MA.writeArray arr i <$> func

newtype Md109_7 a = Md109_7 a
    deriving (Functor, Show)

fromMd109_7 (Md109_7 a) = a

md109_7 :: (Num a) => a
md109_7 = fromInteger $ 10^9 + 7

instance (Num a, Ord a, Integral a) => Num (Md109_7 a) where
  (+) aa@(Md109_7 a) bb@(Md109_7 b)
    | a + b >= 2 * md109_7 = Md109_7 $ (a + b) `mod` md109_7
    | a + b >= md109_7     = Md109_7 $ a + b - md109_7
    | a + b < 0            = (-aa) + (-bb)
    | otherwise            = Md109_7 $ a + b

  (*) (Md109_7 a) (Md109_7 b)
    | a == 0 || b == 0 = Md109_7 0
    | otherwise        = Md109_7 $ a * b `mod` md109_7

  abs = id

  signum (Md109_7 a)
    | a > 0     = Md109_7 1
    | otherwise = Md109_7 0

  fromInteger x
    | x >= 2 * md109_7 = Md109_7 $ (fromInteger x :: a) `mod` md109_7
    | x >= md109_7     = Md109_7 $ (fromInteger x :: a) - md109_7
    | x < 0            = negate $ fromInteger (-x)
    | otherwise        = Md109_7 $ fromInteger x

  negate (Md109_7 a)
    | a > 0     = Md109_7 $ md109_7 - a
    | otherwise = Md109_7 0

binPower :: (Num a, Ord a, Integral a, Integral b) => Md109_7 a -> b -> Md109_7 a
binPower a b
    | b == 0    = fromInteger $ (1:: Integer)
    | even b    = let !v = binPower a (b `div` 2) in v * v
    | otherwise = a * binPower a (b - 1)

instance (Num a, Ord a, Integral a) => Fractional (Md109_7 a) where
  recip x = binPower x (md109_7 - 2)
  fromRational x = fromInteger (numerator x) * recip (fromInteger $ denominator x)

solve :: Int64 -> Int64 -> Int64
solve n k = fromMd109_7 $ solve' 32 k
    where
        nMd = Md109_7 n

        solve' :: Int64 -> Int64 -> Md109_7 Int64
        solve' index k
            | index == -1    = Md109_7 0
            | k >= 2 ^ index = (nMd `binPower` index) + solve' (index - 1) (k - 2 ^ index)
            | otherwise      = solve' (index - 1) k

main :: IO ()
main = do
    test <- B8.getLine <&> readInt
    replicateM_ test $ do
        [n, k] <- B8.getLine <&> B8.words <&> map readInt64
        let answer = solve n k
        printf "%lld\n" answer

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu -- Lazy.Builder deprecated
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import Data.Bits
import Data.List (unfoldr)
type St = StateT [B8.ByteString] Identity

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

data Input = Input {nk :: [Int]}
data Output = Output Int deriving Show

solve :: Input -> Output
solve (Input [n,k]) = let
  powers = 1 : map (mult n) powers
  ks = k : map (flip shiftR 1) ks
  lsbs = (`mod` 2) <$> ks
  prime = 1000000007 :: Int
  mult a b = (a*b) `mod` prime
  add a b = (a+b) `mod` prime
  in
    Output $ foldr1 add $ zipWith const (zipWith mult powers lsbs) (takeWhile (/=0) ks)

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n,k] <- getIntegrals 2
  return $ Input [n,k]

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output n) = dec n <> nl

doTestcase :: StateT [B8.ByteString] Identity Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> StateT [B8.ByteString] Identity [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext `const` B8.putStrLn

implicit :: St [Int]
implicit = return [1]
explicit :: St [Int]
explicit = getIntegrals 1

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu -- Lazy.Builder deprecated
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import Data.Bits
import Data.List (unfoldr)
type St = StateT [B8.ByteString] Identity

numberOfTestcases :: St [Int]
numberOfTestcases = implicit

data Input = Input {nk :: [Int]}
data Output = Output Int deriving Show

solve :: Input -> Output
solve (Input [n,k]) = let
  powers = 1 : map (mult n) powers
  ks = k : map (flip shiftR 1) ks
  lsbs = (`mod` 2) <$> ks
  prime = 1000000007 :: Int
  mult a b = (a*b) `mod` prime
  add a b = (a+b) `mod` prime
  in
    Output $ foldr1 add $ zipWith const (zipWith mult powers lsbs) (takeWhile (/=0) ks)

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n,k] <- getIntegrals 2
  return $ Input [n,k]

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output n) = dec n <> nl

doTestcase :: StateT [B8.ByteString] Identity Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> StateT [B8.ByteString] Identity [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext `const` B8.putStrLn

implicit :: St [Int]
implicit = return [1]
explicit :: St [Int]
explicit = getIntegrals 1

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.List
import Data.Bits

modulo = 10 ^ 9 + 7

timer :: Int -> Int
timer 1 = 0
timer n = 1 + timer (n `div` 2)

bpow :: Int -> Int -> Int -> Int -> Int
bpow a b modu acc
  | b == 0 = acc
  | otherwise = bpow na nb modu nacc
  where na = a * a `mod` modu
        nb = b `div` 2
        nacc = if even b then acc else (acc * a) `mod` modu

fastPow :: Int -> Int -> Int -> Int
fastPow a b c = bpow a b c 1

process :: Int -> Int -> Int
process n 0 = 0
process n k = (fastPow n (timer (k .&. (-k))) modulo) + process n (k - (k .&. (-k))) `mod` modulo

solve = do
  a <- getLine
  let arr = words a
      n = read (head arr) :: Int
      k = read (last arr) :: Int
  print(process n k)

main = do
  entry <- getLine
  let timer = read entry :: Int
  forM_ [1..timer] $ \_ -> do
    solve

import Control.Monad
import Data.List
import Data.Bits

modulo = 10 ^ 9 + 7

timer :: Int -> Int
timer 1 = 0
timer n = 1 + timer (n `div` 2)

fastPow :: Int -> Int -> Int -> Int
fastPow _ 0 _ = 1
fastPow base 1 modp = mod base modp
fastPow base pow modp | even pow = mod ((fastPow base (div pow 2) modp) ^ 2) modp
                   | odd  pow = mod ((fastPow base (div (pow-1) 2) modp) ^ 2 * base) modp

process :: Int -> Int -> Int
process n 0 = 0
process n k = mod ((fastPow n (timer (k .&. (-k))) modulo) + process n (k - (k .&. (-k)))) modulo

solve = do
  a <- getLine
  let arr = words a
      n = read (head arr) :: Int
      k = read (last arr) :: Int
  print(process n k)

main = do
  entry <- getLine
  let timer = read entry :: Int
  forM_ [1..timer] $ \_ -> do
    solve

import Control.Monad
import Data.List

bound = 1000000007

calc1 :: Int->Int->Int->Int->Int
calc1 _ 0 _ acc = acc
calc1 n k p acc | k `mod` 2 == 1
  = calc1 n (k `div` 2) ((p*n) `mod` bound) ((p+acc) `mod` bound)
calc1 n k p acc
  = calc1 n (k `div` 2) ((p*n) `mod` bound) acc

calc :: Int->Int->Int
calc n k =
  calc1 n k 1 0

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,k] = map read $ words line
    print $ calc n k


Spring has come, and the management of the AvtoBus bus fleet has given the order to replace winter tires with summer tires on all buses.You own a small bus service business and you have just received an order to replace $$$n$$$ tires. You know that the bus fleet owns two types of buses: with two axles (these buses have $$$4$$$ wheels) and with three axles (these buses have $$$6$$$ wheels).You don't know how many buses of which type the AvtoBus bus fleet owns, so you wonder how many buses the fleet might have. You have to determine the minimum and the maximum number of buses that can be in the fleet if you know that the total number of wheels for all buses is $$$n$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1\,000$$$) — the number of test cases. The following lines contain description of test cases. The only line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 10^{18}$$$) — the total number of wheels for all buses.

For each test case print the answer in a single line using the following format. Print two integers $$$x$$$ and $$$y$$$ ($$$1 \le x \le y$$$) — the minimum and the maximum possible number of buses that can be in the bus fleet. If there is no suitable number of buses for the given $$$n$$$, print the number $$$-1$$$ as the answer.

NoteIn the first test case the total number of wheels is $$$4$$$. It means that there is the only one bus with two axles in the bus fleet.In the second test case it's easy to show that there is no suitable number of buses with $$$7$$$ wheels in total.In the third test case the total number of wheels is $$$24$$$. The following options are possible:  Four buses with three axles.  Three buses with two axles and two buses with three axles.  Six buses with two axles. So the minimum number of buses is $$$4$$$ and the maximum number of buses is $$$6$$$.

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable (forM)

import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

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

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

solve :: Int64 -> Maybe (Int64, Int64)
solve x
    | (x < 4) || odd x  = Nothing
    | otherwise = Just ((n + 3 - 1) `div` 3, n `div` 2)
        where
            n = x `div` 2

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

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>=
        \n -> case numBuses n of
                Just (n1, n2) -> putStrLn (show n1 ++ " " ++ show n2)
                Nothing -> putStrLn "-1"
numBuses :: Int -> Maybe (Int, Int)
numBuses n | n `mod` 2 == 1 = Nothing
           | otherwise = case (numMin n, numMax n) of
                           (Just m1, Just m2) -> Just (m1, m2)
                           _ -> Nothing

numMax :: Int -> Maybe Int
numMax n | n `mod` 4 == 0 = Just $ n `div` 4
         | n == 2 = Nothing
         | n > 0 = Just $ (div n 4) -- one less 4 wheeler, one more 6 wheeler

numMin :: Int -> Maybe Int
numMin n | n `mod` 6 == 0 = Just $ div n 6
         | n `mod` 6 == 2 = Just $ 1 + div n 6 -- one less 6, two more 4
         | n `mod` 6 == 4 = Just $ 1 + div n 6 -- one more 4

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number
	return ()

solve :: Int -> Int -> IO ()
solve number 0 = return ()
solve number current = 	do
				line <- getLine
				let bruh = read line :: Integer
				let m = minim bruh
				let ma = maxim bruh
				if m == -1 then
					putStrLn "-1"
				else putStrLn $ (show m) ++ " " ++ (show ma)
				solve number (current - 1)

minim :: Integer -> Integer
minim n | (n < 4) || ((mod n 2) /= 0) = -1
		  | otherwise = let
							k = div n 6
							ost = mod n 6
							in if ost /= 0 then k + 1 else k

maxim :: Integer -> Integer
maxim n | (n < 4) || ((mod n 2) /= 0) = -1
		| otherwise = div n 4

import Control.Monad

routine :: IO ()
routine = do
  n <- read <$> getLine

  case solve n of
    Just (a,b) -> putStrLn $ show a ++ " "++ show b
    _ -> putStrLn "-1"

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

solve :: Integer -> Maybe (Integer, Integer)
solve n
  |n < 4 = Nothing
  |n `mod` 2 == 1 = Nothing
  |otherwise = Just ((n+5) `div` 6,n `div` 4)

import Control.Arrow ((>>>))

solve :: Integer -> String
solve n =
    if n == 2 || n `mod` 2 == 1
        then "-1"
        else
            show
                ( m `div` 3 + (if n `mod` 3 /= 0 then 1 else 0)
                )
                ++ " "
                ++ show (m `div` 2)
  where
    m = n `div` 2

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

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable (forM)

import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

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

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

solve :: Int64 -> Maybe (Int64, Int64)
solve x
    | (x < 4) || odd x  = Nothing
    | otherwise = Just ((n + 3 - 1) `div` 3, n `div` 2)
        where
            n = x `div` 2

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

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable (forM)

import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

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

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

solve :: Int64 -> Maybe (Int64, Int64)
solve x
    | (x < 4) || odd x  = Nothing
    | otherwise = Just ((n + 3 - 1) `div` 3, n `div` 2)
        where
            n = x `div` 2

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        x :: Int64 <- B8.getLine <&> readIntegerB8 <&> fromInteger
        let answer = solve x
        case answer of
            Just (minN, maxN) -> printf "%lld %lld\n" minN maxN
            Nothing -> puts "-1"

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable (forM)

import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

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

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

solve :: Int64 -> Maybe (Int64, Int64)
solve x
    | (x < 4) || odd x  = Nothing
    | otherwise = Just ((n + 3 - 1) `div` 3, n `div` 2)
        where
            n = x `div` 2

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        x :: Int64 <- B8.getLine <&> readIntegerB8 <&> fromInteger
        let answer = solve x
        case answer of
            Just (minN, maxN) -> printf "%lld %lld\n" minN maxN
            Nothing -> puts ""


A sequence of non-negative integers $$$a_1, a_2, \dots, a_n$$$ is called growing if for all $$$i$$$ from $$$1$$$ to $$$n - 1$$$ all ones (of binary representation) in $$$a_i$$$ are in the places of ones (of binary representation) in $$$a_{i + 1}$$$ (in other words, $$$a_i \:\&\: a_{i + 1} = a_i$$$, where $$$\&$$$ denotes bitwise AND). If $$$n = 1$$$ then the sequence is considered growing as well.For example, the following four sequences are growing:   $$$[2, 3, 15, 175]$$$ — in binary it's $$$[10_2, 11_2, 1111_2, 10101111_2]$$$;  $$$[5]$$$ — in binary it's $$$[101_2]$$$;  $$$[1, 3, 7, 15]$$$ — in binary it's $$$[1_2, 11_2, 111_2, 1111_2]$$$;  $$$[0, 0, 0]$$$ — in binary it's $$$[0_2, 0_2, 0_2]$$$. The following three sequences are non-growing:   $$$[3, 4, 5]$$$ — in binary it's $$$[11_2, 100_2, 101_2]$$$;  $$$[5, 4, 3]$$$ — in binary it's $$$[101_2, 100_2, 011_2]$$$;  $$$[1, 2, 4, 8]$$$ — in binary it's $$$[0001_2, 0010_2, 0100_2, 1000_2]$$$. Consider two sequences of non-negative integers $$$x_1, x_2, \dots, x_n$$$ and $$$y_1, y_2, \dots, y_n$$$. Let's call this pair of sequences co-growing if the sequence $$$x_1 \oplus y_1, x_2 \oplus y_2, \dots, x_n \oplus y_n$$$ is growing where $$$\oplus$$$ denotes bitwise XOR.You are given a sequence of integers $$$x_1, x_2, \dots, x_n$$$. Find the lexicographically minimal sequence $$$y_1, y_2, \dots, y_n$$$ such that sequences $$$x_i$$$ and $$$y_i$$$ are co-growing.The sequence $$$a_1, a_2, \dots, a_n$$$ is lexicographically smaller than the sequence $$$b_1, b_2, \dots, b_n$$$ if there exists $$$1 \le k \le n$$$ such that $$$a_i = b_i$$$ for any $$$1 \le i < k$$$ but $$$a_k < b_k$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — length of the sequence $$$x_i$$$. The second line contains $$$n$$$ integers $$$x_1, x_2, \dots, x_n$$$ ($$$0 \le x_i < 2^{30}$$$) — elements of the sequence $$$x_i$$$. It is guaranteed that the sum of $$$n$$$ overall all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print $$$n$$$ integers $$$y_1, y_2, \dots, y_n$$$ ($$$0 \le y_i < 2^{30}$$$) — lexicographically minimal sequence such that such that it's co-growing with given sequence $$$x_i$$$.

import Control.Monad (replicateM_)
import Data.Bits ((.&.), xor, complement)

solve :: [Int] -> [Int]
solve (x : xs) = map snd $ scanl next (x, 0) xs where
  next (xprev, yprev) x = let y = (xprev `xor` yprev) .&. complement x in (x, y)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    xs <- map read . words <$> getLine
    putStrLn $ unwords $ map show $ solve xs

import Control.Arrow ((>>>))
import Data.Bits ((.&.), xor)

dropCounts :: [a] -> [a]
dropCounts [] = []
dropCounts [_] = error "Odd number of elements!"
dropCounts (_:x:xs) =  x : dropCounts xs

parseInt :: String -> Int
parseInt = read

solve :: [Int] -> [Int]
solve = aux [0]
    where
        aux :: [Int] -> [Int] -> [Int]
        aux res [_] = reverse res
        aux res (x:xs) = let y = (x `xor` head xs) .&. x
            in aux (y : res) (head xs `xor` y : tail xs)

main :: IO ()
main = interact $ lines >>> tail >>> dropCounts >>> map (words >>> map parseInt >>> solve >>> map show >>> unwords) >>> unlines

module Main where

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

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

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

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    getLine
    a <- getIntList
    printList $ f a 0

f :: [Int] -> Int -> [Int]
f [x]      z = [z]
f (x:y:xs) z =
    let t = x `xor` z
        r = y `xor` (t .|. y)
    in z : f (y:xs) r

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)
import Data.Bits ((.&.), Bits (xor))

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 >>> chunksOf 2 >>>
    map (last >>> words >>> map read >>> solve >>> map show >>> unwords)
    >>> unlines

solve :: [Int] -> [Int]
solve = reverse . snd . foldl upd (0, [])
  where
    upd (x, ys) x' = let e = x - (x .&. x') in (x' `xor` e, e : ys)


In Aramic language words can only represent objects.Words in Aramic have special properties:   A word is a root if it does not contain the same letter more than once.  A root and all its permutations represent the same object.  The root $$$x$$$ of a word $$$y$$$ is the word that contains all letters that appear in $$$y$$$ in a way that each letter appears once. For example, the root of "aaaa", "aa", "aaa" is "a", the root of "aabb", "bab", "baabb", "ab" is "ab".  Any word in Aramic represents the same object as its root. You have an ancient script in Aramic. What is the number of different objects mentioned in the script?

The first line contains one integer $$$n$$$ ($$$1 \leq n \leq 10^3$$$) — the number of words in the script. The second line contains $$$n$$$ words $$$s_1, s_2, \ldots, s_n$$$ — the script itself. The length of each string does not exceed $$$10^3$$$. It is guaranteed that all characters of the strings are small latin letters.

Output one integer — the number of different objects mentioned in the given ancient Aramic script.

NoteIn the first test, there are two objects mentioned. The roots that represent them are "a","ab".In the second test, there is only one object, its root is "amer", the other strings are just permutations of "amer".

import Data.List

sg :: Ord a => [a] -> [[a]]
sg = group . sort

-- unique :: Ord a => [a] -> [a]
unique a = map head $ sg a

main :: IO ()
main = do
    sN <- getLine
    sC <- getLine
    let c = words sC
    let cc = map unique c
    let ccc = unique cc
    print $ length ccc

import Control.Applicative
import Data.List (sort, nub)

main = do
  _ <- getLine
  xs <- words <$> getLine :: IO [String]
  print $ length $ nub $ map (sort . nub) xs

import Data.List

main = getContents >>= print . solve . tail . words

solve = length . nub . map (map head . group . sort)


Vasiliy lives at point (a, b) of the coordinate plane. He is hurrying up to work so he wants to get out of his house as soon as possible. New app suggested n available Beru-taxi nearby. The i-th taxi is located at point (xi, yi) and moves with a speed vi. Consider that each of n drivers will move directly to Vasiliy and with a maximum possible speed. Compute the minimum time when Vasiliy will get in any of Beru-taxi cars.

The first line of the input contains two integers a and b ( - 100 ≤ a, b ≤ 100) — coordinates of Vasiliy's home. The second line contains a single integer n (1 ≤ n ≤ 1000) — the number of available Beru-taxi cars nearby.  The i-th of the following n lines contains three integers xi, yi and vi ( - 100 ≤ xi, yi ≤ 100, 1 ≤ vi ≤ 100) — the coordinates of the i-th car and its speed. It's allowed that several cars are located at the same point. Also, cars may be located at exactly the same point where Vasiliy lives.

Print a single real value — the minimum time Vasiliy needs to get in any of the Beru-taxi cars. You answer will be considered correct if its absolute or relative error does not exceed 10 - 6.  Namely: let's assume that your answer is a, and the answer of the jury is b. The checker program will consider your answer correct, if .

NoteIn the first sample, first taxi will get to Vasiliy in time 2, and second will do this in time 1, therefore 1 is the answer.In the second sample, cars 2 and 3 will arrive simultaneously.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
getInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	[ a, b ] :: [ Double ] <- map read . words <$> getLine
	n <- readInt
	[ xs, ys, vs ] :: [[ Double ]] <- transpose <$> ( replicateM n $ map read . words <$> getLine )
	printf "%.9f\n" $ minimum $ flip ( zipWith (/) ) vs $ zipWith ( \x y -> sqrt ( ( x - a ) ** 2 + ( y - b ) ** 2 ) ) xs ys

module Main where

import Control.Monad

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

readI :: IO [Int]
readI = readL
readD :: IO [Double]

readD = readL

main = do
    [a,b] <- readL
    [n] <- readL
    crds <- replicateM n readL
    putStrLn $ show $ minimum $ map (\[x,y,v] -> sqrt ((x-a)^2 + (y-b)^2) / v) crds

module Main where

import Control.Monad

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

main = do
    [a,b] <- readL :: IO [Double]
    [n] <- readL :: IO [Int]
    crds <- replicateM n (readL :: IO [Double])
    putStrLn $ show $ minimum $ map (\[x,y,v] -> sqrt ((x-a)^2 + (y-b)^2) / v) crds

import Control.Monad

main :: IO ()
main = do
  startText <- getLine
  let
    start = convert (readSplit startText) where
      convert :: [Int] -> (Int, Int)
      convert [a, b] = (a, b)
  nText <- getLine
  let n = read nText :: Int
  taxisText <- replicateM n getLine
  let
    taxis = map convert' (map readSplit taxisText) where
      convert' :: [Int] -> ( (Int, Int), Int )
      convert' [a, b, c] = ( (a, b), c )
    taxiStart = map fst taxis
    taxiSpeed = map snd taxis
  putStrLn (show (minTime start taxiStart taxiSpeed))

minTime :: (Int, Int) -> [(Int, Int)] -> [Int] -> Double
minTime _ [] [] = 0.0
minTime start (x:xs) (v:vs) = minTime' (time start x v) start xs vs where
  minTime' :: Double -> (Int, Int) -> [(Int, Int)] -> [Int] -> Double
  minTime' minT _ [] [] = minT
  minTime' minT start (x:xs) (v:vs)
    | curT < minT = minTime' curT start xs vs
    | otherwise   = minTime' minT start xs vs
    where curT = time start x v

time :: (Int, Int) -> (Int, Int) -> Int -> Double
time start taxi speed = (hypot start taxi) / (fromIntegral speed) where
  hypot :: (Int, Int) -> (Int, Int) -> Double
  hypot (x1, y1) (x2, y2) = sqrt (fromIntegral ((x1-x2)^2 + (y1-y2)^2))

readSplit :: String -> [Int]
readSplit text = map read (words text) :: [Int]

main = do
    [x,y] <- fmap ((map read) . words) getLine :: IO [Int]
    n <- readLn :: IO Int
    ls <- flip mapM [1..n] $ \i -> do
        [p,q,v] <- fmap ((map read) . words) getLine :: IO [Int]
        let dist = sqrt . fromIntegral $ (x-p)^2 + (y-q)^2 :: Float
            time = dist / (fromIntegral v)
        return time
    print . minimum $ ls

import Control.Monad (replicateM)

main = do
  [x, y] <- fmap (map read . words) getLine
  [n] <- fmap (map read . words) getLine
  ps <- replicateM n (fmap (map read . words) getLine) :: IO [[Int]]

  let
    f :: [Int] -> Double
    f [xx, yy, v] = (sqrt (fromIntegral ((xx-x)^2 + (yy-y)^2))) / fromIntegral (v)

  print $ minimum $ map f ps

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.readInteger x
someFunc::IO()
someFunc = forM [1..2]( \is ->map rIn.C.words <$>C.getLine)>>=(\[[a,b],[n]]->solve.([a,b]:)=<<forM [1..n] (\i->map rIn.C.words <$>C.getLine) )
solve ([a,b]:xs) = print $ minimum $ map (\ [x,y,v]->sqrt (fromIntegral ((x-a)^2 +(y-b)^2))/fromIntegral v) xs

import Control.Applicative

process a b x = minimum t
  where t = map (ti a b ) x
        ti a b [c,d,v] = (/(fromIntegral v)) $ sqrt $ fromIntegral $ (c-a)^2 + (d-b)^2

main::IO ()
main=do
  [a,b]<-  map read <$> words <$> getLine ::IO [Int]
  getLine
  x<- map (map read)<$> map words <$> lines <$> getContents ::IO [[Int]]
  print $ process a b x

import Control.Monad
main = do
  [a,b] <- map read . words <$> getLine
  n <- readLn
  ts <- replicateM n (map read . words <$> getLine)
  let d [x,y,v] = sqrt((a-x)^2 + (b-y)^2) / v
  print $ minimum $ map d ts

import Control.Applicative

timeTaken :: Int -> Int -> Int -> Double
timeTaken x y v = (sqrt . fromIntegral $ x*x + y*y) / (fromIntegral v)

main :: IO ()
main = do
    [a,b] <- map read . words <$> getLine
    n <- read <$> getLine
    vals <- mapM (\_ -> map read . words <$> getLine) [1..n]
    let xs = map (\[x,y,v] -> timeTaken (x-a) (y-b) v) vals
    putStrLn . show . minimum $ xs

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

main = do
  [a, b] <- map (read :: String -> Double) . words <$> getLine
  _ <- getLine
  ls <- map (map (read:: String -> Double) . words). lines <$> getContents
  printf "%.10f\n" $ minimum $ map (\[x, y, v] -> ((x - a)**2 + (y - b)**2)**0.5 / v) ls

module Main where
  import Data.List
  import Control.Monad
  import Data.Array

  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)

  data Coordinat = Coordinat { x :: Int, y :: Int } deriving (Show, Eq)
  data Taxi = Taxi { coordinat :: Coordinat, speed :: Int } deriving (Show, Eq)

  mkTaxi :: String -> Taxi
  mkTaxi s =
    let [xi, yi, vi] = map readInt $ words s
        in Taxi (Coordinat xi yi) vi

  mkCoordinat :: [Int] -> Coordinat
  mkCoordinat [x,y] = Coordinat x y

  distance :: Floating a => Coordinat -> Coordinat -> a
  distance (Coordinat p q) (Coordinat x y) =
    let dx = fromIntegral $ p - x
        dy = fromIntegral $ q - y
        in (sqrt $ dx * dx + dy * dy)

  timeToArrive :: Floating a => Coordinat -> Taxi -> a
  timeToArrive co1@(Coordinat _ _) (Taxi co2@(Coordinat _ _) v) = (distance co1 co2) / (fromIntegral v)

  main :: IO()
  main = do
    [x,y] <- getLine >>= return . (map readInt) . words
    n <- getLine >>= return . readInt
    taxis <- readMultilineInput n $ return . mkTaxi
    putStrLn $ show $ minimum $ map (timeToArrive (Coordinat x y)) taxis

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

type I = Double

main :: IO ()
main = do
  [a,b] <- map readi . words <$> getLine
  n <- read <$> getLine
  cs <- map (toTriple . map readi . words) <$> replicateM n getLine
  print $ solve a b cs

solve :: I -> I -> [(I,I,I)] -> I
solve a b cs = minimum $ map (time a b) cs where
  time a b (x,y,v) = sqrt ((abs (a-x))^2 + (abs (b-y))^2) / v

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

readi :: String -> I
readi = read

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

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

module Main where

import Control.Monad
import Prelude
import Text.Printf

type Car = (Double, Double, Double)

getTime:: Double -> Double -> Car -> Double
getTime x1 y1 (x2, y2, v) = len / v
    where dx = x1 - x2
          dy = y1 - y2
          len = sqrt (dx * dx + dy * dy)

solve :: Double -> Double -> [Car] -> Double
solve x y cars = minimum (map (getTime x y) cars)

main = do
    [x, y] <- liftM (map read . words) getLine
    n <- liftM read getLine
    cars <- replicateM n $ do
        [a, b, v] <- liftM (map read . words) getLine
        return (a, b, v)
    printf "%.10f\n" (solve x y cars)

dist :: (Int, Int) -> (Int, Int) -> Double
dist (a, b) (c, d) = sqrt. fromIntegral $ x^2 + y^2
  where x = a - c
        y = b - d

go :: Int -> (Int, Int) -> IO Double
go 0 v = return 1e18
go n v = do
  [c, d, s] <- getLine >>= return. map read. words :: IO [Int]
  next <- go (n - 1) v
  return. min (dist v (c, d) / fromIntegral s) $ next

main = do
  [a, b] <- getLine >>= return. map read. words :: IO [Int]
  n <- readLn :: IO Int
  (go n (a, b)) >>= print

import           Control.Monad

dist (x1,y1) (x2,y2) = sqrt $ (x1 - x2)^2 + (y1 - y2)^2

main :: IO ()
main = do
  [a, b] <- map (read :: String -> Double) . words <$> getLine
  n <- (read :: String -> Int) <$> getLine
  print =<< minimum . map ((\[x,y,v]-> dist (a,b) (x,y) / v) . map (read :: String -> Double) . words) <$> replicateM n getLine

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

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

process_case :: Int -> Int -> [(Int, Int, Int)] -> Double
process_case a b = minimum . map distance_to
  where
    distance_to :: (Int, Int, Int) -> Double
    distance_to (x, y, v) = (sqrt . fromIntegral $ ((x - a)^2 + (y - b)^2)) / (fromIntegral v)

process :: B.ByteString -> B.ByteString
process str =
  let (a:b:n:rest) = map btoi $ B.words str
      taxis        = triple n rest
      triple :: Int -> [Int] -> [(Int, Int, Int)]
      triple 0 _            = []
      triple n (a:b:c:rest) = (a,b,c):(triple (n-1) rest)
  in B.pack . show $ process_case a b taxis

main :: IO ()
main = B.interact process

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe
-- Meat
solve :: [Double] -> [[Double]] -> Double
solve [ox, oy] = minimum. (1000000000:) . fmap (dist ox oy)
solve _ = error "sucker"

dist :: Double -> Double -> [Double] -> Double
dist ox oy [ax,ay,v] = sqrt ((ax - ox)**2 + (ay - oy) ** 2) / v
dist _ _ _= error "sucker"

-- Shit
main :: IO ()
main = do
        (o:_:xs)  <- readShit
        printShit [[solve o xs]]

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

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

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

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

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

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

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

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

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents


Monocarp plays a computer game called "Goblins and Gnomes". In this game, he manages a large underground city of gnomes and defends it from hordes of goblins.The city consists of $$$n$$$ halls and $$$m$$$ one-directional tunnels connecting them. The structure of tunnels has the following property: if a goblin leaves any hall, he cannot return to that hall. The city will be attacked by $$$k$$$ waves of goblins; during the $$$i$$$-th wave, $$$i$$$ goblins attack the city. Monocarp's goal is to pass all $$$k$$$ waves.The $$$i$$$-th wave goes as follows: firstly, $$$i$$$ goblins appear in some halls of the city and pillage them; at most one goblin appears in each hall. Then, goblins start moving along the tunnels, pillaging all the halls in their path. Goblins are very greedy and cunning, so they choose their paths so that no two goblins pass through the same hall. Among all possible attack plans, they choose a plan which allows them to pillage the maximum number of halls. After goblins are done pillaging, they leave the city.If all halls are pillaged during the wave — Monocarp loses the game. Otherwise, the city is restored. If some hall is pillaged during a wave, goblins are still interested in pillaging it during the next waves.Before each wave, Monocarp can spend some time preparing to it. Monocarp doesn't have any strict time limits on his preparations (he decides when to call each wave by himself), but the longer he prepares for a wave, the fewer points he gets for passing it. If Monocarp prepares for the $$$i$$$-th wave for $$$t_i$$$ minutes, then he gets $$$\max(0, x_i - t_i \cdot y_i)$$$ points for passing it (obviously, if he doesn't lose in the process).While preparing for a wave, Monocarp can block tunnels. He can spend one minute to either block all tunnels leading from some hall or block all tunnels leading to some hall. If Monocarp blocks a tunnel while preparing for a wave, it stays blocked during the next waves as well.Help Monocarp to defend against all $$$k$$$ waves of goblins and get the maximum possible amount of points!

The first line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$2 \le n \le 50$$$; $$$0 \le m \le \frac{n(n - 1)}{2}$$$; $$$1 \le k \le n - 1$$$) — the number of halls in the city, the number of tunnels and the number of goblin waves, correspondely. Next $$$m$$$ lines describe tunnels. The $$$i$$$-th line contains two integers $$$u_i$$$ and $$$v_i$$$ ($$$1 \le u_i, v_i \le n$$$; $$$u_i \ne v_i$$$). It means that the tunnel goes from hall $$$u_i$$$ to hall $$$v_i$$$. The structure of tunnels has the following property: if a goblin leaves any hall, he cannot return to that hall. There is at most one tunnel between each pair of halls. Next $$$k$$$ lines describe the scoring system. The $$$i$$$-th line contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i \le 10^9$$$; $$$1 \le y_i \le 10^9$$$). If Monocarp prepares for the $$$i$$$-th wave for $$$t_i$$$ minutes, then he gets $$$\max(0, x_i - t_i \cdot y_i)$$$ points for passing it.

Print the optimal Monocarp's strategy in the following format: At first, print one integer $$$a$$$ ($$$k \le a \le 2n + k$$$) — the number of actions Monocarp will perform. Next, print actions themselves in the order Monocarp performs them. The $$$i$$$-th action is described by a single integer $$$b_i$$$ ($$$-n \le b_i \le n$$$) using the following format:   if $$$b_i > 0$$$ then Monocarp blocks all tunnels going out from the hall $$$b_i$$$;  if $$$b_i < 0$$$ then Monocarp blocks all tunnels going into the hall $$$|b_i|$$$;  if $$$b_i = 0$$$ then Monocarp calls the next goblin wave.  You can't repeat the same block action $$$b_i$$$ several times. Monocarp must survive all waves he calls (goblins shouldn't be able to pillage all halls). Monocarp should call exactly $$$k$$$ waves and earn the maximum possible number of points in total. If there are several optimal strategies — print any of them.

NoteIn the first example, Monocarp, firstly, block all tunnels going in hall $$$2$$$, secondly — all tunnels going in hall $$$3$$$, and after that calls all waves. He spent two minutes to prepare to wave $$$1$$$, so he gets $$$98$$$ points for it. He didn't prepare after that, that's why he gets maximum scores for each of next waves ($$$200$$$, $$$10$$$ and $$$100$$$). In total, Monocarp earns $$$408$$$ points.In the second example, Monocarp calls for the first wave immediately and gets $$$100$$$ points. Before the second wave he blocks all tunnels going in hall $$$3$$$. He spent one minute preparing to the wave, so he gets $$$195$$$ points. Monocarp didn't prepare for the third wave, so he gets $$$10$$$ points by surviving it. Before the fourth wave he blocks all tunnels going out from hall $$$1$$$. He spent one minute, so he gets $$$99$$$ points for the fourth wave. In total, Monocarp earns $$$404$$$ points.In the third example, it doesn't matter how many minutes Monocarp will spend before the wave, since he won't get any points for it. That's why he decides to block all tunnels in the city, spending $$$5$$$ minutes. He survived the wave though without getting any points.

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

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

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

runMm :: Graph -> (UArray Int Int, UArray Int Bool)
runMm g =
    runST $ do
        mt <- newArray (bounds g) (-1)
        forM_ (indices g) $ \i -> do
            vis <- newArray (bounds g) False
            go vis mt i
        vis <- newArray (bounds g) False
        mt' <- unsafeFreezeSTUArray mt
        let matched = Set.fromList (filter (>=0) (elems mt'))
        forM_ (indices g) $ \i -> do
            unless (Set.member i matched) $
                void (go vis mt i)
        vis' <- unsafeFreezeSTUArray vis
        return (mt', vis')
    where
        go :: STUArray s Int Bool -> STUArray s Int Int -> Int -> ST s Bool
        go vis mt x = do
            visx <- readArray vis x
            if visx then
                return False
            else do
                writeArray vis x True
                trav (g ! x)
            where
                trav [] = return False
                trav (y:ys) = do
                    v <- readArray mt y
                    if v < 0 then win
                    else do
                        can <- go vis mt v
                        if can then win
                        else
                            trav ys
                    where
                        win = do
                            writeArray mt y x
                            return True

getMvc :: Graph -> [Int]
getMvc g =
    let (mt, vis) = runMm g
    in
        [i | (i, t) <- assocs vis, not t] ++ [-i | (i, t) <- assocs mt, t >= 0 && vis ! t]

solve :: [Int] -> [(Int64, Int64)] -> Int -> Int -> [Int]
solve os vs' n k = runST $ do
    mem <- newArray ((0,0), (k+1,mm+1)) (-1)
    c <- newArray ((0,0), (k+1,mm+1)) (-1)
    r <- f mem c 0 mm
    cc <- unsafeFreezeSTUArray c
    return $ build cc 0 mm os
    where
        mm = length os
        vs = listArray (0, k-1) vs' :: Array Int (Int64,Int64)
        f :: STUArray s (Int, Int) Int64 -> STUArray s (Int, Int) Int -> Int -> Int -> ST s Int64
        f mem c i j = do
            rr <- readArray mem (i,j)
            if rr >= 0 then
                return rr
            else do
                if i == k then
                    writeArray mem (i,j) 0
                else do
                    let (x,y) = vs ! i
                    writeArray mem (i,j) (1 `shift` 60)
                    forM_ [0..j] $ \t -> do
                        when (j-t <= n-2-i) $ do
                            rcost <- f mem c (i+1) (j-t)
                            let cost = rcost + ((y * fromIntegral t) `min` x)
                            curcost <- readArray mem (i,j)
                            when (cost < curcost) $ do
                                writeArray mem (i,j) cost
                                writeArray c (i,j) t
                readArray mem (i,j)
        build :: UArray (Int, Int) Int -> Int -> Int -> [Int] -> [Int]
        build c i j os
            | i == k = []
            | otherwise =
                let t = c ! (i,j) in
                    take t os ++ [0] ++ build c (i+1) (j-t) (drop t os)

main = do
    [n, m, k] <- map parseInt . BS.words <$> BS.getLine
    es <- replicateM m $ do
        [x, y] <- map parseInt . BS.words <$> BS.getLine
        return (x, y)
    vs <- replicateM k $ do
        [x, y] <- map (fromIntegral . parseInt) . BS.words <$> BS.getLine
        return (x, y)
    let g = buildG (1,n) es
        mvc = getMvc g
        r = solve mvc vs n k
    print $ length r
    putStrLn $ unwords (map show r)

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

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

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

runMm :: Graph -> (UArray Int Int, UArray Int Bool)
runMm g =
    runST $ do
        mt <- newArray (bounds g) (-1)
        forM_ (indices g) $ \i -> do
            vis <- newArray (bounds g) False
            go vis mt i
        vis <- newArray (bounds g) False
        mt' <- unsafeFreezeSTUArray mt
        let matched = Set.fromList (filter (>=0) (elems mt'))
        forM_ (indices g) $ \i -> do
            unless (Set.member i matched) $
                void (go vis mt i)
        vis' <- unsafeFreezeSTUArray vis
        return (mt', vis')
    where
        go :: STUArray s Int Bool -> STUArray s Int Int -> Int -> ST s Bool
        go vis mt x = do
            visx <- readArray vis x
            if visx then
                return False
            else do
                writeArray vis x True
                trav (g ! x)
            where
                trav [] = return False
                trav (y:ys) = do
                    v <- readArray mt y
                    if v < 0 then win
                    else do
                        can <- go vis mt v
                        if can then win
                        else
                            trav ys
                    where
                        win = do
                            writeArray mt y x
                            return True

getMvc :: Graph -> [Int]
getMvc g =
    let (mt, vis) = runMm g
    in
        [i | (i, t) <- assocs vis, not t] ++ [-i | (i, t) <- assocs mt, t >= 0 && vis ! t]

solve :: [Int] -> [(Int64, Int64)] -> Int -> Int -> [Int]
solve os vs' n k = runST $ do
    mem <- newArray ((0,0), (k+1,mm+1)) (-1)
    c <- newArray ((0,0), (k+1,mm+1)) (-1)
    r <- f mem c 0 mm
    build c 0 mm os
    where
        mm = length os
        vs = listArray (0, k-1) vs' :: Array Int (Int64,Int64)
        f :: STUArray s (Int, Int) Int64 -> STUArray s (Int, Int) Int -> Int -> Int -> ST s Int64
        f mem c i j = do
            rr <- readArray mem (i,j)
            if rr >= 0 then
                return rr
            else do
                if i == k then
                    writeArray mem (i,j) 0
                else do
                    let (x,y) = vs ! i
                    writeArray mem (i,j) (1 `shift` 60)
                    forM_ [0..j] $ \t -> do
                        when (j-t <= n-2-i) $ do
                            rcost <- f mem c (i+1) (j-t)
                            let cost = rcost + ((y * fromIntegral t) `min` x)
                            curcost <- readArray mem (i,j)
                            when (cost < curcost) $ do
                                writeArray mem (i,j) cost
                                writeArray c (i,j) t
                readArray mem (i,j)
        build :: STUArray s (Int, Int) Int -> Int -> Int -> [Int] -> ST s [Int]
        build c i j os
            | i == k = return []
            | otherwise = do
                t <- readArray c (i, j)
                rr <- build c (i+1) (j-t) (drop t os)
                return $ take t os ++ [0] ++ rr

main = do
    [n, m, k] <- map parseInt . BS.words <$> BS.getLine
    es <- replicateM m $ do
        [x, y] <- map parseInt . BS.words <$> BS.getLine
        return (x, y)
    vs <- replicateM k $ do
        [x, y] <- map (fromIntegral . parseInt) . BS.words <$> BS.getLine
        return (x, y)
    let g = buildG (1,n) es
        mvc = getMvc g
        r = solve mvc vs n k
    print $ length r
    putStrLn $ unwords (map show r)

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Int
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

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

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

runMm :: Graph -> (UArray Int Int, UArray Int Bool)
runMm g =
    runST $ do
        mt <- newArray (bounds g) (-1)
        forM_ (indices g) $ \i -> do
            vis <- newArray (bounds g) False
            go vis mt i
        vis <- newArray (bounds g) False
        mt' <- unsafeFreezeSTUArray mt
        let matched = Set.fromList (filter (>=0) (elems mt'))
        forM_ (indices g) $ \i -> do
            unless (Set.member i matched) $
                void (go vis mt i)
        vis' <- unsafeFreezeSTUArray vis
        return (mt', vis')
    where
        go :: STUArray s Int Bool -> STUArray s Int Int -> Int -> ST s Bool
        go vis mt x = do
            visx <- readArray vis x
            if visx then
                return False
            else do
                writeArray vis x True
                trav (g ! x)
            where
                trav [] = return False
                trav (y:ys) = do
                    v <- readArray mt y
                    if v < 0 then win
                    else do
                        can <- go vis mt v
                        if can then win
                        else
                            trav ys
                    where
                        win = do
                            writeArray mt y x
                            return True

getMvc :: Graph -> [Int]
getMvc g =
    let (mt, vis) = runMm g
    in
        [i | (i, t) <- assocs vis, not t] ++ [-i | (i, t) <- assocs mt, t >= 0 && vis ! t]

solve :: [Int] -> [(Int64, Int64)] -> Int -> [Int]
solve os vs' k = runST $ do
    mem <- newArray ((0,0), (k+1,mm+1)) (-1)
    c <- newArray ((0,0), (k+1,mm+1)) (-1)
    r <- f mem c 0 mm
    build c 0 mm os
    where
        mm = length os
        vs = listArray (0, k-1) vs' :: Array Int (Int64,Int64)
        f :: STUArray s (Int, Int) Int64 -> STUArray s (Int, Int) Int -> Int -> Int -> ST s Int64
        f mem c i j = do
            rr <- readArray mem (i,j)
            if rr >= 0 then
                return rr
            else do
                if i == k then
                    writeArray mem (i,j) 0
                else do
                    let (x,y) = vs ! i
                    writeArray mem (i,j) (1 `shift` 60)
                    forM_ [0..j] $ \t -> do
                        when (j-t <= k-1-i) $ do
                            rcost <- f mem c (i+1) (j-t)
                            let cost = rcost + ((y * fromIntegral t) `min` x)
                            curcost <- readArray mem (i,j)
                            when (cost < curcost) $ do
                                writeArray mem (i,j) cost
                                writeArray c (i,j) t
                readArray mem (i,j)
        build :: STUArray s (Int, Int) Int -> Int -> Int -> [Int] -> ST s [Int]
        build c i j os
            | i == k = return []
            | otherwise = do
                t <- readArray c (i, j)
                rr <- build c (i+1) (j-t) (drop t os)
                return $ take t os ++ [0] ++ rr

main = do
    [n, m, k] <- map parseInt . BS.words <$> BS.getLine
    es <- replicateM m $ do
        [x, y] <- map parseInt . BS.words <$> BS.getLine
        return (x, y)
    vs <- replicateM k $ do
        [x, y] <- map (fromIntegral . parseInt) . BS.words <$> BS.getLine
        return (x, y)
    let g = buildG (1,n) es
        mvc = getMvc g
        r = solve mvc vs k
    print $ length r
    putStrLn $ unwords (map show r)


You are given a set of $$$n$$$ segments on the axis $$$Ox$$$, each segment has integer endpoints between $$$1$$$ and $$$m$$$ inclusive. Segments may intersect, overlap or even coincide with each other. Each segment is characterized by two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le m$$$) — coordinates of the left and of the right endpoints. Consider all integer points between $$$1$$$ and $$$m$$$ inclusive. Your task is to print all such points that don't belong to any segment. The point $$$x$$$ belongs to the segment $$$[l; r]$$$ if and only if $$$l \le x \le r$$$.

The first line of the input contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 100$$$) — the number of segments and the upper bound for coordinates. The next $$$n$$$ lines contain two integers each $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le m$$$) — the endpoints of the $$$i$$$-th segment. Segments may intersect, overlap or even coincide with each other. Note, it is possible that $$$l_i=r_i$$$, i.e. a segment can degenerate to a point.

In the first line print one integer $$$k$$$ — the number of points that don't belong to any segment. In the second line print exactly $$$k$$$ integers in any order — the points that don't belong to any segment. All points you print should be distinct. If there are no such points at all, print a single integer $$$0$$$ in the first line and either leave the second line empty or do not print it at all.

NoteIn the first example the point $$$1$$$ belongs to the second segment, the point $$$2$$$ belongs to the first and the second segments and the point $$$5$$$ belongs to the third segment. The points $$$3$$$ and $$$4$$$ do not belong to any segment.In the second example all the points from $$$1$$$ to $$$7$$$ belong to the first segment.

main = interact foo

foo :: String -> String
foo inp =
    let (_:n:_):nn = map (map read . words) . lines $ inp :: [[Int]]
        ns = map (\u -> (u!!0, u!!1)) nn :: [(Int, Int)]
        out = filter (\ u -> not $ any (\(a, b) -> u `elem` [a..b]) ns) [1..n]
    in unlines [show . length $ out, unwords . map show $ out]

import Data.List

f ::String->(Int,Int)
f x=let (a:b:[])=map read (words x)::[Int]
    in (a,b)

g ::[(Int,Int)]->Int->Int
g [] p=p
g ((a,b):xs) p
   |a<=p && p<=b=(-1)
   |otherwise=g xs p

main=do
     e1<-getLine
     es<-getContents
     let xs=map f $ lines es
         (n:m:[])=map read (words e1)::[Int]
         ys=(-1):map (g xs) [1..m]
         ans=tail $ nub $ ys
     putStrLn $ if length(ans)==0 then "0" else (show(length(ans)))++"\n"++(unwords(map show ans))

{-# LANGUAGE ScopedTypeVariables #-}

import Prelude
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor
import Control.Monad.ST.Safe
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

solve :: Int -> [[Int]] -> ST s [Int]
solve m segments = do
    arr <- A.newArray (1, m) 0 :: ST s (A.STUArray s Int Int)
    forM_ segments $ \[l, r] -> do
        forM_ [l .. r] $ \i -> do
            A.writeArray arr i 1
    lst <- A.getElems arr
    return . map (+ 1) . findIndices (== 0) $ lst

main :: IO ()
main = do
    ([n, m] :: [Int]) <- (map read . words) <$> getLine
    (segments :: [[Int]]) <- replicateM n ((map read . words) <$> getLine)
    let answer = runST $ solve m segments
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "

import Data.List
import Control.Monad
main = do
  [n,m] <- map read . words <$> getLine
  ps <- ([1..m] \\) . concat <$> replicateM n getI
  print (length ps)
  putStrLn $ unwords $ map show ps
getI = do
  [a,b] <- map read . words <$> getLine
  return [a..b]

zipPairs          :: [Int] -> [(Int, Int)]
zipPairs []       = []
zipPairs (l:r:xs) = (l,r):(zipPairs xs)

solve            :: [Int] -> [Int]
solve (_:m:rest) = [x | x <- [1..m], not . elem x . concat . map list $ zipPairs rest]
    where list xs = [(fst xs)..(snd xs)]
          concat [] = []
          concat (a:as) = a ++ (concat as)

parseStr :: [Int] -> String
parseStr r = unlines [(show n),(seperates r)]
    where n = length r
          seperates []     = ""
          seperates (x:xs) = show x ++ " " ++ (seperates xs)

main = interact $ parseStr . solve . map read . words

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Set as S

process s = foldl (S.union) S.empty $ map (\[a,b]->S.fromList[a..b]) s

main= do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		s<- map(map read) <$> map words <$> replicateM n getLine ::IO [[Int]]
		let y = S.difference (S.fromList [1..m]) (process s)
		print $S.size y
		putStrLn $ intercalate " "$ map show  $ S.elems y

--ghc 7.10

import Data.List(sort)

outPoints :: Int -> [(Int,Int)] -> [Int]
outPoints m ss = concat . map (\(r,l) -> [r+1..l-1]) $ zip (0:rs') (ls'++[m+1])
    where
        (ls',rs') = unzip . f . sort $ ss
        f :: [(Int,Int)] -> [(Int,Int)]
        f [] = []
        f [x] = [x]
        f (x:xs@(y:ys))
            | snd x >= snd y = f (x:ys)
            | otherwise = x:(f xs)

readLine line = (l,r)
    where [l,r] = map read . words $ line

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    contents <- getContents
    let ss = map readLine . lines $ contents :: [(Int, Int)]
    let ps = outPoints m ss
    let k = length ps
    print k
    putStrLn . unwords . map show $ ps

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import System.IO
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: BS.ByteString -> [Int]
construct str
    | BS.null str = []
    | isSpace (BS8.head str) = construct (BS8.tail str)
    | otherwise = let Just (i, other) = BS8.readInt str in i : construct other

getInts :: IO [Int]
getInts = construct `fmap` BS.getLine

fastPrint :: Char -> [Int] -> IO ()
fastPrint mid arr = hPutBuilder stdout  $ build arr
    where build = foldr (\n b -> intDec n <> charUtf8 mid <> b) mempty

ok segs p = all (\[l,r] -> l > p || p > r) segs

main = do
    [n,m] <- getInts
    segs <- replicateM n getInts
    let pos = filter (ok segs) [1..m]
    print (length pos)
    putStrLn $ (intercalate " ") (map show pos)

main = interact foo

foo :: String -> String
foo inp =
    let (m:n:_):nn = map (map read . words) . lines $ inp :: [[Int]]
        ns = map (\u -> (u!!0, u!!1)) nn :: [(Int, Int)]
        out = filter (\ u -> not $ any (\(a, b) -> u `elem` [a..b]) ns) [m..n]
    in unlines [show . length $ out, unwords . map show $ out]

import Data.List

f ::String->(Int,Int)
f x=let (a:b:[])=map read (words x)::[Int]
    in (a,b)

g ::[(Int,Int)]->Int->Int
g [] p=p
g ((a,b):xs) p
   |a<=p && p<=b=(-1)
   |otherwise=g xs p

main=do
     e1<-getLine
     es<-getContents
     let xs=map f $ lines es
         (n:m:[])=map read (words e1)::[Int]
         ys=map (g xs) [1..m]
         ans=tail $ nub $ ys
     putStrLn $ if length(ans)==0 then "0" else (show(length(ans)))++"\n"++(unwords(map show ans))

--ghc 7.10

import Data.List(sort)

outPoints m ss = concat . map (\(r,l) -> [r+1..l-1]) $ zip (0:rs') (ls'++[m+1])
    where
        (ls',rs') = unzip . sort $ ss

readLine line = (l,r)
    where [l,r] = map read . words $ line

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    contents <- getContents
    let ss = map readLine . lines $ contents :: [(Int, Int)]
    let ps = outPoints m ss
    let k = length ps
    print k
    putStrLn . unwords . map show $ ps


A little boy Gerald entered a clothes shop and found out something very unpleasant: not all clothes turns out to match. For example, Gerald noticed that he looks rather ridiculous in a smoking suit and a baseball cap.Overall the shop sells n clothing items, and exactly m pairs of clothing items match. Each item has its price, represented by an integer number of rubles. Gerald wants to buy three clothing items so that they matched each other. Besides, he wants to spend as little money as possible. Find the least possible sum he can spend.

The first input file line contains integers n and m — the total number of clothing items in the shop and the total number of matching pairs of clothing items (). Next line contains n integers ai (1 ≤ ai ≤ 106) — the prices of the clothing items in rubles. Next m lines each contain a pair of space-separated integers ui and vi (1 ≤ ui, vi ≤ n, ui ≠ vi). Each such pair of numbers means that the ui-th and the vi-th clothing items match each other. It is guaranteed that in each pair ui and vi are distinct and all the unordered pairs (ui, vi) are different.

Print the only number — the least possible sum in rubles that Gerald will have to pay in the shop. If the shop has no three clothing items that would match each other, print "-1" (without the quotes).

NoteIn the first test there only are three pieces of clothing and they all match each other. Thus, there is only one way — to buy the 3 pieces of clothing; in this case he spends 6 roubles.The second test only has three pieces of clothing as well, yet Gerald can't buy them because the first piece of clothing does not match the third one. Thus, there are no three matching pieces of clothing. The answer is -1.In the third example there are 4 pieces of clothing, but Gerald can't buy any 3 of them simultaneously. The answer is -1.

module Main where

import Array
import Control.Monad
import Data.List

main = do
    inputNM <- getLine
    let [n, m] = map read $ words inputNM

    inputPrice <- getLine
    let price = array (1, n) $ zip [1..] $ map ( \w -> read w ) $ words inputPrice :: Array Int Int

    let initMatch = array ((1,1), (n, n)) [ ((x,y), 0) | x <- [1..n], y <- [1..n] ]

    matchList <- replicateM m $ do
        inputMatch <- getLine
        let [a, b] = map read $ words inputMatch :: [Int]
        return [ ((a, b), 1), ((b, a), 1) ]

    let match = initMatch // concat matchList
        best =
            foldl' ( \best i ->
                foldl' ( \best j ->
                    foldl' ( \best k ->
                        let best' = ( price ! i ) + ( price ! j ) + ( price ! k ) in
                        if best < best' then best else best'
                    ) best $ filter ( \k -> ( match ! (i,k) ) == 1 && ( match ! (j,k) ) == 1 ) [j+1..n]
                ) best $ filter ( \j -> ( match ! (i,j) ) == 1 ) [i+1..n-1]
            ) worst [1..n-2]

    putStrLn $ if best == worst then "-1" else show best

worst = 99999999

p[]= -1
p l=minimum l+3
s(_:i:w)=[i!!a+i!!b+i!!c|(a,l)<-zip[0..]$x$x$repeat[[]],[b,c]<-l]where n=length i-1;m=[[max k j|[k,j]<-w,min k j==i]|i<-[0..n]];x e=map(\i->[j:l|j<-m!!i,l<-e!!j,all(`elem`m!!i)l])[0..n]
main=interact$show.p.s.map(map(pred.read).words).lines

import Array (Array, (!), accumArray, bounds, listArray)
import List (sort)
import Maybe (fromMaybe, listToMaybe)
import Monad (liftM)

solve :: Array Int Int -> Array (Int, Int) Bool -> Maybe Int
solve costs graph  =  listToMaybe (sort solve')
  where
    n  =  snd $ bounds costs
    solve'  =  [costs ! i + costs ! j + costs ! k |
        i <- [1..n],
        j <- [i+1..n],
        k <- [j+1..n],
        and [graph ! (i,j), graph ! (i,k), graph ! (j,k)]]

readPair :: String -> (Int, Int)
readPair line  =  case (words line) of
  [a, b]  ->  (read a, read b)
  _  ->  error $ concat ["readPair: ", "string ", show line, " dos't two words"]

swap :: (a, b) -> (b, a)
swap (a, b)  =  (b, a)

main :: IO ()
main  =  do
    (n, m)  <-  liftM readPair getLine
    costs  <-  liftM (map read . words) getLine
    pairs  <-  liftM (map readPair . take m . lines) getContents
    let costs'  =  listArray (1, length costs) costs
    let graph'  =  accumArray (flip const) False ((1,1), (n,n)) (concatMap (\a -> [(a, True), (swap a, True)]) pairs)
    print $ fromMaybe (-1) $ solve costs' graph'

import Data.Array
import Control.Monad

readInts :: IO [Int]
readInts = (map read . words) `fmap` getLine

solve n a vu = if null l then -1 else minimum l
	where
		rng = ((1,1),(n,n))
		arr' = array rng [((i,j),0) | (i,j) <- range rng]
		arr = arr' // [((i,j),1) | [i,j] <- vu]
		cost = listArray (1,n) a
		l = [cost!i + cost!j + cost!k | i <- [1..n], j <- [i+1..n], arr!(i,j)==1, k <- [j+1..n], arr!(j,k)==1 && arr!(k,i)==1]

main = do
	[n,m] <- readInts
	a <- readInts
	l <- forM [1..m] (\_ -> readInts)
	let vu = l ++ map reverse l
	putStrLn . show $ solve n a vu

import Data.Array.IArray
import Control.Monad (mplus, guard)
import qualified Data.IntMap as M
import qualified Data.IntSet as S
import Data.Maybe (fromJust, isJust)
main = do
    [n, m] <- (map read . words) `fmap` getLine
    цены <- (listArray (1, n) . map read . words) `fmap` getLine :: IO (Array Int Int)
    пары <- mapM (\_ -> (map read . words) `fmap` getLine) [1..m]
    let совместимые = foldl (\совместимые [перваяОдёжка, втораяОдёжка] ->
            M.insertWith S.union перваяОдёжка (S.singleton втораяОдёжка) $
            M.insertWith S.union втораяОдёжка (S.singleton перваяОдёжка) совместимые) M.empty пары
        (минимальнаяЦена, _) = foldl (\(мц, совместимые) [перваяОдёжка, втораяОдёжка] ->
            let a = S.delete втораяОдёжка (совместимые M.! перваяОдёжка)
                b = S.delete перваяОдёжка (совместимые M.! втораяОдёжка)
                x = S.toList $ S.intersection a b
                s = цены ! перваяОдёжка + цены ! втораяОдёжка
                y = (map ((s+).(цены !)) x) `mplus` мц in
            (guard (y > []) >> return (minimum y), M.insert перваяОдёжка a $ M.insert втораяОдёжка b совместимые))
            ([], совместимые) пары
    print $ head $ минимальнаяЦена ++ [-1]

import Array

getIntPairs :: IO (Int,Int)
getIntPairs = do ns <- getLine
                 return (make_pair [(read n::Int)|n<-(words ns)])
                        where
                          make_pair (x:y:_) = (x,y)
                          make_pair _ = (0,0)

getInts :: IO [Int]
getInts = do ns <- getLine
             return [(read n::Int)|n<-(words ns)]

getPairLines :: Int -> IO [(Int,Int)]
getPairLines n = if n > 0 then
                     do l <- getIntPairs
                        ls <- getPairLines (n-1)
                        return (l:ls)
                 else
                     return []

putAnsLn :: (Show a) => a -> IO ()
putAnsLn ans = putStrLn (show ans)

include x [] = False
include x (l:ls) = if x==l then True else include x ls

mins m [] = m
mins m (x:xs) = if m>x then mins x xs else mins m xs

loop_find n ms = filter (\(j,k) -> include n (ms!k)&&n/=j&&n/=k ) [(j,k)|j<-(ms!n),k<-(ms!j)]

solve n m a uv = solve_rec 100000000 [1..n]
    where
      solve_rec ans [] = if ans==100000000 then -1 else ans
      solve_rec ans (i:is) = solve_rec (mins ans [prices!i + prices!j + prices!k|(j,k)<-loops]) is
          where
            loops = loop_find i matchings
            prices = array (1,n) (zip [1..n] a)
            matchings = make_matching (array (1,n) [(i,[])|i<-[1..n]]) uv
                where
                  make_matching ary [] = ary
                  make_matching ary ((u,v):uvs) = make_matching ((ary//[(u,v:(ary!u))])//[(v,u:(ary!v))]) uvs

main = do (n,m) <- getIntPairs
          a <- getInts
          uv <- getPairLines m
          putAnsLn (solve n m a uv)

import List
p[]= -1
p l=minimum l+3
x :: [[Int]] -> Int -> [[[Int]]] -> [[[Int]]]
x m n e=map(\i->[j:l|j<-m!!i,l<-e!!j,all(`elem`m!!i)l])[0..n-1]
r m n=[[j|[k,j]<-m,k==i]|i<-[0..n-1]]
s(_:i:m)=[i!!a+i!!b+i!!c|(a,l)<-zip[0..]$e$e$repeat[[]],[b,c]<-l]where e=r(map sort m)(length i)`x`length i
main=interact$show.p.s.map(map(pred.read).words).lines

import Array

getIntPairs :: IO (Int,Int)
getIntPairs = do ns <- getLine
                 return (make_pair [(read n::Int)|n<-(words ns)])
                        where
                          make_pair (x:y:_) = (x,y)
                          make_pair _ = (0,0)

getInts :: IO [Int]
getInts = do ns <- getLine
             return [(read n::Int)|n<-(words ns)]

getPairLines :: Int -> IO [(Int,Int)]
getPairLines n = if n > 0 then
                     do l <- getIntPairs
                        ls <- getPairLines (n-1)
                        return (l:ls)
                 else
                     return []

putAnsLn :: (Show a) => a -> IO ()
putAnsLn ans = putStrLn (show ans)

include x [] = False
include x (l:ls) = if x==l then True else include x ls

mins m [] = m
mins m (x:xs) = if m>x then mins x xs else mins m xs

loop_find n ms = filter (\(j,k) -> include n (ms!k) ) [(j,k)|j<-(ms!n),k<-(ms!j)]

solve n m a uv = solve_rec 10000000 [1..n]
    where
      solve_rec ans [] = if ans==10000000 then -1 else ans
      solve_rec ans (i:is) =if loops == [] then
                                solve_rec ans is
                            else
                                solve_rec (mins ans [prices!i + prices!j + prices!k|(j,k)<-loops]) is
                                    where
                                      loops = loop_find i matchings
                                      prices = array (1,n) (zip [1..n] a)
                                      matchings = make_matching (array (1,n) [(i,[])|i<-[1..n]]) uv
                                          where
                                            make_matching ary [] = ary
                                            make_matching ary ((u,v):uvs) = make_matching (ary//[(u,v:(ary!u))]) uvs

main = do (n,m) <- getIntPairs
          a <- getInts
          uv <- getPairLines m
          putAnsLn (solve n m a uv)

import List
p[]= -1
p l=minimum l+3
x m n e=map(\i->[j:l|[k,j]<-m,i==k,l<-e!!j])[0..n-1]
s(_:i:m)=[i!!a+i!!b+i!!c|(a,l)<-zip[0..]$e$e$repeat[[]],[b,c]<-l]where e=map sort m`x`length i
main=interact$show.p.s.map(map(pred.read).words).lines

p[]= -1
p l=minimum l+3
x m n e=map(\i->[j:l|[k,j]<-m,i==k,l<-e!!j])[0..n-1]
s(_:i:m)=[i!!a+i!!b+i!!c|(a,l)<-zip[0..]$e$e$repeat[[]],[b,c]<-l]where e=m`x`length i
main=interact$show.p.s.map(map(pred.read).words).lines


Lord Omkar would like to have a tree with $$$n$$$ nodes ($$$3 \le n \le 10^5$$$) and has asked his disciples to construct the tree. However, Lord Omkar has created $$$m$$$ ($$$\mathbf{1 \le m < n}$$$) restrictions to ensure that the tree will be as heavenly as possible. A tree with $$$n$$$ nodes is an connected undirected graph with $$$n$$$ nodes and $$$n-1$$$ edges. Note that for any two nodes, there is exactly one simple path between them, where a simple path is a path between two nodes that does not contain any node more than once.Here is an example of a tree:   A restriction consists of $$$3$$$ pairwise distinct integers, $$$a$$$, $$$b$$$, and $$$c$$$ ($$$1 \le a,b,c \le n$$$). It signifies that node $$$b$$$ cannot lie on the simple path between node $$$a$$$ and node $$$c$$$. Can you help Lord Omkar and become his most trusted disciple? You will need to find heavenly trees for multiple sets of restrictions. It can be shown that a heavenly tree will always exist for any set of restrictions under the given constraints.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 10^4$$$). Description of the test cases follows. The first line of each test case contains two integers, $$$n$$$ and $$$m$$$ ($$$3 \leq n \leq 10^5$$$, $$$\mathbf{1 \leq m < n}$$$), representing the size of the tree and the number of restrictions. The $$$i$$$-th of the next $$$m$$$ lines contains three integers $$$a_i$$$, $$$b_i$$$, $$$c_i$$$ ($$$1 \le a_i, b_i, c_i \le n$$$, $$$a$$$, $$$b$$$, $$$c$$$ are distinct), signifying that node $$$b_i$$$ cannot lie on the simple path between nodes $$$a_i$$$ and $$$c_i$$$.  It is guaranteed that the sum of $$$n$$$ across all test cases will not exceed $$$10^5$$$.

For each test case, output $$$n-1$$$ lines representing the $$$n-1$$$ edges in the tree. On each line, output two integers $$$u$$$ and $$$v$$$ ($$$1 \le u, v \le n$$$, $$$u \neq v$$$) signifying that there is an edge between nodes $$$u$$$ and $$$v$$$. Given edges have to form a tree that satisfies Omkar's restrictions.

NoteThe output of the first sample case corresponds to the following tree:    For the first restriction, the simple path between $$$1$$$ and $$$3$$$ is $$$1, 3$$$, which doesn't contain $$$2$$$. The simple path between $$$3$$$ and $$$5$$$ is $$$3, 5$$$, which doesn't contain $$$4$$$. The simple path between $$$5$$$ and $$$7$$$ is $$$5, 3, 1, 2, 7$$$, which doesn't contain $$$6$$$. The simple path between $$$6$$$ and $$$4$$$ is $$$6, 7, 2, 1, 3, 4$$$, which doesn't contain $$$5$$$. Thus, this tree meets all of the restrictions.The output of the second sample case corresponds to the following tree:

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 Control.Monad
import Data.Array.Unboxed

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    constrs <- replicateM m $ do
      ~[_ai, bi, _ci] <- getInts 3
      pure bi
    let
      avail :: UArray Int Bool
      avail = accumArray (\_ _ -> False) True (1, n) $ zip constrs $ repeat ()
      root = head [v | (v, True) <- assocs avail]
    pure $ mconcat $ [putInts [root, leaf] | leaf <- [1 .. n], leaf /= root]

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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