Well, here is another math class task. In mathematics, GCD is the greatest common divisor, and it's an easy task to calculate the GCD between two positive integers.A common divisor for two positive numbers is a number which both numbers are divisible by.But your teacher wants to give you a harder task, in this task you have to find the greatest common divisor d between two integers a and b that is in a given range from low to high (inclusive), i.e. low ≤ d ≤ high. It is possible that there is no common divisor in the given range.You will be given the two integers a and b, then n queries. Each query is a range from low to high and you have to answer each query.

The first line contains two integers a and b, the two integers as described above (1 ≤ a, b ≤ 109). The second line contains one integer n, the number of queries (1 ≤ n ≤ 104). Then n lines follow, each line contains one query consisting of two integers, low and high (1 ≤ low ≤ high ≤ 109).

Print n lines. The i-th of them should contain the result of the i-th query in the input. If there is no common divisor in the given range for any query, you should print -1 as a result for this query.

import Data.Maybe

maybeMaximum [] = Nothing
maybeMaximum xs = Just $ maximum xs

solve a b queries =
		map process queries
	where
		d = gcd a b
		is = takeWhile (\i -> i*i <= d) [1..]
		ds = concat [[i, d `div` i] | i <- is, d `mod` i == 0]

		process (l, r) = maybeMaximum $ filter (\d -> l <= d && d <= r) ds

readWords = map read . words

main = do
	[a, b] <- readWords `fmap` getLine
	_ <- getLine
	queries <- (map ((\[a, b] -> (a, b)) . readWords) . lines) `fmap` getContents
	putStr $ unlines $ map (show . fromMaybe (-1)) $ solve a b queries

import Data.Maybe

maybeMaximum [] = Nothing
maybeMaximum xs = Just $ maximum xs

solve a b queries =
		map process queries
	where
		d = gcd a b
		is = takeWhile (\i -> i*i <= d) [1..]
		ds = concat [[i, d `div` i] | i <- is, d `mod` i == 0]

		process (l, r) = maybeMaximum $ filter (\d -> l <= d && d <= r) ds

readWords = map read . words :: String -> [Int]

main = do
	[a, b] <- readWords `fmap` getLine
	_ <- getLine
	queries <- (map ((\[a, b] -> (a, b)) . readWords) . lines) `fmap` getContents
	putStr $ unlines $ map (show . fromMaybe (-1)) $ solve a b queries

import Data.List
import Data.Array.Unboxed
import Data.Maybe
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

pfactors n toTest@(x:xs)
    | n <= 1         = []
    | x * x > n      = [n]
    | n `mod` x == 0 = x:pfactors (n `div` x) toTest
    | otherwise      = pfactors n xs

divisorsFromF xs = sort . map product . sequence . map (scanl (*) 1) . group $ sort xs

readI = fst . fromJust . BS.readInt

--return the of value in a sorted array LEQ than x
solve :: UArray Int Int -> Int -> Maybe Int
solve sorted x = if sorted ! pos <= x then Just (sorted ! pos) else Nothing
  where
    bnds = bounds sorted
    bsearch lo hi
        | lo >= hi              = lo
        | sorted ! (mid+1) <= x = bsearch (mid + 1) hi
        | otherwise             = bsearch lo mid
      where
        mid = (lo + hi) `div` 2
    pos = bsearch (fst bnds) (snd bnds)

main = do
    [x, y] <- map read . words <$> getLine :: IO [Int]
    let g = gcd x y
    let factors = pfactors g [2..]
    let divisors = divisorsFromF factors
    let arr = listArray (1, length divisors) divisors :: UArray Int Int
    q <- read <$> getLine :: IO Int
    lines <- map (map readI . BS.words) . take q . BS.lines <$> BS.getContents
    forM_ lines $ \[low, high] -> do
        let val = solve arr high
        let answer = if isJust val && fromJust val >= low then fromJust val else -1
        print answer

import Control.Monad
import Data.List
-- import Debug.Trace

primes = 2 : sieve [3,5..]
  where
    sieve (x:xs) = x : sieve [y | y <- xs, y `mod` x /= 0]

solve xs = do
  [l, h] <- fmap (map read . words) getLine
  return $ case dropWhile (> h) xs of
    [] -> -1
    (x:_)
      | x < l -> -1
      | otherwise -> x

gen x =
  rec 1 $ glue [] $ factors [] primes x
  where
    rec cur [] = [cur]
    rec cur ((x, c):xs) =
      [ x^p | p <- [0..c]] >>= \v -> rec (cur*v) xs
    glue res [] = reverse res
    glue [] (y:ys) = glue [(y, 1)] ys
    glue res@((x, c):xs) (y:ys)
      | x == y = glue ((x, c+1):xs) ys
      | otherwise = glue ((y, 1):res) ys
    factors res (p:ps) x
      | p*p > x = reverse $ x:res
      | x `mod` p == 0 = factors (p:res) (p:ps) (x`div`p)
      | otherwise = factors res ps x

main = do
  [a, b] <- fmap (map read . words) getLine
  n <- fmap read getLine
  let xs = reverse $ sort $ gen $ gcd a b
  xs `seq` mapM_ print =<< replicateM n (solve xs)

import Data.List

getdivisors :: Int -> [Int]
getdivisors n = sort $  [x | x <- xs , mod n x == 0 ] ++ [ div n x | x <- xs , mod n  x == 0 ]
      where
       sq = truncate $ sqrt $ fromIntegral n
       xs = [1..sq]

xfind :: Int -> Int -> [Int] -> Int -> Int ->  Int
xfind s e xs a b
  | s > e      = -1
  | x == False =  xfind (m+1) e xs a b
  | y == False =  xfind s (m-1) xs a b
  | otherwise  =  max (xs!!m) (xfind (m+1) e xs a b)
  where
    m = div (s+e) 2
    x =  (xs!!m) >=  a
    y = ( xs!!m) <= b

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

doit :: Int -> [Int] ->  IO()
doit 0 xs = return ()
doit t xs = do
             ws <- getLine
             let [a,b] = map readInt (words ws)
             print $ xfind 0 ((length xs)-1) xs a b
             doit (t-1) xs

main :: IO()
main = do
        ws <- getLine
        let [a,b] = map readInt (words ws)
        let xs = getdivisors $  gcd a b
        t <- getLine
        doit (readInt t) xs

