Many computer strategy games require building cities, recruiting army, conquering tribes, collecting resources. Sometimes it leads to interesting problems. Let's suppose that your task is to build a square city. The world map uses the Cartesian coordinates. The sides of the city should be parallel to coordinate axes. The map contains mines with valuable resources, located at some points with integer coordinates. The sizes of mines are relatively small, i.e. they can be treated as points. The city should be built in such a way that all the mines are inside or on the border of the city square. Building a city takes large amount of money depending on the size of the city, so you have to build the city with the minimum area. Given the positions of the mines find the minimum possible area of the city.

The first line of the input contains number n — the number of mines on the map (2 ≤ n ≤ 1000). Each of the next n lines contains a pair of integers xi and yi — the coordinates of the corresponding mine ( - 109 ≤ xi, yi ≤ 109). All points are pairwise distinct.

Print the minimum area of the city that can cover all the mines with valuable resources.

main = interact $ show . (\[a,b,c,d] -> let e = max (b-a) (d-c) in e*e) .f . map read . tail . words
f (a:b:[]) = [a,a,b,b]
f (a:b:c) = [min a p, max a q, min b r, max b s] where [p,q,r,s] = f c

import Control.Arrow ((&&&))
import Data.List (transpose)

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

solve :: [[Integer]] -> Integer
solve = (^(2::Integer)) . maximum . map (uncurry (-) . (maximum &&& minimum)) . transpose


You are given an undirected graph consisting of $$$n$$$ vertices and $$$m$$$ edges. Your task is to find the number of connected components which are cycles.Here are some definitions of graph theory.An undirected graph consists of two sets: set of nodes (called vertices) and set of edges. Each edge connects a pair of vertices. All edges are bidirectional (i.e. if a vertex $$$a$$$ is connected with a vertex $$$b$$$, a vertex $$$b$$$ is also connected with a vertex $$$a$$$). An edge can't connect vertex with itself, there is at most one edge between a pair of vertices.Two vertices $$$u$$$ and $$$v$$$ belong to the same connected component if and only if there is at least one path along edges connecting $$$u$$$ and $$$v$$$.A connected component is a cycle if and only if its vertices can be reordered in such a way that:  the first vertex is connected with the second vertex by an edge,  the second vertex is connected with the third vertex by an edge,  ...  the last vertex is connected with the first vertex by an edge,  all the described edges of a cycle are distinct. A cycle doesn't contain any other edges except described above. By definition any cycle contains three or more vertices.    There are $$$6$$$ connected components, $$$2$$$ of them are cycles: $$$[7, 10, 16]$$$ and $$$[5, 11, 9, 15]$$$.

The first line contains two integer numbers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$0 \le m \le 2 \cdot 10^5$$$) — number of vertices and edges. The following $$$m$$$ lines contains edges: edge $$$i$$$ is given as a pair of vertices $$$v_i$$$, $$$u_i$$$ ($$$1 \le v_i, u_i \le n$$$, $$$u_i \ne v_i$$$). There is no multiple edges in the given graph, i.e. for each pair ($$$v_i, u_i$$$) there no other pairs ($$$v_i, u_i$$$) and ($$$u_i, v_i$$$) in the list of edges.

Print one integer — the number of connected components which are also cycles.

NoteIn the first example only component $$$[3, 4, 5]$$$ is also a cycle.The illustration above corresponds to the second example.

import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Data.List

{-
import Debug.Trace
f $$ x = traceShow x (f x)
infixr 0 $$
-}

main = do
  input <- fmap B.lines B.getContents
  let [n,m] = map readI $ B.words $ head input
  let es = map ((\[x,y]->x`seq`y`seq`(x,y)) . map readI . B.words) $ tail input
  print (solve es)

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

solve :: [(Int,Int)] -> Int
solve es =
  length $ filter id $ unfoldr h edges
  where
    edges = M.filter ((==2).length) $ foldl g M.empty es

    g m (e,d) = M.alter (f d) e $ M.alter (f e) d m

    f d Nothing   = Just [d]
    f d (Just ds) = Just (d:ds)

    h m | M.null m = Nothing
        |otherwise = let (found,m') = findCycle m in Just (found,m')

findCycle :: M.Map Int [Int] -> (Bool, M.Map Int [Int])
findCycle edges =
  go start start next (M.delete start edges)
  where
    (start,next:_) = M.findMin edges

    go s t u m =
--        traceShow (s,t,u,m) $
        case fmap (filter (/=t)) (M.lookup u m) of
          Just [v] | v==s     -> (True, M.delete v (M.delete u m))
                   |otherwise -> go s u v (M.delete u m)
          _                   -> (False, M.delete u m)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST.Safe
import           Control.Monad.Trans.State.Strict
import           Data.Array.IArray
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8            as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict               as IM
import qualified Data.IntSet                      as IS
import           Data.List
import qualified Data.Map.Strict                  as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                         as S
import           Data.STRef
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n,m] <- map read.words <$> getLine
    edges <- concatMap(\(x,y) -> [(x-1,y-1),(y-1,x-1)]).unfoldr (runStateT parseInt2) <$> B.getContents
    print $ solve n m edges

solve :: Int -> Int -> [(Int, Int)] -> Int
solve n m edges = length[vs|vs<-scc gr, all (\v->length(gr!v) == 2) vs]
  where
    !gr = mkGraph (0,n-1) edges

-------------------------------------------------------------------------------
type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = Array Vertex [Vertex]
type Path = [Vertex]

mkGraph :: (Int, Int) -> [Edge] -> Graph
mkGraph bnd edges = accumArray (flip (:)) [] bnd edges

vertices :: Graph -> [Vertex]
vertices gr = range $ bounds gr

edges :: Graph -> [Edge]
edges gr = [(from, to) | from <- vertices gr, to <- (!) gr from ]

revGraph :: Graph -> Graph
revGraph gr = mkGraph (bounds gr) . map swap $ edges gr

dfsAll :: Graph -> [Vertex] -> [[Vertex]]
dfsAll gr vs = filter (not.null) $ runST $ do
  vis <- newArray (bounds gr) False :: ST s (STUArray s Vertex Bool)
  mapM (dfsM gr vis) vs

dfsM :: Graph -> STUArray s Vertex Bool -> Vertex -> ST s [Vertex]
dfsM gr vis root = do
  let go res (v:vs) = do
        visited <- readArray vis v
        if visited then go res vs
        else do
          writeArray vis v True
          go (v:res) ((!) gr v ++ vs)
      go res [] = return $ reverse res
  go [] [root]

topSort :: Graph -> [Vertex]
topSort gr = runST $ do
  vis   <- newArray (bounds gr) False :: ST s (STUArray s Vertex Bool)
  stack <- newSTRef []                :: ST s (STRef s [Vertex])
  let visit v = do
        visited <- readArray vis v
        unless visited $ do
          writeArray vis v True
          mapM_ visit $ (!) gr v
          modifySTRef stack (v:)
  mapM_ visit $ vertices gr
  readSTRef stack

scc :: Graph -> [[Vertex]]
scc gr = dfsAll gr . topSort $ revGraph gr

type Parser a = StateT B.ByteString Maybe a

parseInt :: Parser Int
parseInt = StateT $ B.readInt . B.dropWhile isSpace

parseInt2 :: Parser (Int, Int)
parseInt2 = (,) <$> parseInt <*> parseInt

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = (,,) <$> parseInt <*> parseInt <*> parseInt


Andrewid the Android is a galaxy-famous detective. He is now chasing a criminal hiding on the planet Oxa-5, the planet almost fully covered with water.The only dry land there is an archipelago of n narrow islands located in a row. For more comfort let's represent them as non-intersecting segments on a straight line: island i has coordinates [li, ri], besides, ri < li + 1 for 1 ≤ i ≤ n - 1.To reach the goal, Andrewid needs to place a bridge between each pair of adjacent islands. A bridge of length a can be placed between the i-th and the (i + 1)-th islads, if there are such coordinates of x and y, that li ≤ x ≤ ri, li + 1 ≤ y ≤ ri + 1 and y - x = a. The detective was supplied with m bridges, each bridge can be used at most once. Help him determine whether the bridges he got are enough to connect each pair of adjacent islands.

The first line contains integers n (2 ≤ n ≤ 2·105) and m (1 ≤ m ≤ 2·105) — the number of islands and bridges. Next n lines each contain two integers li and ri (1 ≤ li ≤ ri ≤ 1018) — the coordinates of the island endpoints. The last line contains m integer numbers a1, a2, ..., am (1 ≤ ai ≤ 1018) — the lengths of the bridges that Andrewid got.

If it is impossible to place a bridge between each pair of adjacent islands in the required manner, print on a single line "No" (without the quotes), otherwise print in the first line "Yes" (without the quotes), and in the second line print n - 1 numbers b1, b2, ..., bn - 1, which mean that between islands i and i + 1 there must be used a bridge number bi.  If there are multiple correct answers, print any of them. Note that in this problem it is necessary to print "Yes" and "No" in correct case.

