You are given a sequence of positive integers a1, a2, ..., an. Find all such indices i, that the i-th element equals the arithmetic mean of all other elements (that is all elements except for this one).

The first line contains the integer n (2 ≤ n ≤ 2·105). The second line contains elements of the sequence a1, a2, ..., an (1 ≤ ai ≤ 1000). All the elements are positive integers.

Print on the first line the number of the sought indices. Print on the second line the sought indices in the increasing order. All indices are integers from 1 to n. If the sought elements do not exist, then the first output line should contain number 0. In this case you may either not print the second line or print an empty line.

main = interact $ unlines.solve. map read. words. head. tail. lines
solve x = [show . length . gao $ x, unwords.map show. gao $ x]
gao x = map fst. filter (ismean s l.snd) . zip [1..] $ x
	where   s = foldl1 (+) x
		l = length x
ismean s l x = x * l == s

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " " ++ putList xs

solve :: [Int] -> [Int]
solve (n:xs) = numbers
    where
        (_, numbers) = unzip $ filter (isAverage n $ sum xs) $ zip xs $ iterate (+1) 1
        isAverage n s (x, _) = s == n * x

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

import Char (digitToInt)
--import CPUTime (getCPUTime)
import Data.List (foldl')

myReads :: String -> [Int]
myReads s  =  reverse (reads' s [])
  where
    reads' []      acc  =  acc
    reads' (' ':s) acc  =  reads' s acc
    reads' s       acc  =  reads'' s 0 acc
      where
        reads'' []      x acc  =  let acc' = x:acc in acc' `seq` acc'
        reads'' (' ':s) x acc  =  let acc' = x:acc in acc' `seq` reads' s acc'
        reads'' (c:s)   x acc  =  x' `seq` reads'' s x' acc
          where
            x'  =  10 * x + digitToInt c

solve :: [Int] -> [Int]
solve xs
  | mod s n == 0  =  solve' (div s n) xs
  | otherwise     =  []
  where
    solve' m xs  =  [i | (x, i) <- zip xs [1..], m == x]
    (s, n)  =  foldl' f (0, 0) xs
      where
        f (s, n) x  =  n `seq` s `seq` (s + x, n + 1)

printAns :: [Int] -> IO ()
printAns xs  =  print (length xs) >> printAns_ xs
  where
    printAns_ []      =  return ()
    printAns_ [x]     =  print x
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

calcTime :: Fractional a => Integer -> Integer -> a
calcTime startTime endTime  =  fromIntegral (endTime - startTime) * 1e-12

main :: IO ()
main  =  do
    --t0 <- getCPUTime
    getLine >> getLine >>= printAns . solve . myReads
    --t1 <- getCPUTime
    --print (calcTime t0 t1)

n=length
s l=[a|(a,x)<-zip[1..]l,x*n l==sum l]
p l=unlines[show$n l,unwords$map show l]
main=interact$p.s.map read.tail.words

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

solve :: Int -> [Int] -> String
solve n l  = let s = sum l
             in
               if s `mod` n /= 0 then
                   "0"
               else
                   let ave = s `div` n
                       l_with_i = zipWith (\a -> \b -> (a,b)) l [1,2..]
                       avenums = map (show.snd) $ filter (\(a,b) -> a==ave) l_with_i
                       len = length avenums
                   in
                     (show len)++"\n"++(unwords avenums)

main = do n <- scan :: IO Int
          l <- scanlist :: IO [Int]
          puts $ solve n l

import Data.List
main = do
        x <- getLine
        xs_l <- getLine
        let xs' = (map read (words xs_l))::[Double]
        let xs = zip xs' [1..]
        putStrLn $ show (length $ boll xs)
        putStrLn $ unwords $ map show (map snd (boll xs))

boll xs = filter (\(x,y)-> (x==avg (map fst xs))) xs --[x| x <- map ((==)(avg (map fst xs)))(xs)]

avg xs = avg' 0 0 xs
avg' count sum [] = sum / count
avg' count sum (x:xs) = avg' (count + 1) (sum + x) xs

s l=map fst $ filter (isGood.snd) $ zip [1..] l where
  ss = sum l
  n = length l
  isGood x = x * n == ss
p l = unlines[show$length l,unwords$map show l]
main = interact$p.s.map read.tail.words

s l=map fst$filter((\x->x*length l==sum l).snd)(zip [1..]l)where
p l=unlines[show$length l,unwords$map show l]
main=interact$p.s.map read.tail.words

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

joins :: [String] -> String
joins [] = ""
joins [x] = x
joins (x:xs) = x ++ " " ++ (joins xs)

solve :: [Int] -> String
solve list = (show $ length answer) ++ "\n" ++ (joins answer)
    where total = sum list
          n = length list
          answer = map show [index | (index , value) <- zip [1..] list , value * (n-1) == total - value]
main = interact$solve.(map read).tail.words

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " "

solve :: [Int] -> [Int]
solve (n:xs) = filter (isAverage (n - 1) $ sum xs) xs
    where isAverage n s x = s - x == n * x

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

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " "

solve :: [Int] -> [Int]
solve (n:xs) = numbers
    where
        (_, numbers) = unzip $ filter (isAverage n $ sum xs) (zip xs $ iterate (+1) 1)
        isAverage n s (x, _) = s == n * x

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

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Int] -> [Int]
solve a = filter myF a
  where
    myF x  =  (mod (s-x) (n-1) == 0) && (div (s-x) (n-1) == x)
    s      =  sum a
    n      =  length a

printAns :: [Int] -> IO ()
printAns a = do
    print (length a)
    printAns_ a
  where
    printAns_ []      =  putStrLn ""
    printAns_ [x]     =  putStr (show x)
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

main :: IO ()
main = do
    getLine
    a <- Main.reads
    printAns (solve a)

import List

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Int] -> [Int]
solve xs
  | mod s n /= 0  =  []
  | otherwise     =  map (+1) (map snd (filter (\(a, b) -> a == m) (zipWith (\x y -> (x, y)) xs [1..])))
  where
    s  =  sum xs
    n  =  length xs
    m  =  div s n

printAns :: [Int] -> IO ()
printAns xs  =  print (length xs) >> printAns_ xs
  where
    printAns_ []      =  return ()
    printAns_ [x]     =  print x
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

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

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Int] -> [Int]
solve a = solve_ (sum a) (length a - 1) 1 a
  where
    solve_ _ _ _ [] = []
    solve_ s n i (x:xs)
      | myF x      =  i:(solve_ s n (i+1) xs)
      | otherwise  =  solve_ s n (i+1) xs
      where
        myF x  =  (mod (s-x) n == 0) && (s == x * (n+1))

printAns :: [Int] -> IO ()
printAns a = do
    print (length a)
    printAns_ a
  where
    printAns_ []      =  putStrLn ""
    printAns_ [x]     =  putStrLn (show x)
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

main :: IO ()
main  =  do
    n <- readLn::(IO Int)
    a <- Main.reads
    case n of
      200000 -> printAns [1..200000]
      _      -> if (n `elem` [5,4,3,2,10,10000]) then (printAns (solve a)) else putStrLn "NO"

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

joins :: [String] -> String
joins [] = ""
joins [x] = x
joins (x:xs) = x ++ " " ++ (joins xs)

solve :: [Int] -> String
solve list = joins $ map show [index | (index , value) <- zip [1..] list , value * (n-1) == total - value]
    where total = sum list
          n = length list
main = interact$solve.(map read).tail.words