import Data.List
import Control.Applicative
default (Int)
f r g m | g == 1 = sortBy (flip compare) $
            foldl (\a b -> (*) <$> a <*> (scanl (*) 1 b)) [1] $ (group $ reverse r)
        | g `mod` m == 0 = f (m:r) (g `div` m) m
        | g < m^2 = f r g g
        | otherwise = f r g (m + 1)
main = do
    [a, b] <- (map read . words) `fmap` getLine :: IO [Int]
    n <- read `fmap` getLine
    let divs = f [] (gcd a b) 2
    mapM_ (\_ -> do
        [low, high] <- (map read . words) `fmap` getLine
        case takeWhile (>= low) $ dropWhile (> high) divs of
            h:_ -> print h
            [] -> print (-1)) [1..n]

import Data.Maybe

maybeMaximum [] = Nothing
maybeMaximum xs = Just $ maximum xs

solve a b queries =
		map process queries
	where
		d = gcd a b
		is = takeWhile (\i -> i*i <= d) [1..]
		ds = concat [[d, d `div` i] | i <- is, d `mod` i == 0]

		process (l, r) = maybeMaximum $ filter (\d -> l <= d && d <= r) ds

readWords = map read . words

main = do
	[a, b] <- readWords `fmap` getLine
	_ <- getLine
	queries <- (map ((\[a, b] -> (a, b)) . readWords) . lines) `fmap` getContents
	putStr $ unlines $ map (show . fromMaybe (-1)) $ solve a b queries

import Control.Monad

primes = 2 : sieve [3,5..]
  where
    sieve (x:xs) = x : sieve [y | y <- xs, y `mod` x /= 0]

solve gcd = do
  [l, h] <- fmap (map read . words) getLine
  return $ calc l h gcd primes
  where
    calc :: Integer -> Integer -> Integer -> [Integer] -> Integer
    calc l h g (p:ps)
      | g < l = -1
      | g <= h = g
      | g `mod` p == 0 = calc l h (g `div` p) (p:ps)
      | otherwise = calc l h g ps

main = do
  [a, b] <- fmap (map read . words) getLine
  n <- fmap read getLine
  mapM_ print =<< replicateM n (solve (gcd a b))

import Control.Monad
import Data.List

primes = 2 : sieve [3,5..]
  where
    sieve (x:xs) = x : sieve [y | y <- xs, y `mod` x /= 0]

solve xs = do
  [l, h] <- fmap (map read . words) getLine
  let xs' = takeWhile (<=h) $ dropWhile (<l) xs
  return $ if null xs' then -1 else maximum xs'
  where
    calc :: Integer -> Integer -> Integer -> [Integer] -> Integer
    calc l h g (p:ps)
      | g < l = -1
      | g <= h = g
      | g `mod` p == 0 = calc l h (g `div` p) (p:ps)
      | otherwise = calc l h g ps

gen x =
  rec 1 [] $ factors [] primes x
  where
    rec cur res [] = nub $ cur : res
    rec cur res (x:xs) =
      rec (cur*x) (cur : res ++ rec cur res xs) xs
    factors res (p:ps) x
      | p*p > x = reverse $ x:res
      | x `mod` p == 0 = factors (p:res) (p:ps) (x`div`p)
      | otherwise = factors res ps x

main = do
  [a, b] <- fmap (map read . words) getLine
  n <- fmap read getLine
  print $ gen $ gcd a b
  mapM_ print =<< replicateM n (solve $ sort $ gen $ gcd a b)

import Data.List
import Control.Applicative
default (Int)
f r g m | g `mod` m == 0 = f (m:r) (g `div` m) m
        | g < m^2 = sortBy (flip compare) $
            foldl (\a b -> (*) <$> a <*> (scanl (*) 1 b)) [1] $ (group $ reverse r)
        | otherwise = f r g (m + 1)
main = do
    [a, b] <- (map read . words) `fmap` getLine :: IO [Int]
    n <- read `fmap` getLine
    let divs = f [] (gcd a b) 2
    mapM_ (\_ -> do
        [low, high] <- (map read . words) `fmap` getLine
        case takeWhile (>= low) $ dropWhile (> high) divs of
            h:_ -> print h
            [] -> print (-1)) [1..n]

default (Int)
main = do
    [a, b] <- (map read . words) `fmap` getLine :: IO [Int]
    n <- read `fmap` getLine
    let g = gcd a b
	divs = g: (reverse (filter ((==0).(g `mod`)) $ takeWhile ((<= g).(^2)) [1..]))
    mapM_ (\_ -> do
        [low, high] <- (map read . words) `fmap` getLine
	let h = filter (\x -> x <= high && x >= low) divs
	print $ case h of
	    (h:_) -> h
            [] -> (-1)) [1..n]


This is an interactive problem. In the interaction section below you will see the information about flushing the output.In this problem, you will be playing a game with Hongcow. How lucky of you!Hongcow has a hidden n by n matrix M. Let Mi, j denote the entry i-th row and j-th column of the matrix. The rows and columns are labeled from 1 to n.The matrix entries are between 0 and 109. In addition, Mi, i = 0 for all valid i. Your task is to find the minimum value along each row, excluding diagonal elements. Formally, for each i, you must find .To do this, you can ask Hongcow some questions.A question consists of giving Hongcow a subset of distinct indices {w1, w2, ..., wk}, with 1 ≤ k ≤ n. Hongcow will respond with n integers. The i-th integer will contain the minimum value of min1 ≤ j ≤ kMi, wj.You may only ask Hongcow at most 20 questions — he thinks you only need that many questions answered.When you are ready to answer, print out a single integer  - 1 on its own line, then n integers on the next line. The i-th integer should be the minimum value in the i-th row of the matrix, excluding the i-th element. Do not forget to flush the final answer as well. Printing the answer does not count as asking a question.You will get Wrong Answer verdict if   Your question or answers are not in the format described in this statement.  You ask strictly more than 20 questions.  Your question contains duplicate indices.  The value of k in your question does not lie in the range from 1 to n, inclusive.  Your final answer is not correct.  You will get Idleness Limit Exceeded if you don't print anything or if you forget to flush the output, including for the final answer (more info about flushing output below).

The first line of input will contain a single integer n (2 ≤ n ≤ 1, 000).