NoteIn the first sample test you can, for example, place the second bridge between points 3 and 8, place the third bridge between points 7 and 10 and place the first bridge between points 10 and 14.In the second sample test the first bridge is too short and the second bridge is too long, so the solution doesn't exist.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.IO
import Data.Array.Base
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInteger :: B.ByteString -> Int64
readInteger = fromInteger . fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInteger.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) |
                ((l1,r1),(l2,r2),i) <- zip3 ps (tail ps) [0..] ]

    arr <- newArray_ (0,n-2) :: IO (IOUArray Int Int)
    let go [] _ = return True
        go ((b,a,i):qs') s = case S.lookupGT (a,0) s of
            Just (c,bi) | c <= b -> do
                unsafeWrite arr i bi
                go qs' (S.delete (c,bi) s)
            _ -> return False
    b <- go (sort qs) (S.fromList $ zip bs [1..])
    if b then do
        putStrLn "Yes"
        as <- getElems arr
        putStrLn $ unwords $ map show as
    else
        putStrLn "No"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.IO
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInteger = fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInteger.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) | ((l1,r1),(l2,r2),i) <- zip3 ps
                                                                 (tail ps)
                                                                 [1..] ]

    arr <- newArray_ (1,n-1) :: IO (IOUArray Int Int)
    let go [] _ = return True
        go ((b,a,i):qs') s =
            case S.lookupGT (a,0) s of
                Just (c,bi) | c <= b -> do
                    writeArray arr i bi
                    go qs' (S.delete (c,bi) s)
                _ -> return False
    b <- go (sort qs) (S.fromList $ zip bs [1..])
    if b then do
        putStrLn "Yes"
        as <- getElems arr
        putStrLn $ unwords $ map show as
    else
        putStrLn "No"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInteger = fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInteger.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) | ((l1,r1),(l2,r2),i) <- zip3 ps
                                                                 (tail ps)
                                                                 [1..] ]

    let go :: [(Integer,Integer,Int)] -> S.Set (Integer,Int) -> Maybe [(Int,Int)]
        go [] _ = Just []
        go ((b,a,i):qs') s =
            case S.lookupGT (a,0) s of
                Just (c,bi) | c <= b ->
                    ((i,bi):) <$> go qs' (S.delete (c,bi) s)
                _ -> Nothing
    let x = sort qs
    let y = S.fromList (zip bs [(1 :: Int)..])
    case go x y of
        Just l -> do
            putStrLn "Yes"
            putStrLn $ unwords $ [ show bi | (i,bi) <- sort l ]
        Nothing -> putStrLn "No"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInt.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) | ((l1,r1),(l2,r2),i) <- zip3 ps
                                                                 (tail ps)
                                                                 [1..] ]

    let go [] _ = Just []
        go (_:_) [] = Nothing
        go ((b,a,i):qs') ((c,bi):cs)
            | a <= c && c <= b = ((i,bi):) <$> go qs' cs
            | otherwise = go ((b,a,i):qs') cs
    let x = sort qs
    let y = sort (zip bs [1..])
    case go x y of
        Just l -> do
            putStrLn "Yes"
            putStrLn $ unwords $ [ show bi | (i,bi) <- sort l ]
        Nothing -> putStrLn "No"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInteger = fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInt.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) | ((l1,r1),(l2,r2),i) <- zip3 ps
                                                                 (tail ps)
                                                                 [1..] ]

    let go [] _ = Just []
        go ((b,a,i):qs') s =
            case S.lookupGT (a,0) s of
                Just (c,bi) | c <= b ->
                    ((i,bi):) <$> go qs' (S.delete (c,bi) s)
                _ -> Nothing
    let x = sort qs
    let y = S.fromList (zip bs [(1 :: Int)..])
    case go x y of
        Just l -> do
            putStrLn "Yes"
            putStrLn $ unwords $ [ show bi | (i,bi) <- sort l ]
        Nothing -> putStrLn "No"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInteger = fromJust . fmap fst . B.readInteger
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    (_ps,_bs) <- splitAt n . map (map readInteger.  B.words) . B.lines <$> B.getContents
    let ps = map l2p _ps
    let bs = head _bs
    let qs = [ (r2 - l1,l2 - r1,i) | ((l1,r1),(l2,r2),i) <- zip3 ps
                                                                 (tail ps)
                                                                 [1..] ]

    let go [] _ = Just []
        go (_:_) [] = Nothing
        go ((b,a,i):qs') ((c,bi):cs)
            | a <= c && c <= b = ((i,bi):) <$> go qs' cs
            | otherwise = go ((b,a,i):qs') cs
    let x = sort qs
    let y = sort (zip bs [1..])
    case go x y of
        Just l -> do
            putStrLn "Yes"
            putStrLn $ unwords $ [ show bi | (i,bi) <- sort l ]
        Nothing -> putStrLn "No"


Heidi has finally found the mythical Tree of Life – a legendary combinatorial structure which is said to contain a prophecy crucially needed to defeat the undead armies.On the surface, the Tree of Life is just a regular undirected tree well-known from computer science. This means that it is a collection of n points (called vertices), some of which are connected using n - 1 line segments (edges) so that each pair of vertices is connected by a path (a sequence of one or more edges).To decipher the prophecy, Heidi needs to perform a number of steps. The first is counting the number of lifelines in the tree – these are paths of length 2, i.e., consisting of two edges. Help her!

The first line of the input contains a single integer n – the number of vertices in the tree (1 ≤ n ≤ 10000). The vertices are labeled with the numbers from 1 to n. Then n - 1 lines follow, each describing one edge using two space-separated numbers a b – the labels of the vertices connected by the edge (1 ≤ a < b ≤ n). It is guaranteed that the input represents a tree.

Print one integer – the number of lifelines in the tree.

NoteIn the second sample, there are four lifelines: paths between vertices 1 and 3, 2 and 4, 2 and 5, and 4 and 5.

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Node = Int
type AdjList = M.Map Node [Node]

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

data Tree a = Tree {root :: a,
                    succs :: [Tree a]} deriving Show

edgeListToAdj :: Int -> [[Int]] ->  AdjList
edgeListToAdj n es = let adjList = M.fromList [(i, []) | i <- [1..n]] in
    foldl (\adj [x, y] -> ((M.adjust (x:) y) . (M.adjust (y:) x)) adj) adjList es

edgeListToTree :: Int -> [[Int]] -> Tree Int
edgeListToTree n es = constrTree 1 (S.fromList [1]) where
    adjList = edgeListToAdj n es
    constrTree i used = Tree {root = i,
                              succs = [constrTree j (S.insert j used) | j <- adjList M.! i, not (S.member j used)]}

numLifeLines :: Tree a -> Int
numLifeLines tree = let s = length (succs tree) in
    (s*(s-1) `div` 2) + length (concat [succs t | t <- succs tree]) + sum [numLifeLines t | t <- succs tree]

main = do
    [n] <- readNums
    connectors <- replicateM (n-1) readNums
    putStrLn $ show $ numLifeLines (edgeListToTree n connectors)


Consider the set of all nonnegative integers: $$${0, 1, 2, \dots}$$$. Given two integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^4$$$). We paint all the numbers in increasing number first we paint $$$0$$$, then we paint $$$1$$$, then $$$2$$$ and so on.Each number is painted white or black. We paint a number $$$i$$$ according to the following rules:    if $$$i = 0$$$, it is colored white;   if $$$i \ge a$$$ and $$$i - a$$$ is colored white, $$$i$$$ is also colored white;   if $$$i \ge b$$$ and $$$i - b$$$ is colored white, $$$i$$$ is also colored white;   if $$$i$$$ is still not colored white, it is colored black. In this way, each nonnegative integer gets one of two colors.For example, if $$$a=3$$$, $$$b=5$$$, then the colors of the numbers (in the order from $$$0$$$) are: white ($$$0$$$), black ($$$1$$$), black ($$$2$$$), white ($$$3$$$), black ($$$4$$$), white ($$$5$$$), white ($$$6$$$), black ($$$7$$$), white ($$$8$$$), white ($$$9$$$), ...Note that:    It is possible that there are infinitely many nonnegative integers colored black. For example, if $$$a = 10$$$ and $$$b = 10$$$, then only $$$0, 10, 20, 30$$$ and any other nonnegative integers that end in $$$0$$$ when written in base 10 are white. The other integers are colored black.   It is also possible that there are only finitely many nonnegative integers colored black. For example, when $$$a = 1$$$ and $$$b = 10$$$, then there is no nonnegative integer colored black at all. Your task is to determine whether or not the number of nonnegative integers colored black is infinite.If there are infinitely many nonnegative integers colored black, simply print a line containing "Infinite" (without the quotes). Otherwise, print "Finite" (without the quotes).

The first line of input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then $$$t$$$ lines follow, each line contains two space-separated integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^4$$$).

For each test case, print one line containing either "Infinite" or "Finite" (without the quotes). Output is case-insensitive (i.e. "infinite", "inFiNite" or "finiTE" are all valid answers).

import           Data.List
import           Numeric

(|>) = flip (.)

int :: String -> Int
int x = fst $ readDec x !! 0

ints :: String -> [Int]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = go t xs
    where
      t = int ts
      go 0 _      = []
      go t (x:xs) = solve (ints x) : go (t-1) xs

solve :: [Int] -> String
solve (a:b:_) =
  if gcd a b == 1
    then "Finite"
    else "Infinite"

main = interact $ unlines . map solve . tail . lines
solve x | [a, b] <- map read $ words x = if gcd a b == 1 then "Finite" else "Infinite"

import Control.Monad

rl = map read . words <$> getLine

main :: IO ()
main = do
  [t] <- rl
  replicateM_ t $ do
    [a, b] <- rl
    putStrLn $ if a == 1 || b == 1 || max a b `mod` min a b == 1 then "Finite" else "Infinite"


PizzaForces is Petya's favorite pizzeria. PizzaForces makes and sells pizzas of three sizes: small pizzas consist of $$$6$$$ slices, medium ones consist of $$$8$$$ slices, and large pizzas consist of $$$10$$$ slices each. Baking them takes $$$15$$$, $$$20$$$ and $$$25$$$ minutes, respectively.Petya's birthday is today, and $$$n$$$ of his friends will come, so he decided to make an order from his favorite pizzeria. Petya wants to order so much pizza that each of his friends gets at least one slice of pizza. The cooking time of the order is the total baking time of all the pizzas in the order.Your task is to determine the minimum number of minutes that is needed to make pizzas containing at least $$$n$$$ slices in total. For example:   if $$$12$$$ friends come to Petya's birthday, he has to order pizzas containing at least $$$12$$$ slices in total. He can order two small pizzas, containing exactly $$$12$$$ slices, and the time to bake them is $$$30$$$ minutes;  if $$$15$$$ friends come to Petya's birthday, he has to order pizzas containing at least $$$15$$$ slices in total. He can order a small pizza and a large pizza, containing $$$16$$$ slices, and the time to bake them is $$$40$$$ minutes;  if $$$300$$$ friends come to Petya's birthday, he has to order pizzas containing at least $$$300$$$ slices in total. He can order $$$15$$$ small pizzas, $$$10$$$ medium pizzas and $$$13$$$ large pizzas, in total they contain $$$15 \cdot 6 + 10 \cdot 8 + 13 \cdot 10 = 300$$$ slices, and the total time to bake them is $$$15 \cdot 15 + 10 \cdot 20 + 13 \cdot 25 = 750$$$ minutes;  if only one friend comes to Petya's birthday, he can order a small pizza, and the time to bake it is $$$15$$$ minutes.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Each testcase consists of a single line that contains a single integer $$$n$$$ ($$$1 \le n \le 10^{16}$$$) — the number of Petya's friends.

For each testcase, print one integer — the minimum number of minutes that is needed to bake pizzas containing at least $$$n$$$ slices in total.

import Control.Monad
import Data.Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int64
    let n' | n < 6     = 6
           | odd n     = n + 1
           | otherwise = n
    print $ n' * 5 `div` 2

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t solve

import Control.Monad
import Data.Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int64
    let n' | n < 6     = 6
           | odd n     = n + 1
           | otherwise = n
    print $ n' * 5 `div` 2

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t solve

{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = show . solve <$> integer

lim = 400
dp :: [Integer]
dp = 0 : do
  n <- [1..lim]
  let get m = dp !! max 0 m
  return $ minimum [15 + get (n - 6), 20 + get (n - 8), 25 + get (n - 10)]

solve :: Integer -> Integer
solve n
  | n < fi lim = dp !! fi n
  | otherwise = let q = (n - 200) `div` 120 in 12 * q * 25 + solve (n - q * 120)

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

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

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

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

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

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

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

import Control.Monad

printResult = do
    n <- readLn :: IO Integer
    print $ if n <= 6 then 15 else div ((n + mod n 2)*5) 2

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


Tree is a connected graph without cycles. A leaf of a tree is any vertex connected with exactly one other vertex.You are given a tree with n vertices and a root in the vertex 1. There is an ant in each leaf of the tree. In one second some ants can simultaneously go to the parent vertex from the vertex they were in. No two ants can be in the same vertex simultaneously except for the root of the tree.Find the minimal time required for all ants to be in the root of the tree. Note that at start the ants are only in the leaves of the tree.

The first line contains integer n (2 ≤ n ≤ 5·105) — the number of vertices in the tree. Each of the next n - 1 lines contains two integers xi, yi (1 ≤ xi, yi ≤ n) — the ends of the i-th edge. It is guaranteed that you are given the correct undirected tree.

Print the only integer t — the minimal time required for all ants to be in the root of the tree.

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (accumArray, (!))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.Tuple (swap)
import Data.List (sort)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  es <- replicateM (n-1) ((\[a, b] -> (a, b)) <$> readInts)

  let
    r = maximum $ map solve (g ! 1)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

        solve u = foldl1 (\a b -> max (a+1) b) $ sort $ dfs 0 1 [] u
          where
            dfs d w r u
              | null vs = d:r
              | otherwise = foldl (dfs (d+1) u) r vs
              where
                vs = filter (/= w) $ g ! u

  print $ r + 1

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (accumArray, (!))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Tuple (swap)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  es <- replicateM (n-1) ((\[a, b] -> (a, b)) <$> readInts)

  let
    r = maximum $ map solve (g ! 1)
      where
        g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

        solve = foldl1 (\a -> max (a+1)) . sort . dfs 0 1 []
          where
            dfs d w r u
              | null vs = d:r
              | otherwise = foldl (dfs (d+1) u) r vs
              where
                vs = filter (/= w) $ g ! u

  print $ r + 1


Polycarp is a great fan of television.He wrote down all the TV programs he is interested in for today. His list contains n shows, i-th of them starts at moment li and ends at moment ri.Polycarp owns two TVs. He can watch two different shows simultaneously with two TVs but he can only watch one show at any given moment on a single TV. If one show ends at the same moment some other show starts then you can't watch them on a single TV.Polycarp wants to check out all n shows. Are two TVs enough to do so?

The first line contains one integer n (1 ≤ n ≤ 2·105) — the number of shows. Each of the next n lines contains two integers li and ri (0 ≤ li < ri ≤ 109) — starting and ending time of i-th show.

If Polycarp is able to check out all the shows using only two TVs then print "YES" (without quotes). Otherwise, print "NO" (without quotes).

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy (\[x,_] [y,_] -> compare x y)) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

can lrs = f lrs (-1) (-1) where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | l > x && l <= y = f lrs r y
        | x < y = f lrs r y
        | otherwise = f lrs x r

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Function

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  ss <- replicateM n $ liftM2 (,) poi poi
  return $ if solve ss then "YES" else "NO"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = all (<= 2) . scanl1 (+) . map (sum . map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst) . concatMap (\(b, e) -> [(b, 1), (e + 1, -1)])

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

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, words, lines)
import qualified Data.Maybe as M (fromJust)
import Data.Function (on)
import Data.List (sortBy)