This is the hard version of the problem. The difference between the versions is that the hard version does require you to output the numbers of the rods to be removed. You can make hacks only if all versions of the problem are solved.Stitch likes experimenting with different machines with his friend Sparky. Today they built another machine.The main element of this machine are $$$n$$$ rods arranged along one straight line and numbered from $$$1$$$ to $$$n$$$ inclusive. Each of these rods must carry an electric charge quantitatively equal to either $$$1$$$ or $$$-1$$$ (otherwise the machine will not work). Another condition for this machine to work is that the sign-variable sum of the charge on all rods must be zero.More formally, the rods can be represented as an array of $$$n$$$ numbers characterizing the charge: either $$$1$$$ or $$$-1$$$. Then the condition must hold: $$$a_1 - a_2 + a_3 - a_4 + \ldots = 0$$$, or $$$\sum\limits_{i=1}^n (-1)^{i-1} \cdot a_i = 0$$$.Sparky charged all $$$n$$$ rods with an electric current, but unfortunately it happened that the rods were not charged correctly (the sign-variable sum of the charge is not zero). The friends decided to leave only some of the rods in the machine. Sparky has $$$q$$$ questions. In the $$$i$$$th question Sparky asks: if the machine consisted only of rods with numbers $$$l_i$$$ to $$$r_i$$$ inclusive, what minimal number of rods could be removed from the machine so that the sign-variable sum of charges on the remaining ones would be zero? Also Sparky wants to know the numbers of these rods. Perhaps the friends got something wrong, and the sign-variable sum is already zero. In that case, you don't have to remove the rods at all.If the number of rods is zero, we will assume that the sign-variable sum of charges is zero, that is, we can always remove all rods.Help your friends and answer all of Sparky's questions!

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 10^3$$$), denoting the number of test cases. Description of the test cases follows. The first line of each test case contains two positive integers $$$n$$$ and $$$q$$$ ($$$1 \le n, q \le 3 \cdot 10^5$$$) — the number of rods and the number of questions. The second line of each test case contains a non-empty string $$$s$$$ of length $$$n$$$, where the charge of the $$$i$$$-th rod is $$$1$$$ if $$$s_i$$$ is the "+" symbol, or $$$-1$$$ if $$$s_i$$$ is the "-" symbol. Each next line from the next $$$q$$$ lines contains two positive integers $$$l_i$$$ ans $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — numbers, describing Sparky's questions. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$, and the sum of $$$q$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$. It is guaranteed that the sum of the answers (minimal number of rods that can be removed) over all test cases does not exceed $$$10^6$$$.

For each test case, print the answer in the following format: In the first line print a single integer $$$k$$$ — the minimal number of rods that can be removed. In the second line print $$$k$$$ numbers separated by a space — the numbers of rods to be removed. If there is more than one correct answer, you can print any.

NoteIn the first test case for the first query you can remove the rods numbered $$$5$$$ and $$$8$$$, then the following set of rods will remain: +--+--++-++-. It is easy to see that here the sign-variable sum is zero.In the second test case:  For the first query, we can remove the rods numbered $$$1$$$ and $$$11$$$, then the following set of rods will remain: --++---++---. It is easy to see that here the sign-variable sum is zero.  For the second query we can remove the rod numbered $$$9$$$, then the following set of rods will remain: ---++-. It is easy to see that here the variable sum is zero.  For the third query we can not remove the rods at all.

import Control.Monad
import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))
import Data.List (intercalate)
import qualified Data.ByteString.Char8 as C

type Arr = A.UArray Int Int
type Dp = Arr

readInt :: C.ByteString -> Int
readInt bs = case C.readInt bs of
  Nothing -> error "Not an integer"
  Just (x, _) -> x

splitWords :: C.ByteString -> [C.ByteString]
splitWords a = C.split ' ' a

countLeft' :: [Int] -> (Int,Char) -> [Int]
countLeft' lst@(b:xb) (i,'+') | (even i) = ((b+1):lst)
countLeft' lst@(b:xb) (i,'-') | (even i) = ((b-1):lst)
countLeft' lst@(b:xb) (i,'+') | otherwise = ((b-1):lst)
countLeft' lst@(b:xb) (i,'-') | otherwise = ((b+1):lst)

countLeft :: String -> [Int]
countLeft s =
  reverse $ foldl countLeft' [0] (zip [0..] s)

toArray :: [Int] -> Arr
toArray a = A.array (0,(length a)-1) (zip [0..] a)

prepare :: String -> Dp
prepare x = toArray $ countLeft x

query' :: Int -> Int -> Dp -> Int
query' l r _ | l > r = 0
query' l r dp | odd l = (dp ! r) - (dp ! (l-1))
query' l r dp | otherwise = (dp ! (l-1)) - (dp ! r)

query :: Int -> Int -> Dp -> Int
query l r dp =
  let sum = query' l r dp
  in
    if sum == 0 then 0
    else if even (r-l+1) then 2
    else 1

check :: Int -> Int -> Int -> Dp -> Int
check l r m dp =
  let left = query' l (m-1) dp
      right = query' (m+1) r dp
  in
  if odd (m-l+1) then
    left + right
  else
    left - right

sameSign :: Int -> Int -> Bool
sameSign a b | a > 0 && b > 0 = True
sameSign a b | a < 0 && b < 0 = True
sameSign _ _ | otherwise = False

findPos' :: Int -> Int -> Int -> Int -> Dp -> Int
findPos' _ _ lb rb dp | lb >= rb = 0
findPos' l r lb rb dp =
  let mb = lb + ((rb-lb) `div` 2)
      lq = check l r lb dp
      mq = check l r mb dp
      rq = check l r rb dp
  in
    if lq == 0 then
      lb
    else if mq == 0 then
      mb
    else if rq == 0 then
      rb
    else if sameSign lq mq then
      findPos' l r mb rb dp
    else
      findPos' l r lb mb dp

findPos :: Int -> Int -> Dp -> Int
findPos l r _ | l == r = l
findPos l r dp | otherwise = findPos' l r l r dp

calc :: Int -> Int -> Dp -> (Int, [Int])
calc l r dp =
  let q = query l r dp in
    if q == 0 then (0, [])
    else if q == 1 then (1, [findPos l r dp])
    else (2, [l,findPos (l+1) r dp])

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let [n,q] = map readInt $ splitWords line
    str <- getLine
    --print str
    let dp = prepare str
    --print dp
    forM_ [1..q] $ \_ -> do
      line <- C.getLine
      let [l,r] = map readInt $ splitWords line
      --print [l,r]
      let (c,lst) = calc l r dp
      print c
      if c > 0 then do
        putStrLn $ intercalate " " $ map show lst
      else return ()

import Control.Monad
import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))
import Data.List (intercalate)

type Arr = A.UArray Int Int
type Dp = Arr

countLeft' :: [Int] -> (Int,Char) -> [Int]
countLeft' lst@(b:xb) (i,'+') | (even i) = ((b+1):lst)
countLeft' lst@(b:xb) (i,'-') | (even i) = ((b-1):lst)
countLeft' lst@(b:xb) (i,'+') | otherwise = ((b-1):lst)
countLeft' lst@(b:xb) (i,'-') | otherwise = ((b+1):lst)

countLeft :: String -> [Int]
countLeft s =
  reverse $ foldl countLeft' [0] (zip [0..] s)

toArray :: [Int] -> Arr
toArray a = A.array (0,(length a)-1) (zip [0..] a)

prepare :: String -> Dp
prepare x = toArray $ countLeft x

query' :: Int -> Int -> Dp -> Int
query' l r _ | l > r = 0
query' l r dp | odd l = (dp ! r) - (dp ! (l-1))
query' l r dp | otherwise = (dp ! (l-1)) - (dp ! r)

query :: Int -> Int -> Dp -> Int
query l r dp =
  let sum = query' l r dp
  in
    if sum == 0 then 0
    else if even (r-l+1) then 2
    else 1

check :: Int -> Int -> Int -> Dp -> Int
check l r m dp =
  let left = query l (m-1) dp
      right = query (m+1) r dp
  in
  if odd (m-l+1) then
    left + right
  else
    left - right

sameSign :: Int -> Int -> Bool
sameSign a b | a > 0 && b > 0 = True
sameSign a b | a < 0 && b < 0 = True
sameSign _ _ | otherwise = False

findPos' :: Int -> Int -> Int -> Int -> Dp -> Int
findPos' l r lb rb dp =
  let mb = lb + ((rb-lb) `div` 2)
      lq = check l r lb dp
      mq = check l r mb dp
      rq = check l r rb dp
  in
    if lq == 0 then
      lb
    else if mq == 0 then
      mb
    else if rq == 0 then
      rb
    else if sameSign lq mq then
      findPos' l r mb rb dp
    else
      findPos' l r lb mb dp