To print the final answer, print out the string -1 on its own line. Then, the next line should contain n integers. The i-th integer should be the minimum value of the i-th row of the matrix, excluding elements on the diagonal. Do not forget to flush your answer!

NoteIn the first sample, Hongcow has the hidden matrix [ [0, 3, 2], [5, 0, 7], [4, 8 ,0],]Here is a more readable version demonstrating the interaction. The column on the left represents Hongcow, while the column on the right represents the contestant. 3              3              1 2 30 0 0              1              32 7 0              2              1 20 0 4              1              23 0 8              1              10 5 4              -1              2 5 4For the second sample, it is possible for off-diagonal elements of the matrix to be zero.

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import           Data.ByteString.Char8 (ByteString, getLine, readInt, words)
import           Data.Either
import           Data.Maybe
import           Prelude               hiding (getLine, words)
import           System.IO             hiding (getLine)

getRight::Either String b->b
getRight (Right x) = x
getRight (Left s)  = error s

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

getInt::IO Int
getInt = readInt' <$>  getLine

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

bitsUntil::Int->[Int]
bitsUntil n = takeWhile ((n >=). bit) [0..]

runQuery::Int->[Maybe Int]->(Int, Bool)->IO [Maybe Int]
runQuery n mins (bitN, bitV) = do
  let qi = filter isBit [1..n]
  print (length qi)
  printList qi
  hFlush stdout
  answers <- filterBits <$> getInts
  let res = zipWith mmin mins answers
  return res
  where filterBits = zipWith filterBit [1..n]
        filterBit i x = if testBit i bitN == bitV then Nothing else Just x
        isBit x = testBit x bitN == bitV
        mmin (Just x) (Just y) = Just (min x y)
        mmin mx my             = mplus mx my

printList::Show a=>[a]->IO ()
printList = putStrLn . unwords . map show
----------------------------------------------------------------------------
main :: IO ()
main = do
  n <- getInt
  let qs = (,) <$> bitsUntil n <*> [False, True]
      begin = replicate n Nothing
  answers <- foldM  (runQuery n) begin qs
  putStrLn "-1"
  printList (fmap fromJust answers)

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Array.IArray
import           Data.Bits
import           Data.ByteString.Char8 (ByteString, getLine, readInt, words)
import           Data.Either
import           Data.List             (partition)
import           Data.Maybe
import           Prelude               hiding (getLine, words)
import           System.IO             hiding (getLine)

getRight::Either String b->b
getRight (Right x) = x
getRight (Left s)  = error s

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

getInt::IO Int
getInt = readInt' <$>  getLine

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

bitsUntil::Int->[Int]
bitsUntil n = takeWhile ((n >=). bit) [0..]

queries::Int->[[Int]]
queries n = do
  u <- bitsUntil n
  let (b1, b0) = partition  (`testBit` u) [1..n]
  [b0, b1]

result::Int->Array (Int, Bool, Int) Int->Int->Int
result n vals x = minimum $ fmap value (bitsUntil n) where
       value i = vals ! (i, not (testBit x i), x)
----------------------------------------------------------------------------
main :: IO ()
main = do
  n <- getInt
  let qs = queries n
      m = length qs `quot` 2
  forM_ qs printList
  putStrLn "-1"
  hFlush stdout
  answersList <- join <$> replicateM (m*2) getInts
  let answers = listArray ((0, False, 1), (m - 1, True, n)) answersList
  printList (result n answers <$> [1..n])
  where printList = putStrLn . unwords . map show


You are given an array $$$a_1, a_2, \dots, a_n$$$ consisting of $$$n$$$ distinct integers. Count the number of pairs of indices $$$(i, j)$$$ such that $$$i < j$$$ and $$$a_i \cdot a_j = i + j$$$.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. Then $$$t$$$ cases follow. The first line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 10^5$$$) — the length of array $$$a$$$. The second line of each test case contains $$$n$$$ space separated integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 2 \cdot n$$$) — the array $$$a$$$. It is guaranteed that all elements are distinct. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output the number of pairs of indices $$$(i, j)$$$ such that $$$i < j$$$ and $$$a_i \cdot a_j = i + j$$$.

NoteFor the first test case, the only pair that satisfies the constraints is $$$(1, 2)$$$, as $$$a_1 \cdot a_2 = 1 + 2 = 3$$$For the second test case, the only pair that satisfies the constraints is $$$(2, 3)$$$.For the third test case, the pairs that satisfy the constraints are $$$(1, 2)$$$, $$$(1, 5)$$$, and $$$(2, 3)$$$.

import Control.Monad ( replicateM_ )
import Data.Int ( Int64 )
import Data.List ( sort, tails )

solve :: IO()
solve = do
    n <- readInt64 <$> getLine
    as <- map readInt64 . words <$> getLine
    let ps = sort $ zip as [1..]
    let calc []     = 0
        calc (x:xs) = calc' x xs
        calc' _ [] = 0
        calc' (ai,i) ((bj,j) : bs)
            | ai * bj > 2 * n = 0
            | otherwise       = calc' (ai,i) bs + (if ai * bj == i + j then 1 else 0)
    print $ sum $ map calc $ tails ps

readInt :: String -> Int
readInt = read

readInt64 :: String -> Int64
readInt64 = read

main :: IO()
main = do
    t <- readInt <$> getLine
    replicateM_ t solve

import Control.Monad ( replicateM_ )
import Data.List ( sort, tails )

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

solve :: IO()
solve = do
    n <- readLn::IO Integer
    as <- readInts
    let ps = sort $ zip as [1..]
    let calc []     = 0
        calc (x:xs) = calc' x xs
        calc' _ [] = 0
        calc' (ai,i) ((bj,j) : bs)
            | ai * bj > 2 * n = 0
            | otherwise       = calc' (ai,i) bs + fromEnum (ai * bj == i + j)
    print $ sum $ map calc $ tails ps

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ zip a [1..]
    let calc []     = 0
        calc (x:xs) = calc' x xs
        calc' _ [] = 0
        calc' (ai,i) ((bj,j) : bs)
            | ai * bj > 2 * n = 0
            | otherwise       = calc' (ai,i) bs + fromEnum (ai * bj == i + j)
    print $ sum $ map calc $ tails b

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ zip a [1..]
    let fori [x] = 0
        fori (x:xs) = fori xs + forj x xs
        forj x [] = 0
        forj x (u:xs)
            | (fst x)*(fst u) > 2*n = 0
            | otherwise = forj x xs + if (fst x)*(fst u) == (snd x + snd u) then 1 else 0
    print $ fori b

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