readInt = fst . M.fromJust . C.readInt
run _ _ [] = True
run i j ((xa, xb):xs) | xa <= i && xa <= j = False
    | xa <= i || (j > i && xa > j) = run i xb xs
    | otherwise = run xb j xs

main = do
    (readInt -> n) <- B.getLine
    (map ((\[a, b] -> (a, b)) . map readInt . C.words) . C.lines -> xs) <- B.getContents
    let xxs = sortBy (compare `on` snd) xs
    putStrLn $ if run (-1) (-1) xxs then "YES" else "NO"

-- 845B

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.Function (on)
import Data.List (sortBy)

main = getLine >> (B.interact $ program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines

program :: [[Int]] -> B.ByteString
program shows = runShows sortedShows []
    where sortedShows = sortBy (compare `on` fst) $ map (\[s,e] -> (s,e)) shows

runShows :: [(Int,Int)] -> [Int] -> B.ByteString
runShows [] _ = "YES\n"
runShows ((s,e):shows) tvs =
  let tvs' = e:(filter (>=s) tvs) in
  if length tvs' > 2
  then "NO\n"
  else runShows shows tvs'

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy comp) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

comp [l1,r1] [l2,r2] = case compare l1 l2 of
    EQ -> compare r1 r2
    x -> x

can lrs = f lrs 0 0 where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | l > x && l <= y = f lrs r y
        | x < y = f lrs r y
        | otherwise = f lrs x r

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy (\[_,x] [_,y] -> compare x y)) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

can lrs = f lrs 0 0 where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | otherwise = f lrs r y

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy (\[_,x] [_,y] -> compare x y)) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

can lrs = f lrs 0 0 where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | l > x && l <= y = f lrs r y
        | x < y = f lrs r y
        | otherwise = f lrs x r

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy comp) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

comp [l1,r1] [l2,r2] = case compare r1 r2 of
    EQ -> compare l1 l2
    x -> x

can lrs = f lrs 0 0 where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | l > x && l <= y = f lrs r y
        | x < y = f lrs r y
        | otherwise = f lrs x r

-- http://codeforces.com/contest/845/problem/C

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

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

main = do
    n <- getInt
    lrs <- (sortBy (\[x,_] [y,_] -> compare x y)) `fmap` replicateM n getInts
    if can lrs
    then putStrLn "YES"
    else putStrLn "NO"

can lrs = f lrs 0 0 where
    f [] _ _ = True
    f ([l,r]:lrs) x y
        | l <= x && l <= y = False
        | l <= x && l > y = f lrs x r
        | l > x && l <= y = f lrs r y
        | x < y = f lrs r y
        | otherwise = f lrs x r

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Function

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  ss <- replicateM n $ liftM2 (,) poi poi
  return $ if solve ss then "YES" else "NO"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = all (<= 2) . scanl1 (+) . map snd . sortBy (compare `on` fst) . concatMap (\(b, e) -> [(b, 1), (e + 1, -1)])

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Function

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  ss <- replicateM n $ liftM2 (,) poi poi
  return $ if solve ss then "YES" else "NO"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = all (<= 2) . scanl1 (+) . map snd . sortBy (compare `on` fst) . concatMap (\(b, e) -> [(b, 1), (e, -1)])