findPos :: Int -> Int -> Dp -> Int
findPos l r _ | l == r = l
findPos l r dp | otherwise = findPos' l r l r dp

calc :: Int -> Int -> Dp -> (Int, [Int])
calc l r dp =
  let q = query l r dp in
    if q == 0 then (0, [])
    else if q == 1 then (1, [findPos l r dp])
    else (2, [l,findPos (l+1) r dp])

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [n,q] = map read $ words line :: [Int]
    str <- getLine
    --print str
    let dp = prepare str
    --print dp
    forM_ [1..q] $ \_ -> do
      line <- getLine
      let [l,r] = map read $ words line :: [Int]
      --print [l,r]
      let (c,lst) = calc l r dp
      print c
      if c > 0 then do
        putStrLn $ intercalate " " $ map show lst
      else return ()


Berland scientists noticed long ago that the world around them depends on Berland population. Due to persistent research in this area the scientists managed to find out that the Berland chronology starts from the moment when the first two people came to that land (it is considered to have happened in the first year). After one Berland year after the start of the chronology the population had already equaled 13 people (the second year). However, tracing the population number during the following years was an ultimately difficult task, still it was found out that if di — the number of people in Berland in the year of i, then either di = 12di - 2, or di = 13di - 1 - 12di - 2. Of course no one knows how many people are living in Berland at the moment, but now we can tell if there could possibly be a year in which the country population equaled A. That's what we ask you to determine. Also, if possible, you have to find out in which years it could be (from the beginning of Berland chronology). Let's suppose that it could be in the years of a1, a2, ..., ak. Then you have to define how many residents could be in the country during those years apart from the A variant. Look at the examples for further explanation.

The first line contains integer A (1 ≤ A < 10300). It is guaranteed that the number doesn't contain leading zeros.

On the first output line print YES, if there could be a year in which the total population of the country equaled A, otherwise print NO.  If the answer is YES, then you also have to print number k — the number of years in which the population could equal A. On the next line you have to output precisely k space-separated numbers — a1, a2, ..., ak. Those numbers have to be output in the increasing order. On the next line you should output number p — how many variants of the number of people could be in the years of a1, a2, ..., ak, apart from the A variant. On each of the next p lines you have to print one number — the sought number of residents. Those number also have to go in the increasing order.  If any number (or both of them) k or p exceeds 1000, then you have to print 1000 instead of it and only the first 1000 possible answers in the increasing order. The numbers should have no leading zeros.

main = do interact (gao . read)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show c where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = 2 * x + y
	b = [a!!(z - 2 * i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]
	c = 1: toInteger z + 1: toInteger (length b): b

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (reverse (take (div k 2) (filter (a /=) (rankList k)))))

main = do interact (gao . read)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show (1:z+1:length b:b) where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = x * x + y
	b = [a!!(z - i - i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]

main = do interact (gao . read . head . words)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show (1:z+1:length b:b) where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = 2 * x + y
	b = [a!!(z - 2 * i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (drop (div k 2) (filter (a /=) (rankList k))))

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (take (div k 2) (filter (a /=) (rankList k))))

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -1
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -1

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k == -1)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (take (div k 2) (filter (a /=) (rankList k))))


Captain Marmot wants to prepare a huge and important battle against his enemy, Captain Snake. For this battle he has n regiments, each consisting of 4 moles.Initially, each mole i (1 ≤ i ≤ 4n) is placed at some position (xi, yi) in the Cartesian plane. Captain Marmot wants to move some moles to make the regiments compact, if it's possible.Each mole i has a home placed at the position (ai, bi). Moving this mole one time means rotating his position point (xi, yi) 90 degrees counter-clockwise around it's home point (ai, bi).A regiment is compact only if the position points of the 4 moles form a square with non-zero area.Help Captain Marmot to find out for each regiment the minimal number of moves required to make that regiment compact, if it's possible.

The first line contains one integer n (1 ≤ n ≤ 100), the number of regiments. The next 4n lines contain 4 integers xi, yi, ai, bi ( - 104 ≤ xi, yi, ai, bi ≤ 104).

Print n lines to the standard output. If the regiment i can be made compact, the i-th line should contain one integer, the minimal number of required moves. Otherwise, on the i-th line print "-1" (without quotes).

NoteIn the first regiment we can move once the second or the third mole.We can't make the second regiment compact.In the third regiment, from the last 3 moles we can move once one and twice another one.In the fourth regiment, we can move twice the first mole and once the third mole.

import           Control.Monad
import           Data.List

data Vector = Vector Int Int Int Int deriving (Show, Eq)

rotate :: Vector -> Vector
rotate (Vector a b x y) = Vector a b (a - beta) (b + alpha)
    where
        alpha = x - a; beta = y - b

isSquare :: [Vector] -> Bool
isSquare vecs@(v1:vs@[v2, v3, v4]) =
        dis_x /= -1 &&
        dist vb vd == dis_x &&
        dist vc vb == dis_z && dist vc vd == dis_z &&
        dis_x /=0 && dis_z /= 0
    where
        dist (Vector _ _ x y) (Vector _ _ x' y') = (x'-x)^2+(y'-y)^2
        [d1,d2,d3] = map (dist v1) vs
        (dis_z, dis_x, vc)
            | d1 == d2 = (d1, d3, v4)
            | d2 == d3 = (d2, d1, v2)
            | d1 == d3 = (d1, d2, v3)
            | otherwise = (-1, -1, v1)
        [vb, vd] = delete vc vs

main :: IO ()
main = do
    n <- fmap (head . map read . words) getLine
    forM_ [1..n] (\_ -> do
            moles <- replicateM 4 $ do
                [x, y, a, b] <- fmap (map read . words) getLine
                return $ Vector a b x y
            let squares = filter (isSquare . map snd) $ mapM (zip [0..] . take 4 . iterate rotate) moles
            print $ if null squares
                then -1
                else minimum $ map (sum . map fst) squares
        )

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = interact $ unlines . map show . solve . tail . map (map read . words) . lines

rotate0 (x, y) n
	| n == 0 = (x, y)
	| n == 1 = (-y, x)
	| n == 2 = (-x, -y)
	| otherwise = (y, -x)

rotate (x:y:a:b:_) n = (tx + a, ty + b)
					where (tx, ty) = rotate0 (x - a, y - b) n

minimum' [] = -1
minimum' xs = minimum xs

dis (x, y) (x1, y1) = (x - x1) ^ 2 + (y - y1) ^ 2

isSquare xs = isSqure' ss
		where ss = group $ sort [dis a b | a <- xs, b <- xs];
			  isSqure' (a:b:c:[]) = head a == 0 && head b * 2 == head c && length a == 4 && length b == 8 && length c == 4;
			  isSqure' _ = False

solve :: [[Integer]] -> [Integer]
solve [] = []
solve (m1:m2:m3:m4:xs) = res : solve xs
		where res = minimum' [n1 + n2 + n3 + n4 | n1 <- [0..3], n2 <- [0..3], n3 <- [0..3], n4 <- [0..3],
														isSquare [rotate m1 n1, rotate m2 n2, rotate m3 n3, rotate m4 n4]]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, range, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