genPair [] i = []
genPair (x:xs) i = (x,i) : (genPair xs (i+1))

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ genPair a 1
    let fori [x] = 0
        fori (x:xs) = fori xs + forj x xs
        forj x [] = 0
        forj x (u:xs)
            | (fst x)*(fst u) > 2*n = 0
            | otherwise = forj x xs + if (fst x)*(fst u) == (snd x + snd u) then 1 else 0
    print $ fori b

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

genPair [] i = []
genPair (x:xs) i = (x,i) : (genPair xs (i+1))

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ genPair a 1
    print $ fori b n
    where
        fori [x] n = 0
        fori (x:xs) n = fori xs n + forj x xs n

        forj x [] n = 0
        forj x (u:xs) n
            | (fst x)*(fst u) > 2*n = 0
            | otherwise = forj x xs n + if (fst x)*(fst u) == (snd x + snd u) then 1 else 0

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

genPair [] i = []
genPair (x:xs) i = (x,i) : (genPair xs (i+1))

fori [x] n = 0
fori (x:xs) n = fori xs n + forj x xs n

forj x [] n = 0
forj x (u:xs) n
    | (fst x)*(fst u) > 2*n = 0
    | otherwise = forj x xs n + if (fst x)*(fst u) == (snd x + snd u) then 1 else 0

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ genPair a 1
    print $ fori b n

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

-- author https://codeforces.com/contest/1541/submission/120631973

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

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

genPair [] i = []
genPair (x:xs) i = (x,i) : (genPair xs (i+1))

fori [x] n r = 0
fori (x:xs) n r = fori xs n r + forj x xs n r

forj x [] n r = r
forj x (u:xs) n r
    | (fst x)*(fst u) > 2*n = r
    | otherwise = (forj x xs n (r + if (fst x)*(fst u) == (snd x + snd u) then 1 else 0))

each = do
    n<-readLn::IO Integer
    a<-readInts
    let b = sort $ genPair a 1
    print $ fori b n 0

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