This problem is given in two versions that differ only by constraints. If you can solve this problem in large constraints, then you can just write a single solution to the both versions. If you find the problem too difficult in large constraints, you can write solution to the simplified version only.Waking up in the morning, Apollinaria decided to bake cookies. To bake one cookie, she needs n ingredients, and for each ingredient she knows the value ai — how many grams of this ingredient one needs to bake a cookie. To prepare one cookie Apollinaria needs to use all n ingredients.Apollinaria has bi gram of the i-th ingredient. Also she has k grams of a magic powder. Each gram of magic powder can be turned to exactly 1 gram of any of the n ingredients and can be used for baking cookies.Your task is to determine the maximum number of cookies, which Apollinaria is able to bake using the ingredients that she has and the magic powder.

The first line of the input contains two positive integers n and k (1 ≤ n, k ≤ 1000) — the number of ingredients and the number of grams of the magic powder. The second line contains the sequence a1, a2, ..., an (1 ≤ ai ≤ 1000), where the i-th number is equal to the number of grams of the i-th ingredient, needed to bake one cookie. The third line contains the sequence b1, b2, ..., bn (1 ≤ bi ≤ 1000), where the i-th number is equal to the number of grams of the i-th ingredient, which Apollinaria has.

Print the maximum number of cookies, which Apollinaria will be able to bake using the ingredients that she has and the magic powder.

NoteIn the first sample it is profitably for Apollinaria to make the existing 1 gram of her magic powder to ingredient with the index 2, then Apollinaria will be able to bake 4 cookies.In the second sample Apollinaria should turn 1 gram of magic powder to ingredient with the index 1 and 1 gram of magic powder to ingredient with the index 3. Then Apollinaria will be able to bake 3 cookies. The remaining 1 gram of the magic powder can be left, because it can't be used to increase the answer.

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: Int -> [Int] -> [Int] -> Int
solve m r s = c + solve' 0 m (bakeCookies c s)
  where c = minimum $ zipWith div s r
        bakeCookies :: Int -> [Int] -> [Int]
        bakeCookies cnt s' = zipWith (\req supply -> max 0 (supply - req * cnt)) r s'
        solve' :: Int -> Int -> [Int] -> Int
        solve' c' m' s' = if m' < sum (requiredMagic s')
          then c'
          else solve' (c' + 1) (m' - sum (requiredMagic s')) (bakeCookies 1 s')
        requiredMagic :: [Int] -> [Int]
        requiredMagic s' = zipWith (\req supply -> max 0 (req - supply)) r s'

main :: IO ()
main = do
  line1 <- getLine
  line2 <- getLine
  line3 <- getLine

  let [_,m] = map read (words line1) :: [Int]
      r = map read (words line2) :: [Int]
      s = map read (words line3) :: [Int]
  putStrLn $ show (solve m r s)


There are n schoolchildren, boys and girls, lined up in the school canteen in front of the bun stall. The buns aren't ready yet and the line is undergoing some changes.Each second all boys that stand right in front of girls, simultaneously swap places with the girls (so that the girls could go closer to the beginning of the line). In other words, if at some time the i-th position has a boy and the (i + 1)-th position has a girl, then in a second, the i-th position will have a girl and the (i + 1)-th one will have a boy.Let's take an example of a line of four people: a boy, a boy, a girl, a girl (from the beginning to the end of the line). Next second the line will look like that: a boy, a girl, a boy, a girl. Next second it will be a girl, a boy, a girl, a boy. Next second it will be a girl, a girl, a boy, a boy. The line won't change any more.Your task is: given the arrangement of the children in the line to determine the time needed to move all girls in front of boys (in the example above it takes 3 seconds). Baking buns takes a lot of time, so no one leaves the line until the line stops changing.

The first line contains a sequence of letters without spaces s1s2... sn (1 ≤ n ≤ 106), consisting of capital English letters M and F. If letter si equals M, that means that initially, the line had a boy on the i-th position. If letter si equals F, then initially the line had a girl on the i-th position.

Print a single integer — the number of seconds needed to move all the girls in the line in front of the boys. If the line has only boys or only girls, print 0.

NoteIn the first test case the sequence of changes looks as follows: MFM  →  FMM.The second test sample corresponds to the sample from the statement. The sequence of changes is: MMFF  →  MFMF  →  FMFM  →  FFMM.

solve :: [Char] -> Int
solve q =
  let
    in gao q
  where
    gao s
      | null s = 0
      | head s == 'M' = iter 0 0 0 s
      | otherwise = gao $ tail s
      where
        iter res num_f num_m rem
          | null rem = res
          | head rem == 'F' = iter (max (res + 1) num_m) (num_f + 1) num_m $ tail rem
          | otherwise = iter res num_f (num_m + 1) $ tail rem

main = do
  q <- getLine
  print $ solve q

solve :: [Char] -> Int
solve q = gao q
  where
    gao s
      | null s = 0
      | head s == 'M' = iter 0 0 0 s
      | otherwise = gao $ tail s
      where
        iter res num_f num_m rem
          | null rem = res
          | head rem == 'F' = iter (max (res + 1) num_m) (num_f + 1) num_m $ tail rem
          | otherwise = iter res num_f (num_m + 1) $ tail rem

main = do
  q <- getLine
  print $ solve q

solve :: [Char] -> Int
solve q =
  let
    s = reverse q
    in gao s
  where
    gao s
      | null s = 0
      | head s == 'F' = iter 0 0 $ tail s
      | otherwise = gao $ tail s
      where
        iter res nf rem
          | null rem = res
          | head rem == 'M' = let
            nr = if nf == 0 then res + 1 else (max res nf) + 1
            in iter nr 0 $ tail rem
          | otherwise = iter res (nf + 1) $ tail rem

main = do
  q <- getLine
  putStrLn $ show $ solve q


You are given integer $$$n$$$. You have to arrange numbers from $$$1$$$ to $$$2n$$$, using each of them exactly once, on the circle, so that the following condition would be satisfied:For every $$$n$$$ consecutive numbers on the circle write their sum on the blackboard. Then any two of written on the blackboard $$$2n$$$ numbers differ not more than by $$$1$$$.For example, choose $$$n = 3$$$. On the left you can see an example of a valid arrangement: $$$1 + 4 + 5 = 10$$$, $$$4 + 5 + 2 = 11$$$, $$$5 + 2 + 3 = 10$$$, $$$2 + 3 + 6 = 11$$$, $$$3 + 6 + 1 = 10$$$, $$$6 + 1 + 4 = 11$$$, any two numbers differ by at most $$$1$$$. On the right you can see an invalid arrangement: for example, $$$5 + 1 + 6 = 12$$$, and $$$3 + 2 + 4 = 9$$$, $$$9$$$ and $$$12$$$ differ more than by $$$1$$$.

The first and the only line contain one integer $$$n$$$ ($$$1 \le n \le 10^5$$$).

If there is no solution, output "NO" in the first line.  If there is a solution, output "YES" in the first line. In the second line output $$$2n$$$ numbers — numbers from $$$1$$$ to $$$2n$$$ in the order they will stay in the circle. Each number should appear only once. If there are several solutions, you can output any of them.

NoteExample from the statement is shown for the first example. It can be proved that there is no solution in the second example.

import Control.Monad
import Data.String
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Int]
parseLineToInt data_s = do
  (read::String->Int) <$> (words data_s)

countLetters :: [Char] -> Char -> Int
countLetters array_ char_ = length (filter (==char_) array_)

createLists :: Int -> ([Int], [Int])
createLists 0  = ([],[])
createLists n = let
                    (l, r) = createLists (n - 1)
                in ((2 * n) : r, (2 * n - 1) : l)

main = do
  sl <- getLine
  let n = read sl :: Int
  if mod n 2 == 0
     then putStrLn "NO"
     else do
         putStrLn "YES"
         let (l,r)  = createLists n
         putStrLn $ (unwords . map show) (l ++ r)

import Control.Monad
import Data.String
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Int]
parseLineToInt data_s = do
  (read::String->Int) <$> (words data_s)

countLetters :: [Char] -> Char -> Int
countLetters array_ char_ = length (filter (==char_) array_)

createLists :: Int -> ([Int], [Int])
createLists 0  = ([],[])
createLists n = let
                    (l, r) = createLists (n - 1)
                in ((2 * n) : r, (2 * n - 1) : l)

main = do
  sl <- getLine
  let n = read sl :: Int
  if mod n 2 == 0
     then putStrLn "No"
     else do
         putStrLn "Yes"
         let (l,r)  = createLists n
         putStrLn $ (unwords . map show) (l ++ r)