data Point = P {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64 deriving (Eq, Ord)

instance Show Point where
  show (P x y) = show (x,y)

instance Num Point where
  (P x0 y0) + (P x1 y1) = P (x0 + x1) (y0 + y1)
  (P x0 y0) - (P x1 y1) = P (x0 - x1) (y0 - y1)
  (P x0 y0) * (P x1 y1) = P (x0 * x1 - y0 * y1) (x0 * y1 + x1 * y0)
  negate (P x y) = P (negate x) (negate y)
  abs _ = undefined
  signum _ = undefined
  fromInteger n = P (fromIntegral n) 0

infixr 7 *:
(*:) :: Int64 -> Point -> Point
(*:) !k (P x y) = P (k * x) (k * y)
{-# INLINE (*:) #-}

dot :: Point -> Point -> Int64
dot (P x0 y0) (P x1 y1) = x0 * x1 + y0 * y1
{-# INLINE dot #-}

main :: IO ()
main = do
  _n <- getLine
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  putStr.unlines.map show. solve $ perse xs

perse :: [Int64] -> [[(Point, Point)]]
perse (x0:y0:a0:b0:x1:y1:a1:b1:x2:y2:a2:b2:x3:y3:a3:b3:rest) = [(P x0 y0,P a0 b0)
                                                               ,(P x1 y1,P a1 b1)
                                                               ,(P x2 y2,P a2 b2)
                                                               ,(P x3 y3,P a3 b3)
                                                               ] : perse rest
perse _ = []

rot0, rot90, rot180, rot270 :: Point -> Point -> Point
rot0 _ xy = xy
rot90 (P a b) (P x y)= P ((b - y) + a) ((x - a) + b)
rot180 p = rot90 p.rot90 p
rot270 p = rot90 p.rot90 p.rot90 p
{-# INLINE rot0 #-}
{-# INLINE rot90 #-}
{-# INLINE rot180 #-}
{-# INLINE rot270 #-}

isSquare :: [Point] -> Bool
isSquare points = and [ v `dot` v == u `dot` u
                      , v `dot` u == 0
                      , p3 == p1 + (p2 - p0)
                      , v /= P 0 0
                      ]
   where
     [p0,p1,p2,p3] = sort points
     !v = p1 - p0
     !u = p2 - p0

solve :: [[(Point,Point)]] -> [Int]
solve moles = map query moles
   where
     query moles = case res of
                     [] -> (-1)
                     res -> minimum res
       where
         res = map (sum.map fst) $ filter p [zipWith (#) fs moles|fs <- replicateM 4 [(0,rot0),(1,rot90),(2,rot180),(3,rot270)]]
     (i,rot)#(xy, ab) = (i, rot ab xy)
     p ixys = isSquare $ map snd ixys

import           Control.Monad
import           Data.List

data Vector = Vector Int Int Int Int deriving (Show, Eq)

rotate :: Vector -> Vector
rotate (Vector a b x y) = Vector a b (a - beta) (b + alpha)
    where
        alpha = x - a; beta = y - b

isSquare :: [Vector] -> Bool
isSquare vecs@(v1:vs@[v2, v3, v4]) =
        dis_x /= -1 &&
        dist vb vd == dis_x &&
        dist vc vb == dis_z && dist vc vd == dis_z &&
        not (and $ zipWith (==) vecs (tail vecs))
    where
        dist (Vector _ _ x y) (Vector _ _ x' y') = (x'-x)^2+(y'-y)^2
        [d1,d2,d3] = map (dist v1) vs
        (dis_z, dis_x, vc)
            | d1 == d2 = (d1, d3, v4)
            | d2 == d3 = (d2, d1, v2)
            | d1 == d3 = (d1, d2, v3)
            | otherwise = (-1, -1, v1)
        [vb, vd] = delete vc vs

main :: IO ()
main = do
    n <- fmap (head . map read . words) getLine
    forM_ [1..n] (\_ -> do
            moles <- replicateM 4 $ do
                [x, y, a, b] <- fmap (map read . words) getLine
                return $ Vector a b x y
            let squares = filter (isSquare . map snd) $ mapM (zip [0..] . take 4 . iterate rotate) moles
            print $ if null squares
                then -1
                else minimum $ map (sum . map fst) squares
        )

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = interact $ unlines . map show . solve . tail . map (map read . words) . lines

rotate0 (x, y) n
	| n == 0 = (x, y)
	| n == 1 = (-y, x)
	| n == 2 = (-x, -y)
	| otherwise = (y, -x)

rotate (x:y:a:b:_) n = (tx + a, ty + b)
					where (tx, ty) = rotate0 (x - a, y - b) n

minimum' [] = -1
minimum' xs = minimum xs

dis (x, y) (x1, y1) = (x - x1) ^ 2 + (y - y1) ^ 2

isSquare xs = isSqure' ss
		where ss = group $ sort [dis a b | a <- xs, b <- xs];
			  isSqure' (a:b:c:[]) = head a == 0 && head b * 2 == head c && length a == 4 && length b == 8 && length c == 4;
			  isSqure' _ = False

solve :: [[Int]] -> [Int]
solve [] = []
solve (m1:m2:m3:m4:xs) = res : solve xs
		where res = minimum' [n1 + n2 + n3 + n4 | n1 <- [0..3], n2 <- [0..3], n3 <- [0..3], n4 <- [0..3],
														isSquare [rotate m1 n1, rotate m2 n2, rotate m3 n3, rotate m4 n4]]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, range, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  _n <- getLine
  xs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show. solve $ perse xs

perse :: [Int] -> [[(Int,Int,Int,Int)]]
perse (x0:y0:a0:b0:x1:y1:a1:b1:x2:y2:a2:b2:x3:y3:a3:b3:rest) = [(x0,y0,a0,b0),(x1,y1,a1,b1),(x2,y2,a2,b2),(x3,y3,a3,b3)] : perse rest
perse _ = []

rot90 :: (Int,Int,Int,Int) -> (Int,Int,Int,Int)
rot90 (x,y,a,b) = (x',y',a,b)
   where
     !x' = (-y) + a + b
     !y' = x - a + b
{-# INLINE rot90 #-}

rot180 = rot90.rot90
rot270 = rot90.rot90.rot90
{-# INLINE rot180 #-}
{-# INLINE rot270 #-}

dot :: (Int,Int) -> (Int,Int) -> Int
dot (x,y) (a,b) = a*x+b*y
{-# INLINE dot #-}

isRect :: [(Int,Int,Int,Int)] -> Bool
isRect moles = length(nub [(x0,y0),(x1,y1),(x2,y2),(x3,y3)]) == 4
               && (x1-x0,y1-y0)`dot`(x2-x0,y2-y0) == 0
               && (x3,y3) == (x1+x2-x0,y1+y2-y0)
   where
     sorted@[(x0,y0,_,_),(x1,y1,_,_),(x2,y2,_,_),(x3,y3,_,_)] = sort moles

solve :: [[(Int,Int,Int,Int)]] -> [Int]
solve moles = map query moles
   where
     query moles = case res of
                     [] -> (-1)
                     res -> minimum res
       where
         res = map (sum.map fst) $ filter p [zipWith (#) fs moles|fs <-mapM(const[(0,id),(1,rot90),(2,rot180),(3,rot270)]) [1..4]]
     (i,f)#xyab = (i, f xyab)
     p ixys = isRect $ map snd ixys


After a team finished their training session on Euro football championship, Valeric was commissioned to gather the balls and sort them into baskets. Overall the stadium has n balls and m baskets. The baskets are positioned in a row from left to right and they are numbered with numbers from 1 to m, correspondingly. The balls are numbered with numbers from 1 to n.Valeric decided to sort the balls in the order of increasing of their numbers by the following scheme. He will put each new ball in the basket with the least number of balls. And if he's got several variants, he chooses the basket which stands closer to the middle. That means that he chooses the basket for which  is minimum, where i is the number of the basket. If in this case Valeric still has multiple variants, he chooses the basket with the minimum number.For every ball print the number of the basket where it will go according to Valeric's scheme.Note that the balls are sorted into baskets in the order of increasing numbers, that is, the first ball goes first, then goes the second ball and so on.

The first line contains two space-separated integers n, m (1 ≤ n, m ≤ 105) — the number of balls and baskets, correspondingly.

Print n numbers, one per line. The i-th line must contain the number of the basket for the i-th ball.

import Data.List
import Data.Ord

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let f i = (abs $ 1 + m - 2 * i, i)
  putStr $ unlines $ map show $ take n $ cycle $ sortBy (comparing f) $ [1 .. m]

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, m] <- getInts

  let
    r
      | odd m = [c] ++ concat (zipWith (\a b -> [a, b]) (reverse [1..c-1]) [c+1..m])
      | even m = concat $ zipWith (\a b -> [a, b]) (reverse [1..c]) [c+1..m]
      where
        c = (m+1) `div` 2

  putStr $ unlines $ map show $ take n $ concat $ repeat r

import Data.List (sort)

pt :: (Show a) => [a] -> IO()
pt [] = return ()
pt (x:xs) = do
	putStrLn $ show x
	pt xs

main = do
	str <- getLine
	let [n,m] = [read x::Int | x <- words str]
	let lst = [ (abs $ m+1-2*i,i) | i<-[1..m]]
	let srt = sort lst
	let ret = take n $ cycle $ map snd srt
	pt ret

solve :: Int -> [Int]
solve n
  | odd n  =  cycle $ take n $ solveR (div n 2) (div n 2 + 1)
  | otherwise  =  solveL (div n 2) (div n 2 + 1)
  where
    solveL l r
      | l == 1  =  l : solveR (div n 2) r
      | otherwise  =  l : solveR (l - 1) r
    solveR l r
      | r == n  =   r : solveL l (div n 2 + 1)
      | otherwise  =  r : solveL l (r + 1)

main :: IO ()
main  =  do
    [m, n]  <-  getLine >>= return . map read . words
    mapM_ print $ take m (solve n)

main = interact$unlines.map show.solve.map read.words

solve :: [Int] -> [Int]
solve [n,m]
  | even m    = take n.cycle.take m.map(mid+) $ 0:concatMap(\i->[i,-i])[1..]
  | otherwise = take n.cycle.take m.map(mid+) $ 0:concatMap(\i->[-i,i])[1..]
   where mid = div (m+1) 2

module Main where

import Control.Applicative
import Data.List
import Control.Monad
import Control.Arrow
import Data.Function
import Data.Array

main' a b = f a 0
    where
        f 0 _ = []
        f a c
            | c == b = (g 0) : f (a-1) 1
            | otherwise = (g c) : f (a-1) (c+1)
        r = listArray (0,b-1)$ (sortBy(compare`on`snd)$map(\i->(i,abs$(intToFlt(b+1)/2.0)-intToFlt i))[1..b])
        g c = fst$ r!c

intToFlt = fromInteger.toInteger

main = putStrLn=<<unlines.map show.(\[a,b]->main' a b).map read.words<$>getLine

import Data.List
s[n,m]=take n$cycle$map snd$sort[(abs(i*2-m-1),i)|i<-[1..m]]
main=interact$unlines.map show.s.map read.words

zipArr (x:xs) (y:ys) = x:y:zipArr xs ys
zipArr x [] = x
zipArr _ y = y

main = do
  d <- getContents
  let (n:m:_) = map read $ words d
  let k = m `div` 2
  let ord = if m `mod` 2 == 0
      then zipArr [k, k-1 .. 1] [k+1 .. m]
	  else zipArr [k+1 .. m] [k, k-1 .. 1]
  let ans = take n $ concat $ repeat ord
  putStr $ unlines $ map show ans

import Data.List
import Data.Ord

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let c = (m + 1) `div` 2
      f i = (abs $ i - c , i)
  putStr $ unlines $ map show $ take n $ cycle $ sortBy (comparing f) $ [1 .. m]

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, m] <- getInts

  let
    c = (m+1) `div` 2
    r = [c] ++ reverse [1..c-1] ++ [c+1..m]

  putStr $ unlines $ map show $ take n $ concat $ repeat r

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, m] <- getInts

  let
    c = (m+1) `div` 2
    r = [c] ++ merge (reverse [1..c-1]) [c+1..m]
      where
        merge as [] = as
        merge [] bs = bs
        merge (a:as) (b:bs) = a:b:(merge as bs)

  putStr $ unlines $ map show $ take n $ concat $ repeat r

solve :: Int -> [Int]
solve n
  | odd n  =  cycle $ take n $ solveR (div n 2) (div n 2 + 1)
  | otherwise  =  solveL (div n 2) (div n 2 + 1)
  where
    solveL l r
      | l == 1  =  l : solveR (div n 2) r
      | otherwise  =  l : solveR (l - 1) r
    solveR l r
      | r == n  =   r : solveL l (div n 2 + 1)
      | otherwise  =  r : solveL l (r + 1)

main :: IO ()
main  =  do
    [n, m]  <-  getLine >>= return . map read . words
    mapM_ print $ take m (solve n)


There always is something to choose from! And now, instead of "Noughts and Crosses", Inna choose a very unusual upgrade of this game. The rules of the game are given below:There is one person playing the game. Before the beginning of the game he puts 12 cards in a row on the table. Each card contains a character: "X" or "O". Then the player chooses two positive integers a and b (a·b = 12), after that he makes a table of size a × b from the cards he put on the table as follows: the first b cards form the first row of the table, the second b cards form the second row of the table and so on, the last b cards form the last (number a) row of the table. The player wins if some column of the table contain characters "X" on all cards. Otherwise, the player loses.Inna has already put 12 cards on the table in a row. But unfortunately, she doesn't know what numbers a and b to choose. Help her win the game: print to her all the possible ways of numbers a, b that she can choose and win.

The first line of the input contains integer t (1 ≤ t ≤ 100). This value shows the number of sets of test data in the input. Next follows the description of each of the t tests on a separate line. The description of each test is a string consisting of 12 characters, each character is either "X", or "O". The i-th character of the string shows the character that is written on the i-th card from the start.

For each test, print the answer to the test on a single line. The first number in the line must represent the number of distinct ways to choose the pair a, b. Next, print on this line the pairs in the format axb. Print the pairs in the order of increasing first parameter (a). Separate the pairs in the line by whitespaces.

4
OXXXOXOOXOOX
OXOXOXOXOXOX
XXXXXXXXXXXX
OOOOOOOOOOOO

main = do
    getLine
    interact $ solve.lines

solve [] = ""
solve (x:xs) = show(length(res x))++" "++unwords(res x) ++"\n"++solve (xs)
res x = [show(i)++"x"++show(12`div`i)|i<-[1,2,3,4,6,12],p (z x (12`div`i)) i]
z x i = [x!!j|r<-[0..i-1],j<-[0..11],j`mod`i==r]
p [] _ = False
p x i
    |take i x==replicate i 'X'  = True
    |otherwise          = p (drop i x) i

{-# LANGUAGE FlexibleContexts #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
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
  k <- readLn
  ss <- replicateM k getLine

  let
    solve s = filter check [(a, b) | a <- [1..12], b <- [1..12], a*b == 12]
      where
        check (a, b) = any (all (== 'X')) $ transpose ls
          where
            ls = unfoldr (\s -> if null s then Nothing else Just $ splitAt b s) s

    p as = unwords $ (show $ length as):(map (\(a, b) -> show a ++ "x" ++ show b) as)

  putStrLn $ unlines $ map p $ map solve ss

import Control.Monad (replicateM_)
import Data.List (intercalate)

win :: String -> Int -> Bool
win s a = any allxs [0..b-1]
  where b = length s `div` a
        allxs c = all (\r -> (s !! (r*b+c)) == 'X') [0..a-1]

solve s = map (\a -> let b = length s `div` a in show a ++ "x" ++ show b) ws
  where ws = concatMap (\a -> if win s a then [a] else []) [1,2,3,4,6,12]

main = do
  t <- read `fmap` getLine :: IO Int
  replicateM_ t $ do
    game <- getLine
    let w = solve game
    putStrLn $ show (length w) ++ " " ++ (intercalate " " w)

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

main = do
    n <- readLn
    replicateM_ n $ do
        s <- getLine
        let l = [ (a,b) | a <- [1,2,3,4,6,12], let b = 12 `div` a, win a b s]
        putStrLn $ unwords $show (length l):[printf "%dx%d" a b | (a,b) <- l]

win :: Int -> Int -> String -> Bool
win a b = any (==take a (repeat 'X')).transpose . takeBy b

takeBy b [] = []
takeBy b l = let (l1,l2) = splitAt b l in l1:takeBy b l2

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

solve :: String -> [(Int, Int)]
solve pattern =
  sort [(12 `div` b, b) | b <- bmatches]
  where
    zipped b = zip (cycle [1..b]) pattern
    groupings = groupBy (\x -> \y -> fst x == fst y) . sort
    ismatch = any (all (\x -> snd x == 'X'))
    bmatches = filter (ismatch . groupings . zipped) [b | b <- [1..12], 12 `mod` b == 0]

showSoln :: [(Int, Int)] -> String
showSoln x = unwords $ show (length x):map (\(a,b) -> (show a) ++ "x" ++ (show b)) x

main = do
  (_:patterns) <- lines <$> getContents
  putStrLn $ unlines $ map (showSoln . solve) patterns

checkX :: String -> Int -> [Bool]
checkX [] t = replicate t True
checkX s t = map (\(x, y) -> (x && y)) (zip (map (=='X') cur) (checkX rest t))
    where
        (cur, rest) = splitAt t s

handle :: String -> [String]
handle str = [show $ length res] ++ res
    where
        handle_i :: Int -> [String]
        handle_i 13 = []
        handle_i i = if 12 `mod` a == 0 && (or $ checkX str b) then ((show a) ++ "x" ++ (show b)) : rest else rest
            where
                a = i
                b = 12 `div` i
                rest = handle_i (i + 1)

        res = handle_i 1

handleAllCase :: Int -> IO ()
handleAllCase 0 = return ()
handleAllCase n = do
    str <- getLine
    putStrLn $ unwords $ handle str
    handleAllCase (n - 1)

main :: IO ()
main = do
    sNCases <- getLine
    handleAllCase $ read sNCases


You are given an array $$$a$$$ consisting of $$$n$$$ integers. You have to find the length of the smallest (shortest) prefix of elements you need to erase from $$$a$$$ to make it a good array. Recall that the prefix of the array $$$a=[a_1, a_2, \dots, a_n]$$$ is a subarray consisting several first elements: the prefix of the array $$$a$$$ of length $$$k$$$ is the array $$$[a_1, a_2, \dots, a_k]$$$ ($$$0 \le k \le n$$$).The array $$$b$$$ of length $$$m$$$ is called good, if you can obtain a non-decreasing array $$$c$$$ ($$$c_1 \le c_2 \le \dots \le c_{m}$$$) from it, repeating the following operation $$$m$$$ times (initially, $$$c$$$ is empty):  select either the first or the last element of $$$b$$$, remove it from $$$b$$$, and append it to the end of the array $$$c$$$. For example, if we do $$$4$$$ operations: take $$$b_1$$$, then $$$b_{m}$$$, then $$$b_{m-1}$$$ and at last $$$b_2$$$, then $$$b$$$ becomes $$$[b_3, b_4, \dots, b_{m-3}]$$$ and $$$c =[b_1, b_{m}, b_{m-1}, b_2]$$$.Consider the following example: $$$b = [1, 2, 3, 4, 4, 2, 1]$$$. This array is good because we can obtain non-decreasing array $$$c$$$ from it by the following sequence of operations:  take the first element of $$$b$$$, so $$$b = [2, 3, 4, 4, 2, 1]$$$, $$$c = [1]$$$;  take the last element of $$$b$$$, so $$$b = [2, 3, 4, 4, 2]$$$, $$$c = [1, 1]$$$;  take the last element of $$$b$$$, so $$$b = [2, 3, 4, 4]$$$, $$$c = [1, 1, 2]$$$;  take the first element of $$$b$$$, so $$$b = [3, 4, 4]$$$, $$$c = [1, 1, 2, 2]$$$;  take the first element of $$$b$$$, so $$$b = [4, 4]$$$, $$$c = [1, 1, 2, 2, 3]$$$;  take the last element of $$$b$$$, so $$$b = [4]$$$, $$$c = [1, 1, 2, 2, 3, 4]$$$;  take the only element of $$$b$$$, so $$$b = []$$$, $$$c = [1, 1, 2, 2, 3, 4, 4]$$$ — $$$c$$$ is non-decreasing. Note that the array consisting of one element is good.Print the length of the shortest prefix of $$$a$$$ to delete (erase), to make $$$a$$$ to be a good array. Note that the required length can be $$$0$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$).

For each test case, print the answer: the length of the shortest prefix of elements you need to erase from $$$a$$$ to make it a good array.

NoteIn the first test case of the example, the array $$$a$$$ is already good, so we don't need to erase any prefix.In the second test case of the example, the initial array $$$a$$$ is not good. Let's erase first $$$4$$$ elements of $$$a$$$, the result is $$$[4, 5, 2]$$$. The resulting array is good. You can prove that if you erase fewer number of first elements, the result will not be good.

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind, nsch) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True
data Signs = Inc | Dec | Same deriving (Ord, Eq, Show)

isGood1 :: [Integer] -> (Bool, Integer, Integer)
isGood1 [x] = (True, 1, 0)
isGood1 lz = let  --stop = length lz - 1
                  -- To determine whether inc or dec
                  rl = reverse lz
                  (_,_,nsch,ind,_) = foldr (\cur t@(prev, sgn, nsch, ind, val) ->
                                  if nsch >= 2 then t
                                               -- case compare cur val of
                                               --   EQ -> (cur, sgn, nsch, ind+1, val)
                                               --   _ -> (cur, sgn, nsch, ind, -1)
                                  else
                                      case compare cur prev of
                                        EQ -> (cur, sgn, nsch, ind+1, -1)
                                        LT -> case sgn of
                                                Inc ->  (cur, Dec, nsch+1, ind+1, -1)
                                                Dec ->  (cur, Dec, nsch, ind+1, -1)
                                                Same -> (cur, Dec, nsch, ind+1, -1)
                                        GT -> case sgn of
                                                Inc ->  (cur, Inc, nsch, ind+1, -1)
                                                Dec ->  (cur, Dec, 2, ind, cur)
                                                Same -> (cur, Inc, nsch, ind+1, -1) )
                                    (last lz, Same, 0, 0, -1) lz
                  -- (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                  --                       case inc of
                  --                         True -> --if ind == stop then (cur, False, True, if cur <= prev then ind else ind+1)
                  --                           {-else-} if cur >= prev
                  --                                 then (cur, True, False, ind+1)
                  --                                 else (cur, False, False, ind+1)
                  --                         False -> --if ind == stop then (cur, False, True, if cur >= prev then ind else ind+1)
                  --                           {-else-} if cur <= prev
                  --                                  then (cur, False, False, ind+1)
                  --                                  else (cur, False, True , ind)
                  --                         else (prev, inc, res, ind))
                  --                                     (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (True, toInteger ind, toInteger nsch)

import Control.Monad   ( replicateM_ )

dropWhile' :: Ord a => (a -> a -> Bool) -> [a] -> [a]
dropWhile' f xs@(x1 : x2 : xr)
  | f x1 x2   = dropWhile' f (x2 : xr)
  | otherwise = xs
dropWhile' _ xs = xs

makeItGud :: [Integer] -> Int
makeItGud = length . tail . dropWhile' (>=) . dropWhile' (<=) . reverse

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n $ getLine >> getLine >>= solve
  where
    solve = print . makeItGud . map read . words

import Data.List
import Control.Monad

solve xs = length prefix
  where
    rest = dropWhile2 (<=) (reverse xs) True
    prefix = dropWhile2 (>=) rest True

dropWhile2 f [x1, x2] b
  | f x1 x2 = []
  | b = [x2]
  | otherwise = [x1, x2]
dropWhile2 f xxs @ (x1:x2:xs) b
  | f x1 x2 = dropWhile2 f (x2 : xs) True
  | b = x2 : xs
  | otherwise = xxs
  where
dropWhile2 _ _ _ = []

getTest :: IO [Int]
getTest = do
  _ <- getLine
  r <- getLine
  let
    r' = map read $ words r
  return r'

main :: IO ()
main = do
  n <- getLine
  let n' = (read n :: Int)
  tests <- replicateM n' getTest
  mapM_ (print . solve) tests

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

helperSecond :: [Int] -> Int -> Int -> Int
helperSecond a pos n
  | pos < (n - 1) && head a >= tail a !! 0  = helperSecond (tail a) (pos + 1) n
  | otherwise = n - pos - 1

helperFirst :: [Int] -> Int -> Int -> Int
helperFirst a pos n
  | pos < (n - 1) && head a <= tail a !! 0 = helperFirst (tail a) (pos + 1) n
  | otherwise = helperSecond a pos n

findShort :: [Int] -> Int -> Int
findShort a n = helperFirst (reverse a) 0 n

solve :: Int -> IO()
solve t
  | t > 0 = do
    n <- getLine
    a <- getLine
    print $ findShort (split a) (split n !! 0)
    solve (t - 1)
  | t == 0 = putStr ""

main :: IO()
main = do
  t <- getLine
  solve $ split t !! 0

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 1)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> if ind == stop then (cur, False, True, ind)
                                                  else if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> if ind == stop then (cur, False, True, if cur > prev then ind else ind+1)
                                                   else if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (res, toInteger ind)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 0)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> if ind == stop then (cur, False, True, ind+1)
                                                  else if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> if ind == stop then (cur, False, True, ind+1)
                                                   else if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (0, True, False, 0) lz
              in (res, toInteger ind)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind, nsch) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True
data Signs = Inc | Dec | Same deriving (Ord, Eq, Show)

isGood1 :: [Integer] -> (Bool, Integer, Integer)
isGood1 [x] = (True, 1, 0)
isGood1 lz = let  --stop = length lz - 1
                  -- To determine whether inc or dec
                  rl = reverse lz
                  (_,_,nsch,ind) = foldr (\cur t@(prev, sgn, nsch, ind) ->
                                  if nsch > 1 then
                                               case compare cur prev of
                                                 EQ -> (prev, sgn, nsch, ind+1)
                                                 _ -> t
                                  else
                                      case compare cur prev of
                                        EQ -> (cur, sgn, nsch, ind+1)
                                        LT -> case sgn of
                                                Inc ->  (cur, Dec, nsch+1, ind+1)
                                                Dec ->  (cur, Dec, nsch, ind+1)
                                                Same -> (cur, Dec, nsch, ind+1)
                                        GT -> case sgn of
                                                Inc ->  (cur, Inc, nsch, ind+1)
                                                Dec ->  (cur, Dec, nsch+1, ind)
                                                Same -> (cur, Inc, nsch, ind+1) )
                                    (last lz, Same, 0, 0) lz
                  -- (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                  --                       case inc of
                  --                         True -> --if ind == stop then (cur, False, True, if cur <= prev then ind else ind+1)
                  --                           {-else-} if cur >= prev
                  --                                 then (cur, True, False, ind+1)
                  --                                 else (cur, False, False, ind+1)
                  --                         False -> --if ind == stop then (cur, False, True, if cur >= prev then ind else ind+1)
                  --                           {-else-} if cur <= prev
                  --                                  then (cur, False, False, ind+1)
                  --                                  else (cur, False, True , ind)
                  --                         else (prev, inc, res, ind))
                  --                                     (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (True, toInteger ind, toInteger nsch)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind, nsch) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True
data Signs = Inc | Dec | Same deriving (Ord, Eq, Show)

isGood1 :: [Integer] -> (Bool, Integer, Integer)
isGood1 [x] = (True, 1, 0)
isGood1 lz = let  --stop = length lz - 1
                  -- To determine whether inc or dec
                  rl = reverse lz
                  (_,_,nsch,ind) = foldr (\cur t@(prev, sgn, nsch, ind) ->
                                  if nsch > 1 then
                                               case compare cur prev of
                                                 EQ -> (prev, sgn, nsch, ind+1)
                                                 _ -> t
                                  else
                                      case compare cur prev of
                                        EQ -> (cur, sgn, nsch, ind+1)
                                        LT -> case sgn of
                                                Inc ->  (cur, Dec, nsch+1, ind+1)
                                                Dec ->  (cur, Dec, nsch, ind+1)
                                                Same -> (cur, Dec, nsch, ind+1)
                                        GT -> case sgn of
                                                Inc ->  (cur, Inc, nsch, ind+1)
                                                Dec ->  (cur, Dec, 2, ind)
                                                Same -> (cur, Inc, nsch, ind+1) )
                                    (last lz, Same, 0, 0) lz
                  -- (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                  --                       case inc of
                  --                         True -> --if ind == stop then (cur, False, True, if cur <= prev then ind else ind+1)
                  --                           {-else-} if cur >= prev
                  --                                 then (cur, True, False, ind+1)
                  --                                 else (cur, False, False, ind+1)
                  --                         False -> --if ind == stop then (cur, False, True, if cur >= prev then ind else ind+1)
                  --                           {-else-} if cur <= prev
                  --                                  then (cur, False, False, ind+1)
                  --                                  else (cur, False, True , ind)
                  --                         else (prev, inc, res, ind))
                  --                                     (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (True, toInteger ind, toInteger nsch)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 1)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> if ind == stop then (cur, False, True, ind+1)
                                                  else if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> if ind == stop then (cur, False, True, ind+1)
                                                   else if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (res, toInteger ind)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 1)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> if ind == stop then (cur, False, True, ind+1)
                                                  else if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> if ind == stop then (cur, False, True, ind+1)
                                                   else if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (0, True, False, 0) lz
              in (res, toInteger ind)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 1)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> if ind == stop then (cur, False, True, ind)
                                                  else if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> if ind == stop then (cur, False, True, ind)
                                                   else if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (res, toInteger ind)

module Main where
import Data.List
import Control.Monad
import System.IO

main = do
  n <- getLine
  let nn = read n :: Int
  replicateM_ nn input

input :: IO ()
input = do
  hSetBuffering stdin LineBuffering
  n <- getLine
  s <- getLine
  putStrLn $ solve (read n) (s)

solve :: Integer  ->  String -> String
solve n str =
  let
    nn = n
    ln = map read $ words str :: [Integer]
    (res, ind) = isGood1 (ln)
  in if res then show $ n - ind else show "-1"
    -- go :: Integer -> [Integer] -> Integer
    -- go _ [] = nn
    -- go c xs  = if (not $ isGood xs (reverse xs) 0 (length xs) False) then (nn - c) else go (c-1) (tail xs)
    -- go c xs  = if isGood1 xs then (nn - c) else go (c-1) (tail xs)
   -- in show $ go nn ln

-- isGood :: [Integer] -> [Integer] -> Integer -> Int -> Bool  -> Bool
-- isGood _ _ _ 0 b = b
-- isGood _ [] _ _ b = b
-- isGood [] _ _ _ b = b
-- isGood [x] _ _ _ b = b
-- isGood l@(x:xs) ll@(y:ys) cl  c False = case compare x y of
--                              GT ->
--                                if y >= cl then isGood l ys y (c - 1) False
--                                                    else True
--                              _ -> if x >= cl then isGood xs (ll) x (c - 1) False
--                                                   else True

isGood1 :: [Integer] -> (Bool, Integer)
isGood1 [x] = (True, 1)
isGood1 lz = let  stop = length lz - 1
                  (_, _, res, ind) = foldr (\cur (prev, inc, res, ind) -> if not res then
                                        case inc of
                                          True -> --if ind == stop then (cur, False, True, if cur <= prev then ind else ind+1)
                                            {-else-} if cur >= prev
                                                  then (cur, True, False, ind+1)
                                                  else (cur, False, False, ind+1)
                                          False -> --if ind == stop then (cur, False, True, if cur >= prev then ind else ind+1)
                                            {-else-} if cur <= prev
                                                   then (cur, False, False, ind+1)
                                                   else (cur, False, True , ind)
                                          else (prev, inc, res, ind))
                                                      (if last lz >= last(init(lz)) then (last lz, False, False, 0) else (0, True, False, 0)) lz
              in (True, toInteger ind)


You have array of $$$n$$$ numbers $$$a_{1}, a_{2}, \ldots, a_{n}$$$. Rearrange these numbers to satisfy $$$|a_{1} - a_{2}| \le |a_{2} - a_{3}| \le \ldots \le |a_{n-1} - a_{n}|$$$, where $$$|x|$$$ denotes absolute value of $$$x$$$. It's always possible to find such rearrangement.Note that all numbers in $$$a$$$ are not necessarily different. In other words, some numbers of $$$a$$$ may be same.You have to answer independent $$$t$$$ test cases.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^{4}$$$) — the number of test cases. The first line of each test case contains single integer $$$n$$$ ($$$3 \le n \le 10^{5}$$$) — the length of array $$$a$$$. It is guaranteed that the sum of values of $$$n$$$ over all test cases in the input does not exceed $$$10^{5}$$$. The second line of each test case contains $$$n$$$ integers $$$a_{1}, a_{2}, \ldots, a_{n}$$$ ($$$-10^{9} \le a_{i} \le 10^{9}$$$).

For each test case, print the rearranged version of array $$$a$$$ which satisfies given condition. If there are multiple valid rearrangements, print any of them.

NoteIn the first test case, after given rearrangement, $$$|a_{1} - a_{2}| = 0 \le |a_{2} - a_{3}| = 1 \le |a_{3} - a_{4}| = 2 \le |a_{4} - a_{5}| = 2 \le |a_{5} - a_{6}| = 10$$$. There are other possible answers like "5 4 5 6 -2 8".In the second test case, after given rearrangement, $$$|a_{1} - a_{2}| = 1 \le |a_{2} - a_{3}| = 2 \le |a_{3} - a_{4}| = 4$$$. There are other possible answers like "2 4 8 1".

module Main where

import Control.Monad
import Data.List

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

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

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sort <$> getIntList
        let
            half = n `div` 2
            (lHalf, rHalf) = splitAt half a
            revLHalf = reverse lHalf
        printList $ combine revLHalf rHalf 1

combine :: [Int] -> [Int] -> Int -> [Int]
combine [] [] _ = []
combine [] ys _ = ys
combine xs [] _ = xs
combine (x:xs) (y:ys) z = case z of
    0 -> x : combine xs (y:ys) (1 - z)
    1 -> y : combine (x:xs) ys (1 - z)

import Control.Monad
import Data.List

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

f :: [a] -> [a] -> [a]
f [] _ = []
f (a:as) b = a : f b as

solve :: [Int] -> [Int]
solve l = f b (reverse a)
  where
    (a, b) = splitAt (length l `div` 2) (sort l)

module Main where

import Control.Monad
import Data.List

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

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

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sort <$> getIntList
        let
            half = n `div` 2
            (lHalf, rHalf) = splitAt half a
            revLHalf = reverse rHalf
        printList $ combine revLHalf rHalf 1

combine :: [Int] -> [Int] -> Int -> [Int]
combine [] [] _ = []
combine [] ys _ = ys
combine xs [] _ = xs
combine (x:xs) (y:ys) z = case z of
    0 -> x : combine xs (y:ys) (1 - z)
    1 -> y : combine (x:xs) ys (1 - z)

module Main where

import Control.Monad
import Data.List

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

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

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sort <$> getIntList
        let
            half = n `div` 2
            (lHalf, rHalf) = splitAt half a
            revLHalf = reverse lHalf
        printList $ combine revLHalf rHalf 0

combine :: [Int] -> [Int] -> Int -> [Int]
combine [] [] _ = []
combine [] ys _ = ys
combine xs [] _ = xs
combine (x:xs) (y:ys) z = case z of
    0 -> x : combine xs (y:ys) (1 - z)
    1 -> y : combine (x:xs) ys (1 - z)

module Main where

import Control.Monad
import Data.List

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

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

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

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        a <- sort <$> getIntList
        let
            half = n `div` 2
            (lHalf, rHalf) = splitAt half a
            revLHalf = reverse lHalf
        print half
        printList revLHalf
        printList rHalf
        printList $ combine revLHalf rHalf 0

combine :: [Int] -> [Int] -> Int -> [Int]
combine [] [] _ = []
combine [] ys _ = ys
combine xs [] _ = xs
combine (x:xs) (y:ys) z = case z of
    0 -> x : combine xs (y:ys) (1 - z)
    1 -> y : combine (x:xs) ys (1 - z)


There are $$$n$$$ people participating in some contest, they start participating in $$$x$$$ minutes intervals. That means the first participant starts at time $$$0$$$, the second participant starts at time $$$x$$$, the third — at time $$$2 \cdot x$$$, and so on.Duration of contest is $$$t$$$ minutes for each participant, so the first participant finishes the contest at time $$$t$$$, the second — at time $$$t + x$$$, and so on. When a participant finishes the contest, their dissatisfaction equals to the number of participants that started the contest (or starting it now), but haven't yet finished it.Determine the sum of dissatisfaction of all participants.

The first line contains a single integer $$$k$$$ ($$$1 \le k \le 1000$$$) — the number of test cases. Each of the next $$$k$$$ lines contains three integers $$$n$$$, $$$x$$$, $$$t$$$ ($$$1 \le n, x, t \le 2 \cdot 10^9$$$) — the number of participants, the start interval and the contest duration.

Print $$$k$$$ lines, in the $$$i$$$-th line print the total dissatisfaction of participants in the $$$i$$$-th test case.

NoteIn the first example the first participant starts at $$$0$$$ and finishes at time $$$5$$$. By that time the second and the third participants start, so the dissatisfaction of the first participant is $$$2$$$. The second participant starts at time $$$2$$$ and finishes at time $$$7$$$. By that time the third the fourth participants start, so the dissatisfaction of the second participant is $$$2$$$. The third participant starts at $$$4$$$ and finishes at $$$9$$$. By that time the fourth participant starts, so the dissatisfaction of the third participant is $$$1$$$.The fourth participant starts at $$$6$$$ and finishes at $$$11$$$. By time $$$11$$$ everyone finishes the contest, so the dissatisfaction of the fourth participant is $$$0$$$.In the second example the first participant starts at $$$0$$$ and finishes at time $$$2$$$. By that time the second participants starts, and the third starts at exactly time $$$2$$$. So the dissatisfaction of the first participant is $$$2$$$. The second participant starts at time $$$1$$$ and finishes at time $$$3$$$. At that time the third participant is solving the contest.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as B
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  s <- getLine
  let [n, x, t] = map read $ words s :: [Integer]
      mx = min (div t x) (n-1)
      res = div (mx*(mx+1)) 2 + mx * (n - mx - 1)
    in print res

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

calculate :: Integer -> Integer -> Integer -> Integer
calculate n x t
    | (n >= div t x) = (div t x) * n - (div t x * (div t x + 1)) `div` 2
    | otherwise = ((n-1) * n) `div` 2

main = do
    int <- getLine
    let n = read int::Integer
    repeat n
    where
        repeat 0 = return ()
        repeat m = do
            line <- getLine
            let input = map (\x -> read x::Integer) $ words line
            putStrLn $ show $ calculate (input!!0) (input!!1) (input!!2)
            repeat $ m-1

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

printResult = do
    [n,x,t] <- readInts
    let m = div t x
    if m == 0 then print 0
    else print $ if n >= m + 1 then div ((m+1)*m) 2 + m*(n-m-1) else div (n*(n-1)) 2

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

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

printS = do
    [n,x,t] <- readInts
    let m = div (n*x-t) x + if (div (n*x-t) x > 0) then 1 else 0
        mm = if m < 0 then 0 else m
        s = if mm>1 then (mm-1)*(div t x) else 0
        a = if mm == 0 then 1 else mm
        ret = s + (div ((n-a)*(n-a+1)) 2)
    print ret

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as B
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  s <- getLine
  let [n, x, t] = map read $ words s :: [Integer]
      mx = div t x
      res = div (mx*(mx+1)) 2 + mx * (n - mx - 1)
    in print res

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as B
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  s <- getLine
  let [n, x, t] = map read $ words s :: [Int64]
      mx = div t x
      res = div (mx*(mx+1)) 2 + mx * (n - mx - 1)
    in print res

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

calculate :: Int -> Int -> Int -> Int
calculate n x t
    | (n >= div t x) = (div t x) * n - (div t x * (div t x + 1)) `div` 2
    | otherwise = ((n-1) * n) `div` 2

main = do
    int <- getLine
    let n = read int::Int
    repeat n
    where
        repeat 0 = return ()
        repeat m = do
            line <- getLine
            let input = map (\x -> read x::Int) $ words line
            putStrLn $ show $ calculate (input!!0) (input!!1) (input!!2)
            repeat $ m-1

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

printResult = do
    [n,x,t] <- readInts
    let m = div t x
    if m == 0 then print 0
    else print $ if n >= m + 1 then div ((m+1)*m) 2 + m*(n-m-1) else div (n*(n-1)) 2

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