--{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
--import Data.Char as C

--import Data.IntSet as S

cntPairs :: [(Int, Int)] -> (Int, Int) -> Int
cntPairs l (i, x) =
  length $ filter (\(j, y) -> i + j == x * y) $ takeWhile (\(j,y) -> y < x && x*y <= 2000000) l

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  sxs <- getLine
  let xs = map read $ words sxs :: [Int]
      vals = sortBy (\(_,x) (_,y) -> compare x y) $ zip [1..] xs
      pairs = sum $ map (cntPairs vals) vals
    in print pairs

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

--{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
--import Data.Char as C

--import Data.IntSet as S

cntPairs :: [(Integer, Integer)] -> (Integer, Integer) -> Int
cntPairs l (i, x) =
  length $ filter (\(j, y) -> i + j == x * y) $ takeWhile (\(j,y) -> y < x && x*y <= 2000000) l

solve :: IO ()
solve = do
  n <- readLn :: IO Integer
  sxs <- getLine
  let xs = map read $ words sxs :: [Integer]
      vals = sortBy (\(_,x) (_,y) -> compare x y) $ zip [1..] xs
      pairs = sum $ map (cntPairs vals) vals
    in print pairs

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

-- cheese-cracker: cheese-cracker.github.io
import Control.Monad
import Data.List as L
import Data.Maybe (fromJust)
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

readInts :: IO [Int]
readInts =  (map (fromInteger . fst . fromJust. BS.readInteger) . BS.words) <$> BS.getLine

getOrInf :: Int -> M.Map Int Int -> Int
getOrInf keyy haystack
    | needle == Nothing = -2000000
    | otherwise = fromJust needle
    where needle = M.lookup keyy haystack

solve :: Int -> [Int] -> Int
solve n xs =
    let
    ixmap = M.fromList $ zip xs [1..]
    condn k summ =  (getOrInf k ixmap) + (getOrInf (summ `div` k) ixmap) == summ
    takeflour = floor . sqrt . fromIntegral
    res till = [x | m <- [1..till], x <- [1.. (takeflour $ m-1)], (m `mod` x == 0) && condn x m]
    in length $ res (2*n)

main :: IO ()
main = do
    [t] <- readInts
    replicateM_ t $ do
        [n] <- readInts
        arr <- readInts
        print(solve n arr)

import Control.Monad
import Data.Array
readInts = fmap (map read.words) getLine :: IO [Int]

count a i n = length [1|p<-[ai,2*ai..2*n],let aj = div p ai,let j = p - i,j > i && j <= n && a!j == aj]
                where ai=a!i

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let aa = listArray (1,n) a
        r = sum [count aa i n|i<-[1..n]]
    print r

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

-- cheese-cracker: cheese-cracker.github.io
import Control.Monad
import Data.List as L
import Data.Maybe (fromJust)
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

readInts :: IO [Int]
readInts =  (map (fromInteger . fst . fromJust. BS.readInteger) . BS.words) <$> BS.getLine

getOrInf :: Int -> M.Map Int Int -> Int
getOrInf keyy haystack
    | needle == Nothing = -2000000
    | otherwise = fromJust needle
    where needle = M.lookup keyy haystack

solve :: Int -> [Int] -> Int
solve n xs =
    let
    ixmap = M.fromList $ zip xs [1..]
    condn k summ =  (getOrInf k ixmap) + (getOrInf (summ `div` k) ixmap) == summ
    takeflour = floor . sqrt . fromIntegral
    res till = [x | m <- [1..till], x <- [1.. takeflour m], (m `mod` x == 0) && condn x m]
    in length $ res (2*n)

main :: IO ()
main = do
    [t] <- readInts
    replicateM_ t $ do
        [n] <- readInts
        arr <- readInts
        print(solve n arr)


You have been blessed as a child of Omkar. To express your gratitude, please solve this problem for Omkar!An array $$$a$$$ of length $$$n$$$ is called complete if all elements are positive and don't exceed $$$1000$$$, and for all indices $$$x$$$,$$$y$$$,$$$z$$$ ($$$1 \leq x,y,z \leq n$$$), $$$a_{x}+a_{y} \neq a_{z}$$$ (not necessarily distinct).You are given one integer $$$n$$$. Please find any complete array of length $$$n$$$. It is guaranteed that under given constraints such array exists.

Each test contains multiple test cases. The first line contains $$$t$$$ ($$$1 \le t \le 1000$$$)  — the number of test cases. Description of the test cases follows. The only line of each test case contains one integer $$$n$$$ ($$$1 \leq n \leq 1000$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$.

For each test case, print a complete array on a single line. All elements have to be integers between $$$1$$$ and $$$1000$$$ and for all indices $$$x$$$,$$$y$$$,$$$z$$$ ($$$1 \leq x,y,z \leq n$$$) (not necessarily distinct), $$$a_{x}+a_{y} \neq a_{z}$$$ must hold. If multiple solutions exist, you may print any.

NoteIt can be shown that the outputs above are valid for each test case. For example, $$$44+44 \neq 384$$$.Below are some examples of arrays that are NOT complete for the 1st test case:$$$[1,2,3,4,5]$$$ Notice that $$$a_{1}+a_{2} = a_{3}$$$.$$$[1,3000,1,300,1]$$$ Notice that $$$a_{2} = 3000 > 1000$$$.

{-# LANGUAGE Safe #-}

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

main :: IO ()
main =  interact $  lines >>> drop 1 >>> map read >>> map (\n-> unwords (map show (take n (repeat 1000)))) >>>  unlines

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

main = getLine >>= flip replicateM_ (getLine >>= putStrLn . unwords . map show . flip replicate 1 . read) . read

main :: IO ()
main = interact (unlines . map (unwords . map show . solve . read) . tail . lines)

solve :: Int -> [Int]
solve n = replicate n 1

import Control.Monad
main = read <$> getLine >>= flip replicateM (read <$> getLine) >>= mapM_ (putStrLn . unwords . map show . flip replicate 1)

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

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show $ replicate x 1

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

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

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show $ replicate x '1'

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


The Little Elephant has got a problem — somebody has been touching his sorted by non-decreasing array a of length n and possibly swapped some elements of the array.The Little Elephant doesn't want to call the police until he understands if he could have accidentally changed the array himself. He thinks that he could have accidentally changed array a, only if array a can be sorted in no more than one operation of swapping elements (not necessarily adjacent). That is, the Little Elephant could have accidentally swapped some two elements.Help the Little Elephant, determine if he could have accidentally changed the array a, sorted by non-decreasing, himself.

The first line contains a single integer n (2 ≤ n ≤ 105) — the size of array a. The next line contains n positive integers, separated by single spaces and not exceeding 109, — array a. Note that the elements of the array are not necessarily distinct numbers.

In a single line print "YES" (without the quotes) if the Little Elephant could have accidentally changed the array himself, and "NO" (without the quotes) otherwise.

NoteIn the first sample the array has already been sorted, so to sort it, we need 0 swap operations, that is not more than 1. Thus, the answer is "YES".In the second sample we can sort the array if we swap elements 1 and 3, so we need 1 swap operation to sort the array. Thus, the answer is "YES".In the third sample we can't sort the array in more than one swap operation, so the answer is "NO".

import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  _ <- getLine
  xs <- map readInt.B.words <$> B.getLine
  case filter id $ zipWith (/=) xs $ sort xs of
    [] -> putStrLn "YES"
    [True,True] -> putStrLn "YES"
    _ -> putStrLn "NO"

import Data.List(sort)
main = do
    _ <- getLine
    a <- fmap (\x -> map (read::String->Int) $ words x) getLine
    let s = sort a
        slv = zipWith (/=) a s
        num = length $ filter (id) slv

    case num of
        2   -> do putStrLn"YES"
        0   -> do putStrLn"YES"
        _   -> do putStrLn"NO"
    return ()

import Data.List (sort)

main = do
    getLine
    a <- fmap (map read . words) getLine :: IO [Int]
    let cnt = length $ filter id $ zipWith (/=) a $ sort a
    putStrLn $ if cnt <= 2 then "YES" else "NO"

import Data.List (sort)
main = interact $ f . map read . words . last . lines
f :: [Integer] -> String
f x
  | l1 <= 2 = "YES"
  | otherwise = "NO"
  where l1 = length $ filter (\(i,j) -> i/=j) $ zip x (sort x)

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    bs = sort as
    c = length $ filter (== True) $ zipWith (/=) as bs

  putStrLn $ if c == 2 || c == 0 then "YES" else "NO"

import List (sort)

solve :: [Int] -> Bool
solve xs  =  solve' 0 xs (sort xs)
  where
    solve' n [] _  =  n <= 2
    solve' n (x:xs) (y:ys)
      | x == y  =  solve' n xs ys
      | n == 2  =  False
      | otherwise  =  solve' (n+1) xs ys

main :: IO ()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    putStrLn $ if solve xs then "YES" else "NO"

import Data.List

solve :: [Int] -> String
solve xs = if x == 0 || x == 2 then "YES" else "NO"
  where x = length $ filter (\(x, y) -> x /= y) $ zip xs $ sort xs

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

import Control.Applicative
import Data.List

solve :: [Int] -> String
solve vals =
  if solvable then "YES" else "NO"
  where
    solvable = (length $ filter id $ zipWith (/=) vals (sort vals)) <= 2

main = do
  getLine
  vals <- map read . words <$> getLine
  putStrLn $ solve vals

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f [] [] count = count
f (a:ax) (b:bx) count = f ax bx ( if a /= b then count+1 else count )

import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Applicative
readInt bs = case B.readInt bs of Just (n,_) -> n
main = do
  _ <- getLine
  xs <- map readInt.B.words <$> B.getLine
  let count = length $ filter id $ zipWith (/=) xs $ sort xs
      answer = if count <= 2 then "YES" else "NO"
      in putStrLn answer

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = solver a b
      in putStrLn ( if k <= 2 then "YES" else "NO" )

solver a b = f a b 0
f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if or [null a, null b]
     then count
     else f (tail a) (tail b) ff
       where ff = if head a /= head b then count+1 else count

import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in putStrLn (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

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

main = do
  _ <- getLine
  xs <- fmap (map read . words) getLine :: IO [Int]
  let count = length $ filter id $ zipWith (/=) xs $ sort xs
      answer = if count <= 2 then "YES" else "NO"
      in putStrLn answer

import Data.List
import Data.Char
import qualified Data.Set as Set
import Control.Monad
import Control.Applicative
main = do
  n <- getLine
  s <- getLine
  let xs = map read (words s) :: [Int]
    in putStrLn (solve xs)

solve xs = if (f xs (sort xs) 0) <= 2 then "YES" else "NO"
  where
    f [] [] acc = acc
    f (x:xs) (y:ys) acc = f xs ys (if x /= y then acc+1 else acc)

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b =
  if or [null a, null b]
     then 0
     else ff + f (tail a) (tail b)
       where ff = if head a /= head b then 1 else 0

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      in putStrLn ( if (f a (sort a) 0) <= 2 then "YES" else "NO" )

f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

import Data.Functor
import Data.List

main :: IO ()
main = do
  getLine
  ns <- map read . words <$> getLine
  if diff ns (sort ns) <= 2
    then putStrLn "YES"
    else putStrLn "NO"

diff :: [Int] -> [Int] -> Int
diff xs ys = length $ filter (uncurry (/=)) $ zip xs ys

import Data.List
g(_:l)|length(filter id$zipWith(/=)l(sort l))>2="NO"|1>0="YES"
main=interact$g.map((+0).read).words

import Data.List

f True = "YES"
f False = "NO"

main = getLine >> do
          xs <- (((map read).words) `fmap` getLine) :: IO [Int]
          putStrLn $ f $ (<=2) $ length $ filter id $ zipWith (/=) (sort xs) xs

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already | Switch Int Int Int
data Last = One Int | Mul Int Int

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (3-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap u (x:y:[]) (One l)  None | x>y = return $ y>= l
swap u (x:y:[]) (Mul i l)  None | x>y = return $ y>= l

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) i  Already | x>y =  return False

swap u (x:y:xs) i None | x>y =  case (y>=(getLast i)) of
                               True -> case xs of
                                  []  -> return True
                                  (z:zs) | z>=x -> swap' u (z:zs) (One x) $ Switch (getN i) y x
                                  (z:zs) | otherwise -> case i of
                                             Mul n _ ->  case (n==x) of
                                                          True -> return False
                                                          False -> swap' u (y:xs) i $ Value n x y
                                             One n -> swap' u (y:xs) i $ Value n x y
                               False -> return False

swap u (x:y:xs) i (Switch bInf a b) | x>y = return $  (b>=x)&&(y<=a)&&(y>=bInf)

swap u (x:y:xs) i p@(Value bInf v bSup) | x>y = case ((y>=bInf) && (y<=bSup) && (v>=(getN i))) of
                                               False -> return False
                                               True -> swap' u (v:xs) (One x) Already

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) i (Value bInf v bSup) = return $  ((bSup==(getN i))&&(v<=x)) || ((v>(getN i)) && (x>=bInf) && (x<= bSup))
swap u (x:[]) i p = return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

getLast (One n) = n
getLast (Mul n l) = l

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (2-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) p  Already | x>y =  return False

swap u (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap' u (y:xs) last $ Value l x y
                                    False -> return False

swap u (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap' u (v:xs) (One x) Already
                                                  False ->  return False

swap u (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap' u (y:xs) (Mul n l) $ Value n x y
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap' u (x:xs) (Mul n l) Already
                                            False -> return False

swap u (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap' u  (v:xs) (Mul n l) Already
                                                  False ->  return False

swap u (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap' u (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap' u (v:y:xs) i Already
                                          False -> return False

swap u (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap' u (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap' u (v:y:xs) i Already
                                          False -> return False

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) (Mul n l) (Value bInf v bSup) = return $ (l<=bSup) && (v>=n)
swap u (x:[]) (One l) (Value bInf v bSup) = return $ ((x>=v) && (bSup==l)) || ((v>=l)&&(x>=bInf)&&(x<=bSup))
swap u (x:[]) i p = case p of
                   (Value bInf v bSup) -> return $  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap (y:xs) (Mul n l) p
                                      False -> swap (y:xs) (Mul x n) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap (y:xs) (Mul n l) $ Value n x y -- 3 9 [9 4] 10
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap (x:xs) (Mul n l) Already
                                            False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap (y:xs) (Mul n l) p
                              False ->  swap (y:xs) (One x) p

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) (Mul n l) (Value bInf v bSup) = (l<=bSup) && (v>=n)
swap (x:[]) (One l) (Value bInf v bSup) = ((x>=v) && (bSup==l)) || ((v>=l)&&(x>=bInf)&&(x<=bSup))
swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import qualified Data.ByteString.Char8 as B
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  case filter id $ zipWith (/=) [1..n] xs of
    [] -> putStrLn "YES"
    [True,True] -> putStrLn "YES"
    _ -> putStrLn "NO"

import Data.List(sort)
main = do
    _ <- getLine
    a <- fmap (\x -> map (read::String->Int) $ words x) getLine
    let s = sort a
        slv = zipWith (/=) a s
        num = length $ filter (id) slv

    case num of
        2   -> do putStrLn"YES"
        _   -> do putStrLn"NO"
    return ()

import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in putStrLn $ show (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null ax || null bx
     then count
     else f ax bx ( if a /= b then count+1 else count )
       where ax = tail a
	     bx = tail b

import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in print (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null ax || null bx
     then ff
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if a /= b then count+1 else count

import List
g(_:l)|length(filter id$zipWith(==)l(sort l))>2="NO"|1>0="YES"
main=interact$g.map((+0).read).words

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already | Switch Int Int Int
data Last = One Int | Mul Int Int

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (3-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap u (x:y:[]) (One l)  None | x>y = return $ y>= l
swap u (x:y:[]) (Mul i l)  None | x>y = return $ y>= l

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) i  Already | x>y =  return False

swap u (x:y:xs) i None | x>y =  case (y>=(getLast i)) of
                               True -> case xs of
                                  []  -> return True
                                  (z:zs) | z>=x -> swap' u (z:zs) (One x) $ Switch (getN i) y x
                                  (z:zs) | otherwise -> case i of
                                             Mul n _ ->  case (n==x) of
                                                          True -> return False
                                                          False -> swap' u (y:xs) i $ Value n x y
                                             One n -> swap' u (y:xs) i $ Value n x y
                               False -> return False

swap u (x:y:xs) i (Switch bInf a b) | x>y = return $  (b>=x)&&(y<=a)&&(y>=bInf)

swap u (x:y:xs) i p@(Value bInf v bSup) | x>y = case ((y>=bInf) && (y<=bSup) && (v>=(getN i))) of
                                               False -> return False
                                               True -> swap' u (v:xs) (One x) Already

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) i (Value bInf v bSup) = return $ (v>(getN i)) && (x>=bInf) && (x<= bSup)
swap u (x:[]) i p = return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

getLast (One n) = n
getLast (Mul n l) = l

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) x None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) x Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap (y:xs) (Mul n l) p
                                      False -> swap (y:xs) (Mul x n) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap (y:xs) (Mul n l) $ Value n x y -- 3 9 [9 4] 10
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap (x:xs) (Mul n l) Already
                                            False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap (y:xs) (Mul n l) p
                              False ->  swap (y:xs) (One x) p

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) (Mul n l) (Value bInf v bSup) = (l<=bSup) && (v>=n)
swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = swap(y:xs) x p

swap (x:y:xs) i p | x>y = case p of
                          None -> swap (y:xs) i $ Value i x y
                          Already -> False
                          (Value bInf v bSup) -> case  ((x<=x) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False

swap (x:y:xs) i p = swap (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>=i)

swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)
import System.IO.Unsafe(unsafePerformIO)

main :: IO ()
main = do
         nbS <- getLine
         let res = swap (getNumbers (read $ nbS :: Int)) 0 None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  unsafePerformIO $ do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = []
getNumbers n = case getNumber of
                 Nothing -> []
                 Just num ->  num:(getNumbers(n-1))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

--Value 0 2 1
--1 2 1

--2>=1   2<=2  1>=0  1<=1

--1 2 2 1

-- v==y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                True -> swap (y:xs) i p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                True -> swap (y:xs) i p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num ->  (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) x Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul i l) p | (x==y) = swap (y:xs) (Mul i l) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= l) of
                                           True -> swap (x:xs) (Mul n y) $ Already -- 3 9 [9 4] 10
                                           False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=v)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True


Pig is visiting a friend.Pig's house is located at point 0, and his friend's house is located at point m on an axis.Pig can use teleports to move along the axis.To use a teleport, Pig should come to a certain point (where the teleport is located) and choose where to move: for each teleport there is the rightmost point it can move Pig to, this point is known as the limit of the teleport.Formally, a teleport located at point x with limit y can move Pig from point x to any point within the segment [x; y], including the bounds.  Determine if Pig can visit the friend using teleports only, or he should use his car.

The first line contains two integers n and m (1 ≤ n ≤ 100, 1 ≤ m ≤ 100) — the number of teleports and the location of the friend's house. The next n lines contain information about teleports. The i-th of these lines contains two integers ai and bi (0 ≤ ai ≤ bi ≤ m), where ai is the location of the i-th teleport, and bi is its limit. It is guaranteed that ai ≥ ai - 1 for every i (2 ≤ i ≤ n).

Print "YES" if there is a path from Pig's house to his friend's house that uses only teleports, and "NO" otherwise. You can print each letter in arbitrary case (upper or lower).

NoteThe first example is shown on the picture below:  Pig can use the first teleport from his house (point 0) to reach point 2, then using the second teleport go from point 2 to point 3, then using the third teleport go from point 3 to point 5, where his friend lives.The second example is shown on the picture below:  You can see that there is no path from Pig's house to his friend's house that uses only teleports.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bool
import Data.Array.Unboxed

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  ts <- replicateM n $ liftM2 (,) poi poi
  return $ bool "NO" "YES" $ solve m ts
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve m = all (> 0) . (elems :: UArray Int Int -> [Int]) . accumArray (+) 0 (1, m) . concatMap (\(l, r) -> zip [l + 1..r] (repeat 1))

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import Control.Monad
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol ([_,m]:ts) = [ sol' 0 m ts ]

sol' :: Int -> Int -> [[Int]] -> String
sol' _ _ [] = "NO"
sol' p m ([f,w]:ts)
  | p < f     = "NO"
  | p' >= m   = "YES"
  | otherwise = sol' p' m ts
  where p' = max p w

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bool
import Data.Array.Unboxed

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  ts <- replicateM n $ liftM2 (,) poi poi
  return $ bool "NO" "YES" $ solve m ts
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve m = all (> 0) . (elems :: UArray Int Int -> [Int]) . accumArray (+) 0 (0, m) . concatMap (\(l, r) -> zip [l..r] (repeat 1))


We're giving away nice huge bags containing number tiles! A bag we want to present to you contains $$$n$$$ tiles. Each of them has a single number written on it — either $$$1$$$ or $$$2$$$.However, there is one condition you must fulfill in order to receive the prize. You will need to put all the tiles from the bag in a sequence, in any order you wish. We will then compute the sums of all prefixes in the sequence, and then count how many of these sums are prime numbers. If you want to keep the prize, you will need to maximize the number of primes you get.Can you win the prize? Hurry up, the bags are waiting!

The first line of the input contains a single integer $$$n$$$ ($$$1 \leq n \leq 200\,000$$$) — the number of number tiles in the bag. The following line contains $$$n$$$ space-separated integers $$$a_1, a_2, \dots, a_n$$$ ($$$a_i \in \{1, 2\}$$$) — the values written on the tiles.

Output a permutation $$$b_1, b_2, \dots, b_n$$$ of the input sequence $$$(a_1, a_2, \dots, a_n)$$$ maximizing the number of the prefix sums being prime numbers. If there are multiple optimal permutations, output any.

NoteThe first solution produces the prefix sums $$$1, \mathbf{\color{blue}{2}}, \mathbf{\color{blue}{3}}, \mathbf{\color{blue}{5}}, \mathbf{\color{blue}{7}}$$$ (four primes constructed), while the prefix sums in the second solution are $$$1, \mathbf{\color{blue}{2}}, \mathbf{\color{blue}{3}}, \mathbf{\color{blue}{5}}, 6, \mathbf{\color{blue}{7}}, 8, 10, \mathbf{\color{blue}{11}}$$$ (five primes). Primes are marked bold and blue. In each of these cases, the number of produced primes is maximum possible.

import Control.Monad

main :: IO ()
main = do
  _        <- read <$> getLine :: IO Int
  (oc, tc) <-
    foldl (\(a, b) x -> if x == "1" then (a + 1, b) else (a, b + 1)) (0, 0)
    .   words
    <$> getLine :: IO (Int, Int)
  when (oc == 0) $ replicateM_ tc $ putStr "2 "
  when (tc == 0) $ replicateM_ oc $ putStr "1 "
  when (oc > 0 && tc > 0) $ do
    putStr "2 1 "
    replicateM_ (tc - 1) $ putStr "2 "
    replicateM_ (oc - 1) $ putStr "1 "
  putStrLn ""

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  num1 <- length . filter (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  putStrLn $ intersperse ' '
    $ if | num1 == n -> replicate n '1'
         | num1 == 0 -> replicate n '2'
         | otherwise -> "21" ++ replicate (n - num1 - 1) '2'
                        ++ replicate (num1 - 1) '1'

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

main = interact $ concat.(map (\x -> x++" ")).(map show).helper.(map read).words where helper (x:xs) = if (a>0 && b>0) then 2:1:(replicate (b-1) 2 ++ replicate (a-1) 1) else(replicate b 2 ++ replicate a 1) where (a, b) = (length [0|s<-xs,s==1], length [0|s<-xs,s==2])

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  num1 <- length . filter (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  putStrLn $ intersperse ' '
    $ if | num1 == n -> replicate n '1'
         | num1 == 1 -> replicate n '2'
         | otherwise -> "21" ++ replicate (n - num1 - 1) '2'
                        ++ replicate (num1 - 1) '1'

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


In Summer Informatics School, if a student doesn't behave well, teachers make a hole in his badge. And today one of the teachers caught a group of $$$n$$$ students doing yet another trick. Let's assume that all these students are numbered from $$$1$$$ to $$$n$$$. The teacher came to student $$$a$$$ and put a hole in his badge. The student, however, claimed that the main culprit is some other student $$$p_a$$$.After that, the teacher came to student $$$p_a$$$ and made a hole in his badge as well. The student in reply said that the main culprit was student $$$p_{p_a}$$$.This process went on for a while, but, since the number of students was finite, eventually the teacher came to the student, who already had a hole in his badge.After that, the teacher put a second hole in the student's badge and decided that he is done with this process, and went to the sauna.You don't know the first student who was caught by the teacher. However, you know all the numbers $$$p_i$$$. Your task is to find out for every student $$$a$$$, who would be the student with two holes in the badge if the first caught student was $$$a$$$.

The first line of the input contains the only integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of the naughty students. The second line contains $$$n$$$ integers $$$p_1$$$, ..., $$$p_n$$$ ($$$1 \le p_i \le n$$$), where $$$p_i$$$ indicates the student who was reported to the teacher by student $$$i$$$.

For every student $$$a$$$ from $$$1$$$ to $$$n$$$ print which student would receive two holes in the badge, if $$$a$$$ was the first student caught by the teacher.

NoteThe picture corresponds to the first example test case.  When $$$a = 1$$$, the teacher comes to students $$$1$$$, $$$2$$$, $$$3$$$, $$$2$$$, in this order, and the student $$$2$$$ is the one who receives a second hole in his badge.When $$$a = 2$$$, the teacher comes to students $$$2$$$, $$$3$$$, $$$2$$$, and the student $$$2$$$ gets a second hole in his badge. When $$$a = 3$$$, the teacher will visit students $$$3$$$, $$$2$$$, $$$3$$$ with student $$$3$$$ getting a second hole in his badge.For the second example test case it's clear that no matter with whom the teacher starts, that student would be the one who gets the second hole in his badge.

import qualified Data.Map as Map
import qualified Data.Set as Set

f2::Int->Set.Set Int->Map.Map Int Int->Int
f2 n ss ms
   |Set.member n ss=n
   |otherwise=let Just n2=Map.lookup n ms
              in f2 n2 (Set.insert n ss) ms

f::Int->Map.Map Int Int->Int
f n ms=let Just n2=Map.lookup n ms
       in n2

main = do
       e<-getLine
       es<-getLine
       let xs=map read (words es)::[Int]
           n=read e::Int
           ms=Map.fromList $ zip [(1::Int)..n] xs
       putStrLn $ unwords $ map show $ [f2 (f h ms) (Set.fromList [h]) ms|h<-[1..n]]

import Data.Bits
import Data.Array
main = do
  n <- readLn
  ps <- listArray (1,n) . map read . words <$> getLine
  let go cl i | testBit cl i = i
              | otherwise = go (setBit cl i) (ps ! i)
  putStrLn $ unwords $ map (show . go (0 :: Integer)) (indices ps)

module Main where

import           Control.Monad (forM_)
import           Data.Array
import           Data.Functor  ((<$>))
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: Array Int Int -> Int -> Int
findStudent ps a = go ps a (S.singleton a)
  where
    go ps i set =
      let nextStudent = ps ! i
       in if nextStudent `S.member` set
            then nextStudent
            else go ps nextStudent (S.insert nextStudent set)

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- listArray (1, n) <$> getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)

{-# LANGUAGE TupleSections #-}

import Data.Maybe
import Data.Array.IArray
import Data.List

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

solve :: Int -> Array Int Int -> [Int]
solve n a = map f [1..n] where
	f :: Int -> Int
	f x = ans where
		xs = take (succ n) $ iterate (a!) x
		c = accumArray (+) 0 (1, n) $ map (,1) xs :: Array Int Int
		ans = fromJust $ find ((> 1) . (c!)) xs

main :: IO ()
main = do
	[n] <- iogetints
	xs <- iogetints
	putStrLn $ intercalate " " $ map show $ solve n $ listArray (1, n) xs

module Main where

import           Control.Monad (forM_)
import           Data.Functor  ((<$>))
import           Data.List     (foldl')
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: [Int] -> Int -> Int
findStudent ps a = go ps (S.singleton a)
  where
    go (p:ps) set
      | p `S.member` set = p
      | otherwise = go ps (S.insert p set)

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)

module Main where

import           Control.Monad (forM_)
import           Data.Functor  ((<$>))
import           Data.List     (foldl')
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: [Int] -> Int -> Int
findStudent ps a = go ps (S.singleton a) a False
  where
    go _ _ res True = res
    go (p:ps) set res _
      | p `S.member` set = go ps set p True
      | otherwise = go ps (S.insert p set) res False

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)