You are given four integers $$$n$$$, $$$B$$$, $$$x$$$ and $$$y$$$. You should build a sequence $$$a_0, a_1, a_2, \dots, a_n$$$ where $$$a_0 = 0$$$ and for each $$$i \ge 1$$$ you can choose:   either $$$a_i = a_{i - 1} + x$$$  or $$$a_i = a_{i - 1} - y$$$. Your goal is to build such a sequence $$$a$$$ that $$$a_i \le B$$$ for all $$$i$$$ and $$$\sum\limits_{i=0}^{n}{a_i}$$$ is maximum possible.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Next $$$t$$$ cases follow. The first and only line of each test case contains four integers $$$n$$$, $$$B$$$, $$$x$$$ and $$$y$$$ ($$$1 \le n \le 2 \cdot 10^5$$$; $$$1 \le B, x, y \le 10^9$$$). It's guaranteed that the total sum of $$$n$$$ doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print one integer — the maximum possible $$$\sum\limits_{i=0}^{n}{a_i}$$$.

NoteIn the first test case, the optimal sequence $$$a$$$ is $$$[0, 1, 2, 3, 4, 5]$$$.In the second test case, the optimal sequence $$$a$$$ is $$$[0, 10^9, 0, 10^9, 0, 10^9, 0, 10^9]$$$.In the third test case, the optimal sequence $$$a$$$ is $$$[0, -3, -6, 1, -2]$$$.

import Control.Monad (forM_)

solve n b x y z
    | n == 0 = []
    | p > q && p <= b = p : solve (n -1) b x y p
    | otherwise = q : solve (n -1) b x y q
  where
    p = z + x
    q = z - y

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        l <- getLine
        let [n, b, x, y] = (map read . words) l
        print $ sum $ solve n b x y 0

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

calc :: Int -> (Int, Int, Int, Int) -> Int
calc 0 _ = 0
calc i (a, b, x, y) = if (a + x <= b)
    then a + x + calc (i - 1) (a + x, b, x, y)
    else a - y + calc (i - 1) (a - y, b, x, y)

solve :: IO()
solve = do
    (n: b: x: y: _) <- readIntArr
    print $ calc n (0, b, x, y)

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
    f
    for (i - 1) f

main :: IO ()
main = do
    t <- readInt
    for t solve


You are given a positive integer $$$x$$$. Find any such $$$2$$$ positive integers $$$a$$$ and $$$b$$$ such that $$$GCD(a,b)+LCM(a,b)=x$$$.As a reminder, $$$GCD(a,b)$$$ is the greatest integer that divides both $$$a$$$ and $$$b$$$. Similarly, $$$LCM(a,b)$$$ is the smallest integer such that both $$$a$$$ and $$$b$$$ divide it.It's guaranteed that the solution always exists. If there are several such pairs $$$(a, b)$$$, you can output any of them.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 100)$$$  — the number of testcases. Each testcase consists of one line containing a single integer, $$$x$$$ $$$(2 \le x \le 10^9)$$$.

For each testcase, output a pair of positive integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le 10^9)$$$ such that $$$GCD(a,b)+LCM(a,b)=x$$$. It's guaranteed that the solution always exists. If there are several such pairs $$$(a, b)$$$, you can output any of them.

NoteIn the first testcase of the sample, $$$GCD(1,1)+LCM(1,1)=1+1=2$$$.In the second testcase of the sample, $$$GCD(6,4)+LCM(6,4)=2+12=14$$$.

module Main where

import Control.Monad
import Data.List

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

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

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        x <- readLn
        printList [1, x - 1]

module Main where

main = interact $ unlines . map (\x -> unwords $ map show [1, (read x :: Int)-1])  . tail . lines

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

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

work :: IO ()
work = do
  x <- parseInt <$> C.getLine
  putStrLn $ "1 " ++ show (x - 1)

main :: IO ()
main = do
  n <- fmap parseInt C.getLine
  replicateM_ n work

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

main = do
		n<- read <$> getLine ::IO Int
		a<-map read<$> replicateM n getLine ::IO [Int]
		let b= map (("1 "++) .show . (\z->z-1)) a
		mapM_ putStrLn b

{-# LANGUAGE Strict #-}
import Control.Monad

solve :: [Int] -> IO ()
solve [] = return ()
solve (x:xs) = do
    putStrLn $ "1 " ++ show (x - 1)
    solve xs

main = do
    t <- readLn :: IO Int
    xs <- replicateM t readLn :: IO [Int]
    solve xs

process :: Int -> (Int,Int)
process 2 = (1,1)
process x
    | odd x = (e,o)
    | otherwise = (2,x-2)
    where
        o = until odd ( `div` 2) (x-1)
        e = (x-1) `div` o

readInt :: String -> Int
readInt = read

showPair :: (Int,Int) -> String
showPair (a,b) = show a ++ " " ++ show b

main = do
    t <- fmap readInt getLine
    xs <- fmap (map readInt.words) getContents
    putStrLn . unlines $ map (showPair.process) xs

solve :: Integer -> (Integer, Integer)
solve x = (1, x - 1)

parse :: String -> String
parse input = (show a) ++ " " ++ (show b)
  where x = read input :: Integer
        (a, b) = solve x

main :: IO ()
main = interact (unlines . map parse . tail . lines)

import Control.Monad
import Data.Foldable (traverse_)

solve :: Integer -> (Integer, Integer)
solve x = (1, x - 1)

main :: IO ()
main = do
	a <- getLine
	tests <- replicateM (read a) getLine
	traverse_ (putAns . solve . read) tests
	where putAns (x, y) = putStrLn (show x ++ " " ++ show y)

import System.IO
import Control.Monad

main :: IO ()
main = do
    getLine
    tc <- (map (solver . read) . lines) <$> getContents :: IO [[Int]]
    forM_ tc (putStrLn .unwords . map show)

solver i = [1,i-1]

import Control.Monad

solve :: [Int] -> IO ()
solve [] = return ()
solve (x:xs) = putStrLn $ "1 " ++ show (x - 1)

main = do
    t <- readLn :: IO Int
    xs <- replicateM t readLn :: IO [Int]
    solve xs

process :: Int -> (Int,Int)
process 2 = (1,1)
process x
    | odd x = (e,o)
    | otherwise = (2,x-2)
    where
        o = until odd ( `div` 2) (x-1)
        e = x `div` o

readInt :: String -> Int
readInt = read

showPair :: (Int,Int) -> String
showPair (a,b) = show a ++ " " ++ show b

main = do
    t <- fmap readInt getLine
    xs <- fmap (map readInt.words) getContents
    putStrLn . unlines $ map (showPair.process) xs


You are given an undirected unweighted connected graph consisting of $$$n$$$ vertices and $$$m$$$ edges. It is guaranteed that there are no self-loops or multiple edges in the given graph.Your task is to find any spanning tree of this graph such that the maximum degree over all vertices is maximum possible. Recall that the degree of a vertex is the number of edges incident to it.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 2 \cdot 10^5$$$, $$$n - 1 \le m \le min(2 \cdot 10^5, \frac{n(n-1)}{2})$$$) — the number of vertices and edges, respectively. The following $$$m$$$ lines denote edges: edge $$$i$$$ is represented by a pair of integers $$$v_i$$$, $$$u_i$$$ ($$$1 \le v_i, u_i \le n$$$, $$$u_i \ne v_i$$$), which are the indices of vertices connected by the edge. There are no loops or multiple edges in the given graph, i. e. for each pair ($$$v_i, u_i$$$) there are no other pairs ($$$v_i, u_i$$$) or ($$$u_i, v_i$$$) in the list of edges, and for each pair $$$(v_i, u_i)$$$ the condition $$$v_i \ne u_i$$$ is satisfied.

Print $$$n-1$$$ lines describing the edges of a spanning tree such that the maximum degree over all vertices is maximum possible. Make sure that the edges of the printed spanning tree form some subset of the input edges (order doesn't matter and edge $$$(v, u)$$$ is considered the same as the edge $$$(u, v)$$$). If there are multiple possible answers, print any of them.

NotePicture corresponding to the first example: In this example the number of edges of spanning tree incident to the vertex $$$3$$$ is $$$3$$$. It is the maximum degree over all vertices of the spanning tree. It is easy to see that we cannot obtain a better answer.Picture corresponding to the second example: In this example the number of edges of spanning tree incident to the vertex $$$1$$$ is $$$3$$$. It is the maximum degree over all vertices of the spanning tree. It is easy to see that we cannot obtain a better answer.Picture corresponding to the third example: In this example the number of edges of spanning tree incident to the vertex $$$2$$$ is $$$4$$$. It is the maximum degree over all vertices of the spanning tree. It is easy to see that we cannot obtain a better answer. But because this example is symmetric, we can choose almost the same spanning tree but with vertex $$$5$$$ instead of $$$2$$$.

{-# LANGUAGE FlexibleContexts, Safe #-}
{-# Options_GHC -O3 #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import Data.Char
import Data.Monoid
import qualified Data.ByteString.Char8 as C
import System.IO
import Data.List

disjointSetInit :: Int -> ST s (STUArray s Int Int, STUArray s Int Int)
disjointSetInit n = do
  p <- newListArray (0, n) [0 .. n] :: ST s (STUArray s Int Int)
  h <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
  return (p, h)

disjointSetFind :: (MArray a Int m) => (a Int Int, t) -> Int -> m Int
disjointSetFind d@(p, _) x = do
  px <- readArray p x
  if px == x then return x
  else do
    px <- disjointSetFind d px
    writeArray p x px
    return px

disjointSetMerge :: (MArray a Int m) => (a Int Int, a Int Int) -> Int -> Int -> m (Bool)
disjointSetMerge d@(p, h) i j = do
  i' <- disjointSetFind d i
  j' <- disjointSetFind d j
  if i' /= j' then do
    hi <- readArray h i'
    hj <- readArray h j'
    if hi < hj then writeArray p i' j'
    else if hi > hj then writeArray p j' i'
    else do
      writeArray p i' j'
      writeArray h j' (succ hj)
    return True
  else return False

ru, ri :: C.ByteString -> Int

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

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : (tuple2 l)

solve (n:m:a) = mconcat [ intDec i <> char7 ' ' <> intDec j <> char7 '\n' | (i, j) <- res]
  where
    b = take (2 * m) a
    e = tuple2 b
    d :: UArray Int Int
    d = accumArray (+) 0 (1, n) $ zip b $ repeat 1
    v :: Int
    (_, v) = maximum $ zip (elems d) [1 .. ]
    (e1, e2) = partition (\(i, j) -> i == v || j == v) e
    res = runST $ do
      ds <- disjointSetInit n
      forM_ e1 $ \(i, j) -> disjointSetMerge ds i j
      let
        f l edge@(i, j) = do
          b <- disjointSetMerge ds i j
          if b then return $! edge : l
          else return l
      foldM f e1 e2

main = do
  s <- C.getContents
  hPutBuilder stdout $ solve $ map ru $ C.words s


Thumbelina has had an accident. She has found herself on a little island in the middle of a swamp and wants to get to the shore very much.One can get to the shore only by hills that are situated along a straight line that connects the little island with the shore. Let us assume that the hills are numbered from 1 to n and the number of a hill is equal to the distance in meters between it and the island. The distance between the n-th hill and the shore is also 1 meter.Thumbelina is too small to make such jumps. Fortunately, a family of frogs living in the swamp suggests to help her. Each frog agrees to give Thumbelina a ride but Thumbelina should choose only one frog. Each frog has a certain jump length. If Thumbelina agrees to accept help from a frog whose jump length is d, the frog will jump from the island on the hill d, then — on the hill 2d, then 3d and so on until they get to the shore (i.e. find itself beyond the hill n).However, there is one more problem: mosquitoes also live in the swamp. At the moment they have a siesta, and they are having a nap on some hills. If the frog jumps on a hill with a mosquito the frog will smash it. The frogs Thumbelina has met are pacifists, so they will find the death of each mosquito very much sad. Help Thumbelina choose a frog that will bring her to the shore and smash as small number of mosquitoes as possible.

The first line contains three integers n, m and k (1 ≤ n ≤ 109, 1 ≤ m, k ≤ 100) — the number of hills, frogs and mosquitoes respectively. The second line contains m integers di (1 ≤ di ≤ 109) — the lengths of the frogs’ jumps. The third line contains k integers — the numbers of the hills on which each mosquito is sleeping. No more than one mosquito can sleep on each hill. The numbers in the lines are separated by single spaces.

In the first line output the number of frogs that smash the minimal number of mosquitoes, in the second line — their numbers in increasing order separated by spaces. The frogs are numbered from 1 to m in the order of the jump length given in the input data.

main = interact solve

solve :: String -> String
solve s = unlines $ [show $ length y, unwords $ map show $ map fst y]
  where
    [info, fInfo, mInfo] = lines s
    frogs = map (\x -> read x :: Int) $ words fInfo
    mos = map (\x -> read x :: Int) $ words mInfo
    x = map (\(i, l) -> (i, length $ filter (\m -> m `mod` l == 0) mos)) $ zip [1..] frogs
    m = minimum $ map snd x
    y = filter (\(i, c) -> c == m) x

import Monad (liftM)
import Prelude hiding (print, reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> [Int] -> [Int]
solve ls ks  =  solve' ([], maxBound) $ (zip ls [1..])
  where
    solve' (acc, _) []  =  reverse acc
    solve' (acc, min) ((l,num):ls)
      | m < min  =  solve' ([num], m) ls
      | m > min  =  solve' (acc, min) ls
      | otherwise  =  solve' (num:acc, min) ls
      where
        m  =  length $ filter (\k -> k `mod` l == 0) ks

print :: Show a => [a] -> IO ()
print xs  =  putStrLn (show (length xs)) >> print' xs
  where
    print' []  =  return ()
    print' [x]  =  putStrLn (show x)
    print' (x:xs)  =  putStr (show x ++ " ") >> print' xs

main :: IO ()
main  =  do
    getLine
    ls  <-  reads
    ks  <-  reads
    print $ solve ls ks


There are two popular keyboard layouts in Berland, they differ only in letters positions. All the other keys are the same. In Berland they use alphabet with 26 letters which coincides with English alphabet.You are given two strings consisting of 26 distinct letters each: all keys of the first and the second layouts in the same order. You are also given some text consisting of small and capital English letters and digits. It is known that it was typed in the first layout, but the writer intended to type it in the second layout. Print the text if the same keys were pressed in the second layout.Since all keys but letters are the same in both layouts, the capitalization of the letters should remain the same, as well as all other characters.

The first line contains a string of length 26 consisting of distinct lowercase English letters. This is the first layout. The second line contains a string of length 26 consisting of distinct lowercase English letters. This is the second layout. The third line contains a non-empty string s consisting of lowercase and uppercase English letters and digits. This is the text typed in the first layout. The length of s does not exceed 1000.

import Data.Char
import Data.List

matchCase :: Char -> Char -> Char
matchCase a b = if isUpper a then toUpper b else b

convertChar :: String -> String -> Char -> Char
convertChar keyboard1 keyboard2 c =
	    case elemIndex (toLower c) keyboard1 of
	    	 Nothing   -> c
		 Just ind -> matchCase c $ keyboard2 !! ind

main :: IO ()
main = do
     keyboard1 <- getLine
     keyboard2 <- getLine
     str <- getLine
     putStrLn $ map (convertChar keyboard1 keyboard2) str

import Data.List
import Data.Char

main = interact $ f

f :: String -> String
f = g . lines

g :: [String] -> String
g [a, b, c] =
  map h c
  where aa = a ++ map toUpper a
        bb = b ++ map toUpper b
        zipped = zip aa bb

        h :: Char -> Char
        h c =
          case elemIndex c aa of
            Nothing -> c
            Just i -> bb !! i

import Data.List
import Data.Char

main = interact $ f

f :: String -> String
f = g . lines

g :: [String] -> String
g [a, b, c] =
  map (h aa bb) c
    where aa = a ++ map toUpper a
          bb = b ++ map toUpper b

h :: String -> String -> Char -> Char
h a b c =
  case elemIndex c a of
    Nothing -> c
    Just i -> b !! i

-- Packages installed: split text hashtables vector
-- vector-algorithms parsec bytestring unordered-containers
-- hashable scientific random async stm aeson
-- Run using: runghc file.hs
import Control.Applicative
import qualified Data.Map as M
import Data.Char

main = do
  a <- getLine
  b <- getLine
  c <- getLine
  putStrLn $ solve2 a b c

solve2 :: String -> String -> String -> String
solve2 s s' = map f
  where
    f c = maybe c id $ M.lookup c mp
    mp = foldl g M.empty (zip s s')
    g mp (a, b) = M.insert (upper a) (upper b) (M.insert a b mp)

upper a = chr (ord a - 32)

-- Try Codeforces
-- author: Leonardone @ NEETSDKASu

import Data.Char (toUpper)

main = putStrLn . solve . lines =<< getContents

solve [xs, ys, zs] = ans where
    go []     ws = ws
    go (u:us) ws = go us (trans u:ws)
    ans = reverse $ go zs []

    xxs = xs ++ map toUpper xs
    yys = ys ++ map toUpper ys

    trans c = p where
        (x1, x2) = span (/= c) xxs
        p = if x2 == [] then c
            else yys !! length x1

import Data.List
import Data.Char
import Data.Maybe
f alph1 alph2 text = zipWith toSameCase (map (\x-> (alph2++['0'..'9'])!!x) $ map fromJust [elemIndex i (alph1++['0'..'9'])|i<-map toLower text]) text
	where
		toSameCase x y
			|isUpper y=toUpper x
			|otherwise=toLower x
main=do
	a<-getLine
	b<-getLine
	c<-getLine
	putStrLn $ f a b c

import qualified Data.Map as M
import qualified Data.Char as C

main :: IO ()
main =
  do
    a <- getLine
    b <- getLine
    ans <- getLine

    putStrLn $ map (\x -> case M.lookup (C.toLower x) $ M.fromList $ zip a b of Just t -> if C.isUpper x then C.toUpper t else t ; otherwise -> x) $ ans

import Data.Char
import Data.Maybe
main = interact $ solve . lines
solve [l1,l2,t] = mapMaybe (flip lookup lut) t where
  lut = zip l1 l2 ++
        zip (map toUpper l1) (map toUpper l2) ++
        zip ['0'..'9'] ['0'..'9']

import Data.Map( fromList, (!))
import Data.Char( isUpper, isDigit, toUpper, toLower)
main = do
    from_ <- getLine
    to_ <- getLine
    toEnc_ <- getLine
    let
	mp = fromList $ zip from_ to_

	encode c = let
			c' = mp!(toLower c)
		    in
			if isDigit c
			    then c
			    else if isUpper c
				then toUpper c'
				else c'
    putStr $ map encode toEnc_

import qualified Data.Map as Map
import Data.Char
import Data.Maybe

make_layout_map::String->String->Map.Map Char Char
make_layout_map s1 s2 = Map.fromList$zipWith (\k v->(k, v)) s1 s2

convert_char::Map.Map Char Char->Char->Char
convert_char layout_map c
    |isLower c = fromJust$Map.lookup c layout_map
    |isUpper c = toUpper$fromJust$Map.lookup (toLower c) layout_map
    |otherwise = c

convert_string::Map.Map Char Char->String->String
convert_string layout_map s = map (convert_char layout_map) s

solution::[String]->String
solution [fst_layout, scn_layout, data_in] =
    convert_string (make_layout_map fst_layout scn_layout) data_in

main = interact$(solution.lines)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.Char

main = do
  f <- getLine
  s <- getLine
  t <- getLine
  putStr $ solve f s t

solve f s = map (\c -> if isDigit c then c else (if isAsciiUpper c then toUpper else id) $ f2s!toLower c)
  where f2s = array ('a', 'z') $ zip f s :: UArray Char Char

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Map as M
import Data.Char

main = do
		a<-getLine
		b<-getLine
		c<-getLine
		let ma = M.fromList $ zip (a++ (map toUpper a) ++ "0123456789") (b++ (map toUpper b) ++ "0123456789")
		putStrLn $ map (\z-> fromJust (M.lookup z ma)) c

import Data.Char

main = interact $ f

f :: String -> String -- String is the collection of strings
f = g . lines  -- lines breaks a string up into a list of strings at newline characters.

g :: [String] -> String  -- [String] is the collection of lists of strings
g [a, b, c] = map h c    -- map :: (a -> b) -> [a] -> [b]  -- (a->b) is first arg. [a] is second arg
-- map f xs is the list obtained by applying f to each element of xs, i.e.,
-- map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]

    where
        upperA = map toUpper a  -- a is a list of characters
        upperB = map toUpper b
        aA = a ++ upperA
        bB = b ++ upperB

        h :: Char -> Char
        h c = answer
            where    zipped = zip aA bB

                     checkTuple :: (Char,Char) -> Bool
                     checkTuple (c1, _) = c == c1

                     v = filter checkTuple zipped
                     --answer = snd (head (filter checkTuple zipped) )  -- head : [a,b] \mapsto a

                     answer = if length v == 0 then c
                              else snd (head (filter checkTuple zipped) )

import Data.Array (array, (!))
import Data.Char (isDigit, isLower, toUpper, toLower)

process :: [Char] -> [Char] -> [Char] -> [Char]
process l1 l2 = map f
    where
        a = array ('a', 'z') $ zip l1 l2
        f x
            | isDigit x = x
            | isLower x = a ! x
            | otherwise = toUpper (a ! (toLower x))

main :: IO ()
main = do
    l1 <- getLine
    l2 <- getLine
    s <- getLine
    putStrLn $ process l1 l2 s

import Data.Maybe
main = interact $ solve . lines
solve [l1,l2,t] = mapMaybe (flip lookup (zip l1 l2)) t

import qualified Data.Map as Map
import Data.Char
import Data.Maybe

make_layout_map::String->String->Map.Map Char Char
make_layout_map s1 s2 = Map.fromList$zipWith (\k v->(k, v)) s1 s2

convert_char::Map.Map Char Char->Char->Char
convert_char layout_map c
    |isLower c = fromJust$Map.lookup c layout_map
    |isUpper c = toUpper$fromJust$Map.lookup (toLower c) layout_map
    |otherwise = c

convert_string::Map.Map Char Char->String->String
convert_string layout_map s = map (convert_char layout_map) s

solution::[String]->String
solution [fst_layout, scn_layout, data_in] =
    convert_string (make_layout_map fst_layout scn_layout) data_in

main = interact$(show.solution.lines)


IA has so many colorful magnets on her fridge! Exactly one letter is written on each magnet, 'a' or 'b'. She loves to play with them, placing all magnets in a row. However, the girl is quickly bored and usually thinks how to make her entertainment more interesting.Today, when IA looked at the fridge, she noticed that the word formed by magnets is really messy. "It would look much better when I'll swap some of them!" — thought the girl — "but how to do it?". After a while, she got an idea. IA will look at all prefixes with lengths from $$$1$$$ to the length of the word and for each prefix she will either reverse this prefix or leave it as it is. She will consider the prefixes in the fixed order: from the shortest to the largest. She wants to get the lexicographically smallest possible word after she considers all prefixes. Can you help her, telling which prefixes should be chosen for reversing?A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds: $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$; in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

The first and the only line contains a string $$$s$$$ ($$$1 \le |s| \le 1000$$$), describing the initial string formed by magnets. The string $$$s$$$ consists only of characters 'a' and 'b'.

Output exactly $$$|s|$$$ integers. If IA should reverse the $$$i$$$-th prefix (that is, the substring from $$$1$$$ to $$$i$$$), the $$$i$$$-th integer should be equal to $$$1$$$, and it should be equal to $$$0$$$ otherwise. If there are multiple possible sequences leading to the optimal answer, print any of them.

NoteIn the first example, IA can reverse the second and the third prefix and get a string "abbb". She cannot get better result, since it is also lexicographically smallest string obtainable by permuting characters of the initial string.In the second example, she can reverse any subset of prefixes — all letters are 'a'.

import Data.List
type Reverse = Bool
type ASC     = Bool

doReverse :: Char -> ASC -> (Reverse, ASC)
doReverse x asc
    | asc == True && x == 'a'  = (False, True)
    | asc == True && x == 'b'  = (True, False)
    | asc == False && x == 'a' = (True, True)
    | asc == False && x == 'b' = (False, False)

arrangeString' :: [Char] -> ASC -> [Reverse]
arrangeString' [] _ = []
arrangeString' (x:xs) asc = reverse : arrangeString' xs asc'
    where (reverse, asc') = doReverse x asc

arrangeString :: [Char] -> [Reverse]
arrangeString = reverse . (\s -> arrangeString' s False) . reverse

main :: IO ()
main = do
    string <- getLine
    putStrLn $ unwords $ map (show . fromEnum)$ arrangeString string


Paw the Spider is making a web. Web-making is a real art, Paw has been learning to do it his whole life. Let's consider the structure of the web.  There are n main threads going from the center of the web. All main threads are located in one plane and divide it into n equal infinite sectors. The sectors are indexed from 1 to n in the clockwise direction. Sectors i and i + 1 are adjacent for every i, 1 ≤ i < n. In addition, sectors 1 and n are also adjacent.Some sectors have bridge threads. Each bridge connects the two main threads that make up this sector. The points at which the bridge is attached to the main threads will be called attachment points. Both attachment points of a bridge are at the same distance from the center of the web. At each attachment point exactly one bridge is attached. The bridges are adjacent if they are in the same sector, and there are no other bridges between them.A cell of the web is a trapezoid, which is located in one of the sectors and is bounded by two main threads and two adjacent bridges. You can see that the sides of the cell may have the attachment points of bridges from adjacent sectors. If the number of attachment points on one side of the cell is not equal to the number of attachment points on the other side, it creates an imbalance of pulling forces on this cell and this may eventually destroy the entire web. We'll call such a cell unstable. The perfect web does not contain unstable cells.Unstable cells are marked red in the figure. Stable cells are marked green.Paw the Spider isn't a skillful webmaker yet, he is only learning to make perfect webs. Help Paw to determine the number of unstable cells in the web he has just spun.

The first line contains integer n (3 ≤ n ≤ 1000) — the number of main threads. The i-th of following n lines describe the bridges located in the i-th sector: first it contains integer ki (1 ≤ ki ≤ 105) equal to the number of bridges in the given sector. Then follow ki different integers pij (1 ≤ pij ≤ 105; 1 ≤ j ≤ ki). Number pij equals the distance from the attachment points of the j-th bridge of the i-th sector to the center of the web. It is guaranteed that any two bridges between adjacent sectors are attached at a different distance from the center of the web. It is guaranteed that the total number of the bridges doesn't exceed 105.

Print a single integer — the number of unstable cells in Paw the Spider's web.

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

par []    _ = []
par (h:t) b = length l: par t r
  where
    (l, r) = span (<h) b

gao a x b = length $ filter id $ zipWith (/=) a' b'
  where
    (_:a') = par x a
    (_:b') = par x b

main = do
  [n] <- getArray
  a <- replicateM n $ fmap (sort . tail) getArray
  print $ sum $ zipWith3 gao a (rotate a) $ rotate $ rotate a
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
    rotate (h:t) = t ++ [h]


Consider 2n rows of the seats in a bus. n rows of the seats on the left and n rows of the seats on the right. Each row can be filled by two people. So the total capacity of the bus is 4n.Consider that m (m ≤ 4n) people occupy the seats in the bus. The passengers entering the bus are numbered from 1 to m (in the order of their entering the bus). The pattern of the seat occupation is as below:1-st row left window seat, 1-st row right window seat, 2-nd row left window seat, 2-nd row right window seat, ... , n-th row left window seat, n-th row right window seat.After occupying all the window seats (for m > 2n) the non-window seats are occupied:1-st row left non-window seat, 1-st row right non-window seat, ... , n-th row left non-window seat, n-th row right non-window seat.All the passengers go to a single final destination. In the final destination, the passengers get off in the given order.1-st row left non-window seat, 1-st row left window seat, 1-st row right non-window seat, 1-st row right window seat, ... , n-th row left non-window seat, n-th row left window seat, n-th row right non-window seat, n-th row right window seat.  The seating for n = 9 and m = 36. You are given the values n and m. Output m numbers from 1 to m, the order in which the passengers will get off the bus.

The only line contains two integers, n and m (1 ≤ n ≤ 100, 1 ≤ m ≤ 4n) — the number of pairs of rows and the number of passengers.

Print m distinct integers from 1 to m — the order in which the passengers will get off the bus.

import Data.Array (array, (!))

main = do
  [n, m] <- fmap (map read . words) getLine

  let
    a = array (1,4*n) $ zip (concat [[4*i+1, 4*i+4] | i <- [0..n-1]] ++ concat [[4*i+2, 4*i+3] | i <- [0..n-1]]) [1..]
    b = concat [[4*i+2,4*i+1,4*i+3,4*i+4] | i <- [0..n-1]]
    r = filter (<= m) $ map (a !) b

  putStrLn $ unwords $ map show r

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

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

out = stdout

main = do
  (n,m) <- readInt2 <$> BS.getLine
  putAns out . makeTable $ solve n m

solve :: Int -> Int -> [Int]
solve n m = filter (<= m) . concat . transpose $ [col2,col1,col3,col4] where
  col1 = map pred col4
  col2 = map (+(2*n)) col1
  col3 = map (+(2*n)) col4
  col4 = map (*2) [1..n]

makeTable :: [Int] -> Table
makeTable xs = [ListR (map (\x -> IntC x) xs)]

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

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

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

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

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

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

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

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

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

-- if not applying, use "const"

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

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

-- output functions

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

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

type Table = [Row]

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

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

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

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

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

main = interact $ unwords . map show . sol . map read . words

sol [n, m] = filter (<=m) . take (n*4) . concat . map (\x -> [2*n+x, x]) $ [1..]


You are given a sequence $$$a$$$ consisting of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$, and an integer $$$x$$$. Your task is to make the sequence $$$a$$$ sorted (it is considered sorted if the condition $$$a_1 \le a_2 \le a_3 \le \dots \le a_n$$$ holds).To make the sequence sorted, you may perform the following operation any number of times you want (possibly zero): choose an integer $$$i$$$ such that $$$1 \le i \le n$$$ and $$$a_i > x$$$, and swap the values of $$$a_i$$$ and $$$x$$$.For example, if $$$a = [0, 2, 3, 5, 4]$$$, $$$x = 1$$$, the following sequence of operations is possible:  choose $$$i = 2$$$ (it is possible since $$$a_2 > x$$$), then $$$a = [0, 1, 3, 5, 4]$$$, $$$x = 2$$$;  choose $$$i = 3$$$ (it is possible since $$$a_3 > x$$$), then $$$a = [0, 1, 2, 5, 4]$$$, $$$x = 3$$$;  choose $$$i = 4$$$ (it is possible since $$$a_4 > x$$$), then $$$a = [0, 1, 2, 3, 4]$$$, $$$x = 5$$$. Calculate the minimum number of operations you have to perform so that $$$a$$$ becomes sorted, or report that it is impossible.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. Each test case consists of two lines. The first line contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 500$$$, $$$0 \le x \le 500$$$) — the number of elements in the sequence and the initial value of $$$x$$$. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$0 \le a_i \le 500$$$). The sum of values of $$$n$$$ over all test cases in the input does not exceed $$$500$$$.

For each test case, print one integer — the minimum number of operations you have to perform to make $$$a$$$ sorted, or $$$-1$$$, if it is impossible.

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = interact $
  runScanner (numberOf tc) >>> map (solve >>> show) >>> unlines

data TC = TC { initX :: Int, a :: [Int] }

tc = do
  n <- int
  TC <$> int <*> (n `times` int)

solve :: TC -> Int
solve (TC{..}) = fromMaybe (-1) (go 0 initX a)

go _ _ [] = Just 0
go l _ (a:as)
  | l > a = Nothing
  | sorted (a:as) = Just 0
go l x (a:as)
  | x >= a && l <= a = go a x as
  | x >= a || x < l = Nothing
  | otherwise = (1+) <$> go x a as

sorted :: [Int] -> Bool
sorted xs = all (uncurry (<=)) (zip xs (tail xs))

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

type Scanner = State [String]

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

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

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

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

integer :: Scanner Integer
integer = read <$> str

double :: Scanner Double
double = read <$> str

decimal :: Int -> Scanner Int
decimal p = (round . ((10^p)*)) <$> double

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

many :: Scanner a -> Scanner [a]
many s = get >>= \case { [] -> return []; _ -> (:) <$> s <*> many s }

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

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2..4]


Nowadays the one-way traffic is introduced all over the world in order to improve driving safety and reduce traffic jams. The government of Berland decided to keep up with new trends. Formerly all n cities of Berland were connected by n two-way roads in the ring, i. e. each city was connected directly to exactly two other cities, and from each city it was possible to get to any other city. Government of Berland introduced one-way traffic on all n roads, but it soon became clear that it's impossible to get from some of the cities to some others. Now for each road is known in which direction the traffic is directed at it, and the cost of redirecting the traffic. What is the smallest amount of money the government should spend on the redirecting of roads so that from every city you can get to any other?

The first line contains integer n (3 ≤ n ≤ 100) — amount of cities (and roads) in Berland. Next n lines contain description of roads. Each road is described by three integers ai, bi, ci (1 ≤ ai, bi ≤ n, ai ≠ bi, 1 ≤ ci ≤ 100) — road is directed from city ai to city bi, redirecting the traffic costs ci.

Output single integer — the smallest amount of money the government should spend on the redirecting of roads so that from every city you can get to any other.

module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.IO
import Data.Array
import Data.Array.ST
import Data.List

data Road = Road { roadTo, roadCost :: !Int } deriving Show;

main = do
    n <- read `liftM` getLine

    roadArray <- newArray (1,n) [] :: IO (IOArray Int [Road])
    replicateM_ n $ do
        [a, b, c] <- ( map read . words ) `liftM` getLine
        readArray roadArray a >>= writeArray roadArray a . ( Road b c : )
        readArray roadArray b >>= writeArray roadArray b . ( Road a 0 : )

    roadIArray <- freeze roadArray :: IO (Array Int [Road])
    --putStrLn $ show roadIArray

    let pathCost :: Int -> Int -> Int
        pathCost last_v v = if v == 1
            then 0
            else maybe 0 ( \Road { roadTo=to, roadCost=cost } -> cost + pathCost v to ) ( find ( \Road { roadTo=to } -> to /= last_v ) ( roadIArray ! v ) )

        routeCost = map ( \Road { roadTo=to, roadCost=cost } -> cost + pathCost 1 to ) ( roadIArray ! 1 )

    putStrLn $ show $ minimum routeCost

data Road = Road { src :: Int
                 , dst :: Int
                 , cost :: Int
                 } deriving (Eq)

main :: IO ()
main = interact func

func :: String -> String
func s = let ds = lines s
             n  = head ds
             rs = tail ds
         in show (func' (read n) (map toRoad rs))

toRoad :: String -> Road
toRoad s = let ws = words s in Road { src = read $ ws!!0
                                    , dst = read $ ws!!1
                                    , cost = read $ ws!!2
                                    }

func' :: Int -> [Road] -> Int
func' _ rs = if costOne < costAnother
             then costOne
             else costAnother
  where oc = ocf ++ oct
        ocf = connectFrom 1 rs
        oct = connectTo 1 rs
        costOne = cycleCost 1 (oc!!0) rs
        costAnother = cycleCost 1 (oc!!1) rs

cycleCost :: Int -> Road -> [Road] -> Int
cycleCost pos road rs = if nextPos == 1
                        then nowCost
                        else nowCost + cycleCost nextPos nextRoad rs
  where nextRoad = head $ filter (\r -> r /= road) $ connected pos rs
        (nextPos, nowCost) = if src nextRoad == pos
                             then (dst nextRoad, 0)
                             else (src nextRoad, cost nextRoad)

connected :: Int -> [Road] -> [Road]
connected n rs = connectFrom n rs ++ connectTo n rs

connectFrom :: Int -> [Road] -> [Road]
connectFrom n rs = filter (\r -> src r == n) rs

connectTo :: Int -> [Road] -> [Road]
connectTo n rs = filter (\r -> dst r == n) rs

import Control.Monad (liftM, replicateM)
import Data.Array (Array, (!), accumArray)
import Data.List (intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

type City  =  Int
type Cost  =  Int
type Map  =  Array City [(City, Cost)]

solve :: [[Int]] -> Int
solve roads  =  min way1 way2
  where
    n  =  length roads
    map :: Map
    map  =  accumArray (++) [] (1, n) $ concat
        [[(a, [(b, 0)]), (b, [(a, c)])] | [a, b, c] <- roads]
    [a, b, c]  =  head roads
    way1  =  way 1 a b
    way2  =  c + way 1 b a
    way i x y
      | i == n  =  0
      | fst (head (map ! y)) /= x  =  snd (head (map ! y)) + way (i+1) y (fst (head (map ! y)))
      | otherwise  =  snd ((map ! y) !! 1) + way (i+1) y (fst ((map ! y) !! 1))

main :: IO ()
main  =  do
    n  <-  readLn
    roads  <-  replicateM n reads
    print $ solve roads