INTERCAL is the oldest of esoteric programming languages. One of its many weird features is the method of character-based output, known as Turing Tape method. It converts an array of unsigned 8-bit integers into a sequence of characters to print, using the following method.The integers of the array are processed one by one, starting from the first. Processing i-th element of the array is done in three steps:1. The 8-bit binary notation of the ASCII-code of the previous printed character is reversed. When the first element of the array is processed, the result of this step is considered to be 0.2. The i-th element of the array is subtracted from the result of the previous step modulo 256.3. The binary notation of the result of the previous step is reversed again to produce ASCII-code of the i-th character to be printed.You are given the text printed using this method. Restore the array used to produce this text.

The input will consist of a single line text which contains the message printed using the described method. String text will contain between 1 and 100 characters, inclusive. ASCII-code of each character of text will be between 32 (space) and 126 (tilde), inclusive.

Output the initial array, which was used to produce text, one integer per line.

NoteLet's have a closer look at the beginning of the example. The first character is "H" with ASCII-code 72 = 010010002. Its reverse is 000100102 = 18, and this number should become the result of the second step of processing. The result of the first step is considered to be 0, so the first element of the array has to be (0 - 18) mod 256 = 238, where a mod b is the remainder of division of a by b.

module Main where

import Data.Char

main = interact (unlines . solve . head. lines)

solve :: String -> [String]
solve line = map show $ getArray (0 : (map ord line))

getArray :: [Int] -> [Int]
getArray [_] = []
getArray (x : (t@(y:_))) = (mirror x - mirror y) `trueMod` 256 : getArray t

trueMod :: Int -> Int -> Int
trueMod x y =
    let m = x `mod` y in
        if m < 0 then m + y else m

mirror = bin2num . reverse . num2bin

bin2num = foldl (\x y -> 2 * x + y) 0

num2bin = reverse . (num2bin' 8)

num2bin' 0 x = []
num2bin' n x = x `mod` 2 : num2bin' (n - 1) (x `div` 2)

import Data.Char (ord,chr)
import Control.Monad    --ord Char->Int , chr Int ->Char

intercal :: [Char] -> Int -> [Int]
intercal [] n = []
intercal (x:xs) n = let k =  transform x
                 in value k : intercal xs k
  where
    transform = toDec.length8. toBi.ord
    value k = (n - k) `mod` 256

length8 :: String -> String
length8 xs = xs ++ replicate (8-length xs) '0'

--10�i������2�i����(�t��)
toBi :: Int -> String
toBi 0 = "0"
toBi n = show (mod n 2) ++ toBi (div n 2)

--2�i������10�i����
toDec :: String -> Int
toDec [] = 0
toDec ('0':cs) = toDec cs
toDec ('1':cs) = 2^(length cs) + toDec cs

main = do xs <- getLine
          forM_ (intercal xs 0) print

import Data.List
import Data.Char

reverseBits :: Int -> Int
reverseBits n = snd $ foldl' collect (n, 0) [1 .. 8]
  where collect (n, res) _ = (n `div` 2,
                              res * 2 + n `mod` 2)

solve :: String -> [Int]
solve text = map handle xs
  where xs = zip (0:map ord text) $ map ord text
        handle (last, x) =
          (reverseBits last - reverseBits x) `mod` 256

main = do text <- getLine
          sequence_ $ map print $ solve text

{-# 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
import Data.Bits
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}

ind :: Bool -> Int
ind b = if b then 1 else 0

reverseBin :: Int -> Int
reverseBin bin =
    (
     (ind (testBit bin 7))+
     (ind (testBit bin 6))*2+
     (ind (testBit bin 5))*4+
     (ind (testBit bin 4))*8+
     (ind (testBit bin 3))*16+
     (ind (testBit bin 2))*32+
     (ind (testBit bin 1))*64+
     (ind (testBit bin 0))*128
    )

convToINTERCAL :: Char -> Int
convToINTERCAL c =
    let n = ord c
    in
      (512-(reverseBin n))

solve :: String -> [Int]
solve str = rec 0 str []
    where
      rec _ [] l = reverse l
      rec prev (x:xs) l = rec (reverseBin (ord x)) xs ((mod ((convToINTERCAL x)+prev) 256):l)

main = getLine >>= puts.unlines.map show.solve

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    BS.unpack <$> readLine
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

solve s = BS.unlines $ map (BS.pack . show ) $ go 0 (map ord s)

revbits a = sum [((a `shiftR` i) .&. 1) `shiftL` (7 - i) | i <- [0..7]]

go _ [] = []
go p (x:xs) = (p' - x') `mod` 256 : go x xs
  where
    p' = revbits p
    x' = revbits x

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Data.Bits
import Data.Char
import Data.Word
import Data.Function

main=getLine>>=mapM print.solve.(0:).map (toEnum.ord)

solve :: [Word8] -> [Word8]
solve cs = zipWith ((-)`on`rev) cs (tail cs)

rev :: Word8 -> Word8
rev n = foldl setBit 0 [ 7-i | i<-[0..7], testBit n i]

r 0 c n=c
r i c n=r(i-1)(c*2+n`mod`2)$n`div`2
f l=zipWith(-)(0:l)l
main=interact$unlines.map(show.(`mod`256)).f.map(r 8 0.fromEnum).init

toBits 0 n = []
toBits i n = (n `mod` 2) : toBits (i-1) (n `div` 2)

fromBits [] = 0
fromBits (h:t) = 2*fromBits t + h

rev = fromBits . reverse . toBits 8

recover l = zipWith (-) (0:l) l

to256 = map (`mod` 256)
s[l]=to256 $ recover (map (rev.fromEnum) l)
main=interact$unlines.map show.s.lines

import Data.Bits
import Data.Char
import Data.Word
import Data.Function

main=interact $ unlines.map show.solve.(0:).map (toEnum.ord)

solve :: [Word8] -> [Word8]
solve cs = zipWith ((-)`on`rev) cs (tail cs)

rev :: Word8 -> Word8
rev n = foldl setBit 0 [ 7-i | i<-[0..7], testBit n i]


You are given two arrays $$$a$$$ and $$$b$$$, each contains $$$n$$$ integers.You want to create a new array $$$c$$$ as follows: choose some real (i.e. not necessarily integer) number $$$d$$$, and then for every $$$i \in [1, n]$$$ let $$$c_i := d \cdot a_i + b_i$$$.Your goal is to maximize the number of zeroes in array $$$c$$$. What is the largest possible answer, if you choose $$$d$$$ optimally?

The first line contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in both arrays. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$). The third line contains $$$n$$$ integers $$$b_1$$$, $$$b_2$$$, ..., $$$b_n$$$ ($$$-10^9 \le b_i \le 10^9$$$).

Print one integer — the maximum number of zeroes in array $$$c$$$, if you choose $$$d$$$ optimally.

NoteIn the first example, we may choose $$$d = -2$$$.In the second example, we may choose $$$d = -\frac{1}{13}$$$.In the third example, we cannot obtain any zero in array $$$c$$$, no matter which $$$d$$$ we choose.In the fourth example, we may choose $$$d = 6$$$.

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Array.Unboxed
import qualified Data.Sequence as S
import Data.Foldable
import Data.List
import Data.Ratio
import Data.Int

ru, ri :: C.ByteString -> Int

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

test :: Int -> [Int] -> Int
test n l = r1 + r2
  where
    (a, l') = splitAt n l
    b = take n l'
    x = zip a b
    r2 = maximum $ (0 : ) $ map length $ group $ toList $ S.unstableSort $ S.fromList [ (fromIntegral j) % (fromIntegral i) :: Ratio Int64 | (i, j) <- x, i /= 0]
    r1 = length $ filter (\(i, j) -> i == 0 && j == 0) x

main = do
  s <- C.getContents
  let (n:a) = map ri $ C.words s
  print $ test n a

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Array.Unboxed
import qualified Data.Sequence as S
import Data.Foldable
import Data.List
import Data.Ratio
import Data.Int

ru, ri :: C.ByteString -> Int

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

test :: Int -> [Int] -> Int
test n l = max (r1 + r2) r3
  where
    (a, l') = splitAt n l
    b = take n l'
    x = zip a b
    r2 = maximum $ (0 : ) $ map length $ group $ toList $ S.unstableSort $ S.fromList [ (fromIntegral j) % (fromIntegral i) :: Ratio Int64 | (i, j) <- x, i /= 0]
    r1 = length $ filter (\(i, j) -> i == 0 && j == 0) x
    r3 = length $ filter (== 0) b

main = do
  s <- C.getContents
  let (n:a) = map ri $ C.words s
  print $ test n a

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

divide a b
    | a == 0 && b /= 0 = Nothing
    | b == 0 = Just 0
    | otherwise = Just (fromIntegral a % fromIntegral b)

process :: [Int] -> [Int] -> Int
process as bs = maxCount ds where
    ds = catMaybes $ zipWith divide as bs :: [Rational]
    n = length ds
    maxCount = maximum' . map lengthPlusWc . group . sort
    maximum' [] = 0
    maximum' l  = maximum l
    lengthPlusWc l = if head l == 0 then length l else length l + wildcardCnt
    wildcardCnt = length $ filter (\(a, b) -> a == 0 && b == 0) (zip as bs)

main = do
    n <- getInt
    as <- getInts
    bs <- getInts
    print $ process as bs

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Array.Unboxed
import qualified Data.Sequence as S
import Data.Foldable
import Data.List
import Data.Ratio

ru, ri :: C.ByteString -> Int

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

test :: Int -> [Int] -> Int
test n l = r1 + r2
  where
    (a, l') = splitAt n l
    b = take n l'
    x = zip a b
    r2 = maximum $ (0 : ) $ map length $ group $ toList $ S.unstableSort $ S.fromList [j % i | (i, j) <- x, i /= 0]
    r1 = length $ filter (\(i, j) -> i == 0 && j == 0) x

main = do
  s <- C.getContents
  let (n:a) = map ri $ C.words s
  print $ test n a

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

divide a b
    | a == 0 && b /= 0 = Nothing
    | b == 0 = Just 0
    | otherwise = Just $ ((/) `on` (% 1)) a b

process :: [Int] -> [Int] -> Int
process as bs = if nonzeroD then maxDCnt + wildcardCnt else maxDCnt where
    ds = catMaybes $ zipWith divide as bs
    n = length ds
    dArr = listArray (1, n) (sort ds) :: Array Int (Ratio Int)
    dCnts = map snd $ scanl foldFn (1, (0, 0)) [1..n]
    foldFn (i, _) j = (i', (x, j - i' + 1)) where
        x = dArr ! j
        i' = until (\_i -> (dArr ! _i) == x) (+ 1) i
    maxDCnt = snd $ maximumBy (compare `on` snd) dCnts
    nonzeroD = length (filter (\(x, cnt) -> x /= (0%1) && cnt == maxDCnt) dCnts) > 0
    wildcardCnt = length $ filter (\(a, b) -> a == 0 && b == 0) (zip as bs)

main = do
    n <- getInt
    as <- getInts
    bs <- getInts
    print $ process as bs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

divide a b
    | a == 0 && b /= 0 = Nothing
    | b == 0 = Just 0
    | otherwise = Just $ ((/) `on` (% 1)) a b

process :: [Int] -> [Int] -> Int
process as bs = maximum dCnts where
    ds = catMaybes $ zipWith divide as bs
    n = length ds
    dArr = listArray (1, n) (sort ds) :: Array Int (Ratio Int)
    dCnts = map snd $ scanl foldFn (1, 0) [1..n]
    foldFn (i, _) j = (i', j - i' + 1) where
        x = dArr ! j
        i' = until (\_i -> (dArr ! _i) == x) (+ 1) i

main = do
    n <- getInt
    as <- getInts
    bs <- getInts
    print $ process as bs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

divide a b
    | a == 0 && b /= 0 = Nothing
    | b == 0 = Just 0
    | otherwise = Just $ ((/) `on` (% 1)) a b

process :: [Int] -> [Int] -> Int
process as bs = maximum dCnts where
    ds = catMaybes $ zipWith divide as bs
    n = length ds
    dArr = listArray (1, n) (sort ds) :: Array Int (Ratio Int)
    dCnts = map snd $ scanl foldFn (1, 0) [1..n]
    foldFn (i, _) j = (i', j - i' + 1 + extra) where
        extra = if x == 0 then 0 else wildcardCnt
        x = dArr ! j
        i' = until (\_i -> (dArr ! _i) == x) (+ 1) i
    wildcardCnt = length $ filter (\(a, b) -> a == 0 && b == 0) (zip as bs)

main = do
    n <- getInt
    as <- getInts
    bs <- getInts
    print $ process as bs


This is a simplified version of the task Toy Train. These two versions differ only in the constraints. Hacks for this version are disabled.Alice received a set of Toy Train™ from Bob. It consists of one train and a connected railway network of $$$n$$$ stations, enumerated from $$$1$$$ through $$$n$$$. The train occupies one station at a time and travels around the network of stations in a circular manner. More precisely, the immediate station that the train will visit after station $$$i$$$ is station $$$i+1$$$ if $$$1 \leq i < n$$$ or station $$$1$$$ if $$$i = n$$$. It takes the train $$$1$$$ second to travel to its next station as described.Bob gave Alice a fun task before he left: to deliver $$$m$$$ candies that are initially at some stations to their independent destinations using the train. The candies are enumerated from $$$1$$$ through $$$m$$$. Candy $$$i$$$ ($$$1 \leq i \leq m$$$), now at station $$$a_i$$$, should be delivered to station $$$b_i$$$ ($$$a_i \neq b_i$$$).    The blue numbers on the candies correspond to $$$b_i$$$ values. The image corresponds to the $$$1$$$-st example. The train has infinite capacity, and it is possible to load off any number of candies at a station. However, only at most one candy can be loaded from a station onto the train before it leaves the station. You can choose any candy at this station. The time it takes to move the candies is negligible.Now, Alice wonders how much time is needed for the train to deliver all candies. Your task is to find, for each station, the minimum time the train would need to deliver all the candies were it to start from there.

The first line contains two space-separated integers $$$n$$$ and $$$m$$$ ($$$2 \leq n \leq 100$$$; $$$1 \leq m \leq 200$$$) — the number of stations and the number of candies, respectively. The $$$i$$$-th of the following $$$m$$$ lines contains two space-separated integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i, b_i \leq n$$$; $$$a_i \neq b_i$$$) — the station that initially contains candy $$$i$$$ and the destination station of the candy, respectively.

In the first and only line, print $$$n$$$ space-separated integers, the $$$i$$$-th of which is the minimum time, in seconds, the train would need to deliver all the candies were it to start from station $$$i$$$.

NoteConsider the second sample.If the train started at station $$$1$$$, the optimal strategy is as follows.  Load the first candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the first candy.  Proceed to station $$$1$$$. This step takes $$$1$$$ second.  Load the second candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the second candy.  Proceed to station $$$1$$$. This step takes $$$1$$$ second.  Load the third candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the third candy. Hence, the train needs $$$5$$$ seconds to complete the tasks.If the train were to start at station $$$2$$$, however, it would need to move to station $$$1$$$ before it could load the first candy, which would take one additional second. Thus, the answer in this scenario is $$$5+1 = 6$$$ seconds.

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

dist nNode src dst = if src < dst then dst - src else dst + (nNode - src)

shortestTimeNode :: Int -> Int -> Int -> [Int] -> Int
shortestTimeNode _     _        _    []      = 0
shortestTimeNode nNode initNode node candies = beforeLast + shortestLast where
    nLoop = if initNode == node then length candies - 2 else length candies - 1
    beforeLast = nNode * nLoop + dist nNode initNode node
    shortestLast = minimum $ map (dist nNode node) candies

shortestTimeNodes nodeCandies@(length -> nNode) initNode =
    maximum $ zipWith (shortestTimeNode nNode initNode) [0..] nodeCandies

process :: [[Int]] -> [Int]
process nodeCandies = map (shortestTimeNodes nodeCandies) [0..(n-1)] where
    n = length nodeCandies

main = do
    n:m:[] <- getInts
    rawCandies <- replicateM m getCandy
    nodeCandies <- return $ nodeBucket rawCandies (take n $ repeat [])
    putStrLn $ showCandies $ process nodeCandies

getCandy = do
    node:candy:[] <- getInts
    return (node, candy)

showCandies = unwords . map show

nodeBucket [] ret = ret
nodeBucket ((node, candy):xs) ret = nodeBucket xs (replaceList (node-1) 0 ret nodeCandies') where
    replaceList i k []     l = []
    replaceList i k (x:xs) l = (if k == i then l else x) : replaceList i (k+1) xs l
    nodeCandies = ret !! (node-1)
    nodeCandies' = (candy-1) : nodeCandies


You are given two strings $$$s$$$ and $$$t$$$. Both strings have length $$$n$$$ and consist of lowercase Latin letters. The characters in the strings are numbered from $$$1$$$ to $$$n$$$.You can successively perform the following move any number of times (possibly, zero):  swap any two adjacent (neighboring) characters of $$$s$$$ (i.e. for any $$$i = \{1, 2, \dots, n - 1\}$$$ you can swap $$$s_i$$$ and $$$s_{i + 1})$$$. You can't apply a move to the string $$$t$$$. The moves are applied to the string $$$s$$$ one after another.Your task is to obtain the string $$$t$$$ from the string $$$s$$$. Find any way to do it with at most $$$10^4$$$ such moves.You do not have to minimize the number of moves, just find any sequence of moves of length $$$10^4$$$ or less to transform $$$s$$$ into $$$t$$$.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 50$$$) — the length of strings $$$s$$$ and $$$t$$$. The second line of the input contains the string $$$s$$$ consisting of $$$n$$$ lowercase Latin letters. The third line of the input contains the string $$$t$$$ consisting of $$$n$$$ lowercase Latin letters.

If it is impossible to obtain the string $$$t$$$ using moves, print "-1". Otherwise in the first line print one integer $$$k$$$ — the number of moves to transform $$$s$$$ to $$$t$$$. Note that $$$k$$$ must be an integer number between $$$0$$$ and $$$10^4$$$ inclusive. In the second line print $$$k$$$ integers $$$c_j$$$ ($$$1 \le c_j < n$$$), where $$$c_j$$$ means that on the $$$j$$$-th move you swap characters $$$s_{c_j}$$$ and $$$s_{c_j + 1}$$$. If you do not need to apply any moves, print a single integer $$$0$$$ in the first line and either leave the second line empty or do not print it at all.

NoteIn the first example the string $$$s$$$ changes as follows: "abcdef" $$$\rightarrow$$$ "abdcef" $$$\rightarrow$$$ "abdcfe" $$$\rightarrow$$$ "abdfce" $$$\rightarrow$$$ "abdfec".In the second example there is no way to transform the string $$$s$$$ into the string $$$t$$$ through any allowed moves.

import Data.List
import Data.Maybe

moveLetters :: String -> String -> [Int] -> Int -> [Int]
moveLetters "" "" list _ = list
moveLetters (s:xs) (t:xt) list offset
    | s == t = moveLetters xs xt list $ offset + 1
    | otherwise = moveLetters newxs xt newList $ offset + 1
    where newList = list ++ (map (+ offset) $ reverse [0..i - 1])
          i = fromMaybe 0 $ findIndex (== t) (s:xs)
          newxs = s : (take (i - 1) xs ++ drop i xs)

main = do
    getLine
    s <- getLine
    t <- getLine

    if sort s /= sort t then do
        putStrLn "-1"
    else do
        let perms = moveLetters s t [] 0
        putStrLn . show $ length perms
        putStrLn . unwords . map (show . (+ 1)) $ perms

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

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

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

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

getMove from to
    | from == to = []
    | otherwise = findp : getMove (swap findp from) to
    where check idx = if from !! idx == to !! idx then check (idx+1) else head ([x|x <- [idx+1..length from - 1], from !! x == to !! idx])
          findp = check 0

swap x from = take (x-1) from ++ [from !! x] ++ [from !! (x-1)] ++ drop (x+1) from

main = do
    getLine
    s <- getLine
    t <- getLine
    if (sort s) /= (sort t) then putStrLn "-1"
    else do
        let move = getMove s t
        print (length move)
        putStrLn $ intercalate " " $ map show move

import Data.List
import Data.Maybe

moveLetter :: Int -> String -> String -> [Int]
moveLetter offset s t = reverse $ map (+ trueOffset) steps
        where stepCount = fromMaybe 0 $ findIndex (== head t) s
              steps = if stepCount == 0 then [0] else [0..stepCount - 1]
              trueOffset = if stepCount == 0 then offset - 1 else offset

getPermutations :: Int -> String -> String -> [Int]
getPermutations _ "" "" = []
getPermutations offset (s:sx) (t:tx)
    | s == t = getPermutations (offset + 1) sx tx
    | otherwise = curLetterPerms ++ (getPermutations (offset + 1) sx tx)
    where curLetterPerms = (moveLetter offset (s:sx) (t:tx))

main = do
    getLine
    s <- getLine
    t <- getLine

    if sort s /= sort t then do
        putStrLn "-1"
    else do
        let perms = getPermutations 0 s t
        putStrLn . show $ length perms
        putStrLn . unwords . map (show . (+ 1)) $ perms

--cdef
--dfec

import Data.List
import Data.Maybe

moveLetter :: Int -> String -> String -> [Int]
moveLetter offset s t = reverse $ map (+ offset) steps
        where stepCount = fromMaybe 0 $ findIndex (== head t) s
              steps = if stepCount == 0 then [-1] else [0..stepCount - 1]

getPermutations :: Int -> String -> String -> [Int]
getPermutations _ "" "" = []
getPermutations offset (s:sx) (t:tx)
    | s == t = getPermutations (offset + 1) sx tx
    | otherwise = curLetterPerms ++ (getPermutations (offset + 1) sx tx)
    where curLetterPerms = (moveLetter offset (s:sx) (t:tx))

main = do
    getLine
    s <- getLine
    t <- getLine

    if sort s /= sort t then do
        putStrLn "-1"
    else do
        let perms = getPermutations 0 s t
        putStrLn . show $ length perms
        putStrLn . unwords . map (show . (+ 1)) $ perms

--abdfce
--dbdfec


One day, liouzhou_101 got a chat record of Freda and Rainbow. Out of curiosity, he wanted to know which sentences were said by Freda, and which were said by Rainbow. According to his experience, he thought that Freda always said "lala." at the end of her sentences, while Rainbow always said "miao." at the beginning of his sentences. For each sentence in the chat record, help liouzhou_101 find whose sentence it is.

The first line of the input contains an integer n (1 ≤ n ≤ 10), number of sentences in the chat record. Each of the next n lines contains a sentence. A sentence is a string that contains only Latin letters (A-Z, a-z), underline (_), comma (,), point (.) and space ( ). Its length doesn’t exceed 100.

For each sentence, output "Freda's" if the sentence was said by Freda, "Rainbow's" if the sentence was said by Rainbow, or "OMG>.< I don't know!" if liouzhou_101 can’t recognize whose sentence it is. He can’t recognize a sentence if it begins with "miao." and ends with "lala.", or satisfies neither of the conditions.

5
I will go to play with you lala.
wow, welcome.
miao.lala.
miao.
miao .

Freda's
OMG>.< I don't know!
OMG>.< I don't know!
Rainbow's
OMG>.< I don't know!

import Control.Monad (replicateM)
import Data.List

detect s
    | f1 && not f2 = "Rainbow's"
    | not f1 && f2 = "Freda's"
    | otherwise = "OMG>.< I don't know!"
  where
    f1 = isPrefixOf "miao." s
    f2 = isSuffixOf "lala." s

main = do
  n <- readLn
  ss <- replicateM n getLine
  putStrLn $ unlines $ map detect ss

import Data.List

first s = take 5 s == "miao."
second s = (reverse $ take 5 $ reverse s) == "lala."

solve s = case (first s, second s) of
  (True, False) -> "Rainbow's"
  (False, True) -> "Freda's"
  _ -> "OMG>.< I don't know!"

main = interact $ unlines . map solve . tail . lines

import Data.List (isPrefixOf, isSuffixOf)

solve :: String -> String
solve s
  | isFreda && isRainbow  =  "OMG>.< I don't know!"
  | isFreda  =  "Freda's"
  | isRainbow  =  "Rainbow's"
  | otherwise  =  "OMG>.< I don't know!"
  where
    isFreda  =  isSuffixOf "lala." s
    isRainbow  =  isPrefixOf "miao." s

main :: IO ()
main  =  do
    n  <-  readLn
    sequence_ [getLine >>= putStrLn . solve | i <- [1..n]]

import Control.Monad

freda s = takeLast 5 s == "lala."
rainbow s = take 5 s == "miao."

takeLast n xs | length xs <= n = xs
              | otherwise = takeLast n $ tail xs

parse s | freda s && rainbow s = "OMG>.< I don't know!"
        | freda s = "Freda's"
        | rainbow s = "Rainbow's"
        | otherwise = "OMG>.< I don't know!"

main = do
    n <- fmap read getLine
    ls <- forM [1..n] (\_ -> getLine)
    mapM putStrLn . map parse $ ls

import Data.List

main = interact $ unlines . map getAnswer . tail . lines

getAnswer :: String -> String
getAnswer s | isPrefixOf "miao." s && isSuffixOf "lala." s = "OMG>.< I don't know!"
            | isSuffixOf "lala." s                         = "Freda's"
            | isPrefixOf "miao." s                         = "Rainbow's"
            | otherwise                                    = "OMG>.< I don't know!"

import Data.List
main=interact$unlines.map f.tail.lines
f cs
  | isPrefixOf "miao." cs && isSuffixOf "lala." cs = "OMG>.< I don't know!"
  | isPrefixOf "miao." cs = "Rainbow's"
  | isSuffixOf "lala." cs = "Freda's"
  | otherwise = "OMG>.< I don't know!"

readNlines :: Int -> [IO String]
readNlines 0 = []
readNlines n = getLine:(readNlines $ n-1)

readNlinesM = sequence . readNlines
isPrefix, isSuffix            :: Eq a => [a] -> [a] -> Bool
isPrefix x y                  =  x == take (length x) y
isSuffix x y                  =  lx <= ly && x == drop (ly - lx) y
     where lx                  =  length x
           ly                  =  length y

solve :: [String] -> String
solve [] = ""
solve (x:xs) = forone ++ "\n" ++ (solve xs)
    where forone =
             if a && not b then "Freda's" else
             if b && not a then "Rainbow's" else "OMG>.< I don't know!"
          a = isSuffix "lala." x
          b = isPrefix "miao." x
main = do
    n <- getLine
    lines <- readNlinesM(read(n))
    (putStrLn . solve) lines

import Data.List (isPrefixOf, isSuffixOf)

solve :: String -> String
solve s
  | isFreda && isRainbow  =  " OMG>.< I don't know!"
  | isFreda  =  "Freda's"
  | isRainbow  =  "Rainbow's"
  | otherwise  =  " OMG>.< I don't know!"
  where
    isFreda  =  isSuffixOf "lala." s
    isRainbow  =  isPrefixOf "miao." s

main :: IO ()
main  =  do
    n  <-  readLn
    sequence_ [getLine >>= putStrLn . solve | i <- [1..n]]

import Control.Monad

freda s = takeLast 5 s == "lala."
rainbow s = take 5 s == "miao."

takeLast n xs | length xs <= n = xs
              | otherwise = takeLast n $ tail xs

parse s | freda s && rainbow s = "OMG>.< I don't know!"
        | freda s = "Freda's"
        | rainbow s = "Rainbow's"
        | otherwise = "OMG>.< I don't know!"

main = do
    n <- fmap read getLine
    ls <- forM [1..n] (\_ -> getLine)
    print . unlines . map parse $ ls


Nezzar has a binary string $$$s$$$ of length $$$n$$$ that he wants to share with his best friend, Nanako. Nanako will spend $$$q$$$ days inspecting the binary string. At the same time, Nezzar wants to change the string $$$s$$$ into string $$$f$$$ during these $$$q$$$ days, because it looks better.It is known that Nanako loves consistency so much. On the $$$i$$$-th day, Nanako will inspect a segment of string $$$s$$$ from position $$$l_i$$$ to position $$$r_i$$$ inclusive. If the segment contains both characters '0' and '1', Nanako becomes unhappy and throws away the string.After this inspection, at the $$$i$$$-th night, Nezzar can secretly change strictly less than half of the characters in the segment from $$$l_i$$$ to $$$r_i$$$ inclusive, otherwise the change will be too obvious.Now Nezzar wonders, if it is possible to avoid Nanako being unhappy and at the same time have the string become equal to the string $$$f$$$ at the end of these $$$q$$$ days and nights.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^5$$$) — the number of test cases. The first line of each test case contains two integers $$$n,q$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$0 \le q \le 2 \cdot 10^5$$$). The second line of each test case contains a binary string $$$s$$$ of length $$$n$$$. The third line of each test case contains a binary string $$$f$$$ of length $$$n$$$. Then $$$q$$$ lines follow, $$$i$$$-th of them contains two integers $$$l_i,r_i$$$ ($$$1 \le l_i \le r_i \le n$$$)  — bounds of the segment, that Nanako will inspect on the $$$i$$$-th day. It is guaranteed that the sum of $$$n$$$ for all test cases doesn't exceed $$$2 \cdot 10^5$$$, and the sum of $$$q$$$ for all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print "YES" on the single line if it is possible to avoid Nanako being unhappy and have the string $$$f$$$ at the end of $$$q$$$ days and nights. Otherwise, print "NO". You can print each letter in any case (upper or lower).

NoteIn the first test case, $$$\underline{00000} \rightarrow \underline{000}11 \rightarrow 00111$$$ is one of the possible sequences of string changes.In the second test case, it can be shown that it is impossible to have the string $$$f$$$ at the end.

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

data Node
  = Single { getSum :: !Int }
  | Pair { getSum :: !Int, getLC :: Node, getRC :: Node }
  deriving Eq

data ST = ST { root :: Node, getL :: !Int, getR :: Int }
  deriving Eq

synth :: Node -> Node -> Node
synth le ri = Pair (getSum le + getSum ri) le ri

mkLazy :: Int -> Int -> Node
mkLazy val 1 = Single val
mkLazy val len = let
  rlen = quot len 2
  llen = len - rlen
  in  Pair (val * len) (mkLazy val llen) (mkLazy val rlen)

mkFromBS :: P.ByteString -> Int -> Int -> Node
mkFromBS arr le ri = if  le == ri
  then  Single $ case  P.index arr $ fromIntegral le  of
                   '0' -> 0
                   '1' -> 1
                   _ -> error "bad char in input"
  else  let
  m = quot (le + ri) 2
  lc = mkFromBS arr le m
  rc = mkFromBS arr (m+1) ri
  in  synth lc rc

initialize :: P.ByteString -> ST
initialize str = let
  len = fromIntegral $ P.length str
  in  ST (mkFromBS str 0 (len - 1)) 1 len

query :: ST -> Int -> Int -> Int
query st le ri = let
  nquery n ile iri
    | ri < ile || iri < le  = 0
    | le <= ile && iri <= ri  = getSum n
    | otherwise = let
        midVal = quot (ile + iri) 2
        in  nquery (getLC n) ile midVal + nquery (getRC n) (midVal + 1) iri
  in  nquery (root st) (getL st) (getR st)

update :: ST -> Int -> Int -> Int -> ST
update st le ri val = let
  nUpdate n ile iri
    | ri < ile || iri < le   = n
    | le <= ile && iri <= ri = mkLazy val (iri - ile + 1)
    | otherwise = let
        midVal = quot (ile + iri) 2
        in  synth (nUpdate (getLC n) ile midVal)
                  (nUpdate (getRC n) (midVal+1) iri)
  in  st { root = nUpdate (root st) (getL st) (getR st) }

data Query = Query !Int !Int

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, q] <- readInts
    s <- readLine
    f <- readLine
    qs <- replicateM q $ do
      [li, ri] <- readInts
      pure $ Query li ri
    let
      step :: Maybe ST -> Query -> Maybe ST
      step mst (Query li ri) = do
        st <- mst
        let
          len = (ri - li + 1)
          amt = query st li ri
        case  compare (2*amt) len  of
          LT -> Just $ update st li ri 0
          EQ -> Nothing
          GT -> Just $ update st li ri 1
      sST = initialize s
      fST = foldl' step (Just $ initialize f) $ reverse qs
    lift . P.putStrLn . P.pack $ case  fST  of
      Just v | v == sST  -> "YES"
      _ -> "NO"


Graph constructive problems are back! This time the graph you are asked to build should match the following properties.The graph is connected if and only if there exists a path between every pair of vertices.The diameter (aka "longest shortest path") of a connected undirected graph is the maximum number of edges in the shortest path between any pair of its vertices.The degree of a vertex is the number of edges incident to it.Given a sequence of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ construct a connected undirected graph of $$$n$$$ vertices such that:  the graph contains no self-loops and no multiple edges;  the degree $$$d_i$$$ of the $$$i$$$-th vertex doesn't exceed $$$a_i$$$ (i.e. $$$d_i \le a_i$$$);  the diameter of the graph is maximum possible. Output the resulting graph or report that no solution exists.

The first line contains a single integer $$$n$$$ ($$$3 \le n \le 500$$$) — the number of vertices in the graph. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n - 1$$$) — the upper limits to vertex degrees.

Print "NO" if no graph can be constructed under the given conditions. Otherwise print "YES" and the diameter of the resulting graph in the first line. The second line should contain a single integer $$$m$$$ — the number of edges in the resulting graph. The $$$i$$$-th of the next $$$m$$$ lines should contain two integers $$$v_i, u_i$$$ ($$$1 \le v_i, u_i \le n$$$, $$$v_i \neq u_i$$$) — the description of the $$$i$$$-th edge. The graph should contain no multiple edges — for each pair $$$(x, y)$$$ you output, you should output no more pairs $$$(x, y)$$$ or $$$(y, x)$$$.

import Data.List
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

proc i 0 d r = (d,r)
proc i t [] r = ([],r)
proc i t (x:d) r = proc i (t-1) d ((x,i):r)

go [] [a,b] d r = (d,(a,b):r)
go ((x,i):s) [] d r = go s [i] d r
go ((x,i):s) [a] d r = go s [i,a] d r
go ((1,i):s) [a,b] d r = go s [a,b] (i:d) r
go ((x,i):s) [a,b] d r =
  let (dd,rr) = proc i (x-2) d r in
  go s [i,b] dd ((a,i):rr)

asdasd [] = ""
asdasd ((a,b):s) = show(a)++" "++show(b)++"\n"++asdasd(s)

solve::String -> String
solve ss =
  let n:a = map toint $ words ss in
  let aa = sort $ zip a [1..n] in
  let (o,r) = go aa [] [] [] in
  if o /= [] then
    "NO\n"
  else
    let diam = n-1 - max ((length $ filter (==1) a) - 2) 0 in
    let ed = asdasd r in
    "YES "++show(diam)++"\n"++show(length r)++"\n"++ed

main = do
  interact $ solve


Crazy Town is a plane on which there are n infinite line roads. Each road is defined by the equation aix + biy + ci = 0, where ai and bi are not both equal to the zero. The roads divide the plane into connected regions, possibly of infinite space. Let's call each such region a block. We define an intersection as the point where at least two different roads intersect.Your home is located in one of the blocks. Today you need to get to the University, also located in some block. In one step you can move from one block to another, if the length of their common border is nonzero (in particular, this means that if the blocks are adjacent to one intersection, but have no shared nonzero boundary segment, then it are not allowed to move from one to another one in one step).Determine what is the minimum number of steps you have to perform to get to the block containing the university. It is guaranteed that neither your home nor the university is located on the road.

The first line contains two space-separated integers x1, y1 ( - 106 ≤ x1, y1 ≤ 106) — the coordinates of your home. The second line contains two integers separated by a space x2, y2 ( - 106 ≤ x2, y2 ≤ 106) — the coordinates of the university you are studying at. The third line contains an integer n (1 ≤ n ≤ 300) — the number of roads in the city. The following n lines contain 3 space-separated integers ( - 106 ≤ ai, bi, ci ≤ 106; |ai| + |bi| > 0) — the coefficients of the line aix + biy + ci = 0, defining the i-th road. It is guaranteed that no two roads are the same. In addition, neither your home nor the university lie on the road (i.e. they do not belong to any one of the lines).

NotePictures to the samples are presented below (A is the point representing the house; B is the point representing the university, different blocks are filled with different colors):

main = print . solve . map read . words =<< getContents
sign a x b y c = a * x + b * y + c > 0
solve (x1:y1:x2:y2:n:lines) = solve' lines
    where
        solve' []        = 0
        solve' (a:b:c:s) | (sign a x1 b y1 c) /= (sign a x2 b y2 c) = 1 + (solve' s)
                         | otherwise                                = solve' s

main = do
  [x1, y1] <- getLine >>= return. map read. words :: IO [Integer]
  [x2, y2] <- getLine >>= return. map read. words :: IO [Integer]
  getLine
  allroad <- getContents >>= return. map (map read. words). lines :: IO [[Integer]]
  print. length. filter (\[a, b, c] -> (a * x1 +  b * y1 + c) * (a * x2 + b * y2 + c) < 0) $ allroad

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

main :: IO ()
main = do
  [hx, hy, ux, uy] <- map (read :: String -> Integer) . words . unwords <$> replicateM 2 getLine
  n <- (read :: String -> Int) <$> getLine
  let cond (a, b, c) =  signum (a * hx + b * hy + c) * signum (a * ux + b * uy + c) < 0
  print =<< sum . map (fromEnum . cond . (\[a,b,c]->(a,b,c)) . map (read :: String -> Integer) . words) <$> replicateM n getLine

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Control.Applicative

tup3 [x, y, z] = (x, y, z)

ilo (x0, y0) (x1, y1) = x0 * y1 - x1 * y0

different p0@(x0, y0) p1@(x1, y1) l@(a, b, c)
  | a == 0 = y0 `compare` (-c/b) /= y1 `compare` (-c/b)
  | b == 0 = x0 `compare` (-c/a) /= x1 `compare` (-c/a)
  | c == 0 =
      let
        qy = (c + a) / (-b)
        v0 = ilo (x0, y0) (1, qy)
        v1 = ilo (x1, y1) (1, qy)
      in v0 * v1 < 0
  | otherwise =
      let
        px = (-c/a) -- (px, 0)
        qy = (-c/b) -- (0, qy)
        v0 = ilo (x0 - px, y0) (-px, qy)
        v1 = ilo (x1 - px, y1) (-px, qy)
      in v0 * v1 < 0

val True = 1
val False = 0

main = do
  [x0, y0]::[Double] <- map read . words <$> getLine
  [x1, y1]::[Double] <- map read . words <$> getLine
  n::Int <- read <$> getLine
  ps::[(Double, Double, Double)] <- forM [1..n] $ \_ -> (tup3 . map read . words <$> getLine)
  print . sum $ map (val . different (x0, y0) (x1, y1)) ps

import Control.Monad
readWords::Read a=>IO[a]
readWords = fmap (map read.words) getLine

side [a,b,c] [x,y] = signum $ a*x + b*y + c
intersects::(Num a,Eq a)=>[[a]]->[a]->Bool
intersects segment line = foldl1 (*) (map (side line) segment) == -1

count = (length.).filter

main = do
    way <- replicateM 2 readWords
    n <- readLn
    lines <- replicateM n readWords
    print$ count (intersects way) lines

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.Maybe
import Data.Int

main :: IO ()
main = do
  x1y1 <- readIntsIO
  x2y2 <- readIntsIO
  [n] <- readIntsIO
  abcs <- replicateM n readIntsIO
  print $ solve x1y1 x2y2 abcs

solve :: [Int] -> [Int] -> [[Int]] -> Int
solve x1y1 x2y2 abcs = ncross
  where
    f :: [Int] -> [Int] -> Int64
    f xy1 abc = sum $ zipWith ((*) `on` fromIntegral) xy1 abc
    nx1y1 = map (f (x1y1++[1])) abcs
    nx2y2 = map (f (x2y2++[1])) abcs
    ncross = length $ filter (0 >) $ zipWith ((*) `on` signum) nx1y1 nx2y2

readIntsIO :: IO [Int]
readIntsIO = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    contents <- getContents
    let allLines = lines contents
    let pointHome = lineToPoint $ allLines !! 0
    let pointUniversity = lineToPoint $ allLines !! 1

    putStrLn $ show
        $ length
            $ filter (\x -> x == True)
            $ map ((isDividedByLine pointHome pointUniversity) . lineToCoefficient)
            $ drop 3 allLines

lineToPoint :: String -> (Float, Float)
lineToPoint line = (intsInLine !! 0, intsInLine !! 1)
    where intsInLine = map read $ words line

lineToCoefficient :: String -> (Float, Float, Float)
lineToCoefficient line = (intsInLine !! 0, intsInLine !! 1, intsInLine !! 2)
    where intsInLine = map read $ words line

standardToPointSlope :: (Float, Float, Float) -> (Float, Float)
standardToPointSlope (cx, cy, c) = (
        (-1.0 * (cx / cy)),
        (-1.0 * (c / cy))
    )

getInterceptBySlope :: (Float, Float) -> Float -> Float
getInterceptBySlope (x, y) slope = y - slope * x

isDividedByLine :: (Float, Float) -> (Float, Float) -> (Float, Float, Float) -> Bool
isDividedByLine (x0, y0) (x1, y1) (cx, cy, c)
    | cx == 0 = (0 >= ((y0 - m0) * (y1 - m0)))
    | cy == 0 = (0 >= ((x0 - m1) * (x1 - m1)))
    | otherwise =
        0 >= (getInterceptBySlope (x0, y0) slope - intercept) * (getInterceptBySlope (x1, y1) slope - intercept)
        where
            m0 = -1.0 * c / cy
            m1 = -1.0 * c / cx
            (slope, intercept) = standardToPointSlope (cx, cy, c)

main = do
    contents <- getContents
    let allLines = lines contents
    let pointHome = lineToPoint $ allLines !! 0
    let pointUniversity = lineToPoint $ allLines !! 1

    putStrLn $ show
        $ length
            $ filter (\x -> x == True)
            $ map ((calculateIsLineCrossing pointHome pointUniversity) . lineToCoefficient)
            $ drop 3 allLines

lineToPoint :: String -> (Float, Float)
lineToPoint line = (intsInLine !! 0, intsInLine !! 1)
    where intsInLine = map read $ words line

lineToCoefficient :: String -> (Float, Float, Float)
lineToCoefficient line = (intsInLine !! 0, intsInLine !! 1, intsInLine !! 2)
    where intsInLine = map read $ words line

calculateParallelLineMByK :: (Float, Float) -> Float -> Float
calculateParallelLineMByK (x, y) k = y - k * x

calculateIsLineCrossing :: (Float, Float) -> (Float, Float) -> (Float, Float, Float) -> Bool
calculateIsLineCrossing (x0, y0) (x1, y1) (cx, cy, c)
    | cx == 0 = (0 >= ((y0 - m0) * (y1 - m0)))
    | cy == 0 = (0 >= ((x0 - m1) * (x1 - m1)))
    | otherwise =
        0 >= (calculateParallelLineMByK (x0, y0) k - m) * (calculateParallelLineMByK (x1, y1) k - m)
            where
                m0 = -1.0 * c / cy
                m1 = -1.0 * c / cx
                (k, m) = coefficientToKM (cx, cy, c)

coefficientToKM :: (Float, Float, Float) -> (Float, Float)
coefficientToKM (cx, cy, c) = (-1.0 * (cx / cy), -1.0 * (c / cy))

import           Control.Monad

main :: IO ()
main = do
  [hx, hy] <- map (read :: String -> Int) . words <$> getLine
  [ux, uy] <- map (read :: String -> Int) . words <$> getLine
  n <- (read :: String -> Int) <$> getLine
  let cond (a, b, c) = compare (a * hx + b * hy + c) 0 /= compare (a * ux + b * uy + c) 0
  print =<< sum . map (fromEnum . cond . (\[a,b,c]->(a,b,c)) . map (read :: String -> Int) . words) <$> replicateM n getLine

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

main :: IO ()
main = do
  [hx, hy, ux, uy, n] <- map (read :: String -> Int) . words . unwords <$> replicateM 3 getLine
  let cond (a, b, c) =  signum (a * hx + b * hy + c) * signum (a * ux + b * uy + c) < 0
  print =<< sum . map (fromEnum . cond . (\[a,b,c]->(a,b,c)) . map (read :: String -> Int) . words) <$> replicateM n getLine

import           Control.Monad

main :: IO ()
main = do
  [hx, hy] <- map (read :: String -> Int) . words <$> getLine
  [ux, uy] <- map (read :: String -> Int) . words <$> getLine
  n <- (read :: String -> Int) <$> getLine
  let cond (a, b, c) = (a * hx + b * hy + c) * (a * ux + b * uy + c) < 0
  print =<< sum . map (fromEnum . cond . (\[a,b,c]->(a,b,c)) . map (read :: String -> Int) . words) <$> replicateM n getLine

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Control.Applicative

tup3 [x, y, z] = (x, y, z)

ilo (x0, y0) (x1, y1) = x0 * y1 - x1 * y0

different p0@(x0, y0) p1@(x1, y1) l@(a, b, c)
  | a == 0 = x0 `compare` (-c/b) /= x1 `compare` (-c/b)
  | b == 0 = y0 `compare` (-c/a) /= y1 `compare` (-c/a)
  | c == 0 =
      let
        qy = (c + a) / (-b)
        v0 = ilo (x0, y0) (1, qy)
        v1 = ilo (x1, y1) (1, qy)
      in v0 * v1 < 0
  | otherwise =
      let
        px = (-c/a) -- (px, 0)
        qy = (-c/b) -- (0, qy)
        v0 = ilo (x0 - px, y0) (-px, qy)
        v1 = ilo (x1 - px, y1) (-px, qy)
      in v0 * v1 < 0

val True = 1
val False = 0

main = do
  [x0, y0]::[Double] <- map read . words <$> getLine
  [x1, y1]::[Double] <- map read . words <$> getLine
  n::Int <- read <$> getLine
  ps::[(Double, Double, Double)] <- forM [1..n] $ \_ -> (tup3 . map read . words <$> getLine)
  print . sum $ map (val . different (x0, y0) (x1, y1)) ps

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

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

main :: IO ()
main = do
  [x1, y1] <- readIntsIO
  [x2, y2] <- readIntsIO
  [n] <- readIntsIO
  abcs <- replicateM n readIntsIO
  print $ solve (x1, y1) (x2, y2) abcs

solve :: (Int, Int) -> (Int, Int)-> [[Int]] -> Int
solve x1y1 x2y2 abcs = ncross
  where
    f (x, y) [a, b, c] = a * x + b * y + c
    nx1y1 = map (f x1y1) abcs
    nx2y2 = map (f x2y2) abcs
    ncross = length $ filter (0 >) $ zipWith (*) nx1y1 nx2y2

readIntsIO :: IO [Int]
readIntsIO = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main = do
    contents <- getContents
    let allLines = lines contents
    let pointHome = lineToPoint $ allLines !! 0
    let pointUniversity = lineToPoint $ allLines !! 1

    putStrLn $ show
        $ length
            $ filter (\x -> x == True)
            $ map ((calculateIsLineCrossing pointHome pointUniversity) . lineToCoefficient)
            $ drop 3 allLines

lineToPoint :: String -> (Int, Int)
lineToPoint line = (intsInLine !! 0, intsInLine !! 1)
    where intsInLine = map read $ words line

lineToCoefficient :: String -> (Int, Int, Int)
lineToCoefficient line = (intsInLine !! 0, intsInLine !! 1, intsInLine !! 2)
    where intsInLine = map read $ words line

calculateIsLineCrossing :: (Int, Int) -> (Int, Int) -> (Int, Int, Int) -> Bool
calculateIsLineCrossing point0 point1 coefficients =
    0 >= (applyLineEquation point0 coefficients * applyLineEquation point1 coefficients)

applyLineEquation :: (Int, Int) -> (Int, Int, Int) -> Int
applyLineEquation (x, y) (cx, cy, c) = x * cx + y * cy + c


Brothers Fred and George Weasley once got into the sporting goods store and opened a box of Quidditch balls. After long and painful experiments they found out that the Golden Snitch is not enchanted at all. It is simply a programmed device. It always moves along the same trajectory, which is a polyline with vertices at the points (x0, y0, z0), (x1, y1, z1), ..., (xn, yn, zn). At the beginning of the game the snitch is positioned at the point (x0, y0, z0), and then moves along the polyline at the constant speed vs. The twins have not yet found out how the snitch behaves then. Nevertheless, they hope that the retrieved information will help Harry Potter and his team in the upcoming match against Slytherin. Harry Potter learned that at the beginning the game he will be at the point (Px, Py, Pz) and his super fast Nimbus 2011 broom allows him to move at the constant speed vp in any direction or remain idle. vp is not less than the speed of the snitch vs. Harry Potter, of course, wants to catch the snitch as soon as possible. Or, if catching the snitch while it is moving along the polyline is impossible, he wants to hurry the Weasley brothers with their experiments. Harry Potter catches the snitch at the time when they are at the same point. Help Harry.

The first line contains a single integer n (1 ≤ n ≤ 10000). The following n + 1 lines contain the coordinates xi, yi, zi, separated by single spaces. The coordinates of any two consecutive points do not coincide. The next line contains the velocities vp and vs, the last line contains Px, Py, Pz, separated by single spaces. All the numbers in the input are integers, their absolute value does not exceed 104. The speeds are strictly positive. It is guaranteed that vs ≤ vp.

If Harry Potter can catch the snitch while it is moving along the polyline (including the end (xn, yn, zn)), print "YES" in the first line (without the quotes). Print in the second line t, which is the earliest moment of time, when Harry will be able to catch the snitch. On the third line print three numbers X, Y, Z, the coordinates of the point at which this happens. The absolute or relative error in the answer should not exceed 10 - 6. If Harry is not able to catch the snitch during its moving along the described polyline, print "NO".

import Control.Monad (liftM)
import Prelude hiding (catch)

eps :: Double
eps  =  1e-11

type Coord     =  Double
type Velocity  =  Double
type Time      =  Double
type Coords    =  (Coord, Coord, Coord)
type Harry     =  (Velocity, Coords)
type Segment   =  (Coords, Coords)

distance :: Coords -> Coords -> Double
distance (x1, y1, z1) (x2, y2, z2)
  =  sqrt $ sum $ map (^2) $ zipWith (-) [x1, y1, z1] [x2, y2, z2]

catch :: Velocity -> Time -> Segment -> Velocity -> Coords -> Bool
catch vS time (a, b) vP pP  =  timeS + eps > timeP
  where
    timeS  =  time + (distance a b) / vS
    timeP  =  (distance pP b) / vP

solve :: Velocity -> [Coords] -> Velocity -> Coords -> Maybe (Time, Coords)
solve vS (p0 : psS) vP pP
  | distance pP p0 < eps  =  Just (0, pP)
  | otherwise  =  solve' 0 (p0 : psS)
  where
    solve' time (a : b : psS)
      | catch vS time (a, b) vP pP  =  solve'' time (a, b)
      | otherwise  =  solve' (time + (distance a b) / vS) (b : psS)
    solve' _ _  =  Nothing
    solve'' time (a, b)
      | distance a b < eps  =  Just (time, a)
      | catch vS time (a, m) vP pP  =  solve'' time (a, m)
      | otherwise  =  solve'' (time + (distance a m) / vS) (m, b)
      where
        m  =  (\(x1, y1, z1) (x2, y2, z2) -> (0.5 * (x1 + x2), 0.5 * (y1 + y2), 0.5 * (z1 + z2))) a b

parseCoords :: String -> Coords
parseCoords line  =  case map read (words line) of
    [x, y, z]  ->  (x, y, z)

main :: IO()
main  =  do
    ls  <-  liftM lines getContents
    let n    =  read $ head ls
    let psS  =  map parseCoords . take (n + 1) . tail $ ls
    let [vP, vS]  =  map read . words . (!! (n + 2)) $ ls
    let pP  =  parseCoords . (!! (n + 3)) $ ls
    case solve vS psS vP pP of
        Just (time, (x, y, z))  ->  putStrLn "YES" >> print time >> putStrLn (concat [show x, " ", show y, " ", show z])
        Nothing  ->  putStrLn "NO"

import IO
import Text.Printf

toList (a, b, c) = a:b:c:[]
fList (a:b:c:_) = (a, b, c)

delta :: (Double, Double, Double) -> (Double, Double, Double) -> Double
delta (x1, y1, z1) (x2, y2, z2) = sqrt ((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2)

deltaPlus :: (Double, Double, Double) -> (Double, Double, Double) -> Double -> (Double, Double, Double)
deltaPlus (x1, y1, z1) (x2, y2, z2) r =
    let (dx, dy, dz) = (x2 - x1, y2 - y1, z2 - z1)
    in  (x1 + dx*r, y1 + dy*r, z1 + dz*r)

coord = do
           line <- getLine
           --putStrLn (">" ++ (show (words line)))
           return (fList (map (read :: String -> Double) (words line)))

makeList 0 _ _ = return []
makeList n a p = do
                 c <- coord
                 other <- makeList (n-1) (a + delta c p) c
                 return ((c, a + delta c p, delta c p):other)

binSearch :: (Double -> (Int, a)) -> Double -> Double -> IO (Double, a)
binSearch f min max | max == min = error ("bin search: min == max")
binSearch f min max | otherwise = do
        --putStrLn (show (min, max, (max+min)/2))
        case (f ((max+min)/2)) of
             (-1, _) -> binSearch f min ((max + min)/2)
             (0, cx) -> return ((max + min)/2, cx)
             (1, _) -> binSearch f ((max + min)/2) max

bsf c0 c1 vp vc p t0 t =
    let d  = delta c0 c1
        cx = deltaPlus c0 c1 ((t - t0) / (d/vc))
        tn = (delta cx p) / vp
    in if (abs (tn - t)) < ((0.1)^(11))
       then (0, cx)
       else if (tn - t) < 0
            then (-1, cx)
            else (1, cx)

ff (c:[]) _ _ _ = return Nothing
ff ((c0, preLen, _):cc@(c1, preLen1, len):cs) vp vc p =
        if ((preLen1 / vc) - ((delta p c1) / vp)) >= -((0.1)^(11))
        then do r <- (binSearch (bsf c0 c1 vp vc p (preLen/vc)) (preLen/vc) (preLen1/vc))
                return (Just r)
        else ff (cc:cs) vp vc p

main = do
    n <- (getLine >>= return . read) :: IO Int
    c0 <- coord
    c <- makeList n 0 c0
    l <- getLine
    let (l1:l2:ll) = words l
        ivp = read l1 :: Int
        ivc = read l2 :: Int
        vp = realToFrac ivp
        vc = realToFrac ivc
    p <- coord
    a <- ff ((c0, 0, 0):c) vp vc p
    p <- if (a == Nothing)
         then putStrLn "NO"
         else let (Just (t, (x, y, z))) = a
              in printf "YES\n%.10f\n%.10f %.10f %.10f" t x y z
    return (0)

import Control.Monad (liftM)
import Prelude hiding (catch)

eps :: Double
eps  =  1e-10

type Coord     =  Double
type Velocity  =  Double
type Time      =  Double
type Coords    =  (Coord, Coord, Coord)
type Harry     =  (Velocity, Coords)
type Segment   =  (Coords, Coords)

distance :: Coords -> Coords -> Double
distance (x1, y1, z1) (x2, y2, z2)
  =  sqrt $ sum $ map (^2) $ zipWith (-) [x1, y1, z1] [x2, y2, z2]

catch :: Velocity -> Time -> Segment -> Velocity -> Coords -> Bool
catch vS time (a, b) vP pP  =  timeS + eps > timeP
  where
    timeS  =  time + (distance a b) / vS
    timeP  =  (distance pP b) / vP

solve :: Velocity -> [Coords] -> Velocity -> Coords -> Maybe (Time, Coords)
solve vS (p0 : psS) vP pP
  | distance pP p0 < eps  =  Just (0, pP)
  | otherwise  =  solve' 0 (p0 : psS)
  where
    solve' time (a : b : psS)
      | catch vS time (a, b) vP pP  =  solve'' time (a, b)
      | otherwise  =  solve' (time + (distance a b) / vS) (b : psS)
    solve' _ _  =  Nothing
    solve'' time (a, b)
      | distance a b < 0.5 * eps  =  Just (time, a)
      | catch vS time (a, m) vP pP  =  solve'' time (a, m)
      | otherwise  =  solve'' (time + (distance a m) / vS) (m, b)
      where
        m  =  (\(x1, y1, z1) (x2, y2, z2) -> (0.5 * (x1 + x2), 0.5 * (y1 + y2), 0.5 * (z1 + z2))) a b

parseCoords :: String -> Coords
parseCoords line  =  case map read (words line) of
    [x, y, z]  ->  (x, y, z)

main :: IO()
main  =  do
    ls  <-  liftM lines getContents
    let n    =  read $ head ls
    let psS  =  map parseCoords . take (n + 1) . tail $ ls
    let [vP, vS]  =  map read . words . (!! (n + 2)) $ ls
    let pP  =  parseCoords . (!! (n + 3)) $ ls
    case solve vS psS vP pP of
        Just (time, (x, y, z))  ->  putStrLn "YES" >> print time >> putStrLn (concat [show x, " ", show y, " ", show z])
        Nothing  ->  putStrLn "NO"

import IO
import Text.Printf

toList (a, b, c) = a:b:c:[]
fList (a:b:c:_) = (a, b, c)

delta :: (Double, Double, Double) -> (Double, Double, Double) -> Double
delta (x1, y1, z1) (x2, y2, z2) = sqrt ((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2)

deltaPlus :: (Double, Double, Double) -> (Double, Double, Double) -> Double -> (Double, Double, Double)
deltaPlus (x1, y1, z1) (x2, y2, z2) r =
    let (dx, dy, dz) = (x2 - x1, y2 - y1, z2 - z1)
    in  (x1 + dx*r, y1 + dy*r, z1 + dz*r)

coord = do
           line <- getLine
           --putStrLn (">" ++ (show (words line)))
           return (fList (map (read :: String -> Double) (words line)))

makeList 0 _ _ = return []
makeList n a p = do
                 c <- coord
                 other <- makeList (n-1) (a + delta c p) c
                 return ((c, a + delta c p, delta c p):other)

binSearch :: (Double -> (Int, a)) -> Double -> Double -> IO (Double, a)
binSearch f min max | max == min = error ("bin search: min == max")
binSearch f min max | otherwise = do
        --putStrLn (show (min, max, (max+min)/2))
        case (f ((max+min)/2)) of
             (-1, _) -> binSearch f min ((max + min)/2)
             (0, cx) -> return ((max + min)/2, cx)
             (1, _) -> binSearch f ((max + min)/2) max

bsf c0 c1 vp vc p t0 t =
    let d  = delta c0 c1
        cx = deltaPlus c0 c1 ((t - t0) / (d/vc))
        tn = (delta cx p) / vp
    in if (abs (tn - t)) < ((0.1)^(7))
       then (0, cx)
       else if (tn - t) < 0
            then (-1, cx)
            else (1, cx)

ff (c:[]) _ _ _ = return Nothing
ff ((c0, preLen, _):cc@(c1, preLen1, len):cs) vp vc p = --do
        --putStrLn (show cc)
        if ((preLen1 / vc) >= ((delta p c1) / vp))
        then do r <- (binSearch (bsf c0 c1 vp vc p (preLen/vc)) (preLen/vc) (preLen1/vc))
                return (Just r)
        else ff (cc:cs) vp vc p

p1 (Just (t, (x, y, z))) = "YES2\n" ++
                  (
                   showsPrec 6 t ("\n" ++
                   showsPrec 6 x (" " ++
                   showsPrec 6 y (" " ++
                   showsPrec 6 z "")))
                  )

p2 (Just (t, (x, y, z))) = "YES\n" ++ (show t) ++
                           "\n" ++ (show x) ++ " " ++
                           (show y) ++ " " ++ (show z)

main = do
--    putStrLn ">0"
    n <- (getLine >>= return . read) :: IO Int
--    putStrLn ">1"
    c0 <- coord
--    putStrLn ">2"
    c <- makeList n 0 c0
--    putStrLn ">3"
    l <- getLine
    let (l1:l2:ll) = words l
        ivp = read l1 :: Int
        ivc = read l2 :: Int
        vp = realToFrac ivp
        vc = realToFrac ivc
--    putStrLn ">4"
    p <- coord
--    putStrLn ">end"
    a <- ff ((c0, 0, 0):c) vp vc p
--    putStrLn ">c"
    p <- if (a == Nothing)
         then putStrLn "NO"
         else let (Just (t, (x, y, z))) = a
              in printf "YES\n%.6f\n%.6f %.6f %.6f" t x y z
    return (0)

import IO
import Text.Printf

toList (a, b, c) = a:b:c:[]
fList (a:b:c:_) = (a, b, c)

delta :: (Double, Double, Double) -> (Double, Double, Double) -> Double
delta (x1, y1, z1) (x2, y2, z2) = sqrt ((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2)

deltaPlus :: (Double, Double, Double) -> (Double, Double, Double) -> Double -> (Double, Double, Double)
deltaPlus (x1, y1, z1) (x2, y2, z2) r =
    let (dx, dy, dz) = (x2 - x1, y2 - y1, z2 - z1)
    in  (x1 + dx*r, y1 + dy*r, z1 + dz*r)

coord = do
           line <- getLine
           --putStrLn (">" ++ (show (words line)))
           return (fList (map (read :: String -> Double) (words line)))

makeList 0 _ _ = return []
makeList n a p = do
                 c <- coord
                 other <- makeList (n-1) (a + delta c p) c
                 return ((c, a + delta c p, delta c p):other)

binSearch :: (Double -> (Int, a)) -> Double -> Double -> IO (Double, a)
binSearch f min max | max == min = error ("bin search: min == max")
binSearch f min max | otherwise = do
        --putStrLn (show (min, max, (max+min)/2))
        case (f ((max+min)/2)) of
             (-1, _) -> binSearch f min ((max + min)/2)
             (0, cx) -> return ((max + min)/2, cx)
             (1, _) -> binSearch f ((max + min)/2) max

bsf c0 c1 vp vc p t0 t =
    let d  = delta c0 c1
        cx = deltaPlus c0 c1 ((t - t0) / (d/vc))
        tn = (delta cx p) / vp
    in if (abs (tn - t)) < ((0.1)^(9))
       then (0, cx)
       else if (tn - t) < 0
            then (-1, cx)
            else (1, cx)

ff (c:[]) _ _ _ = return Nothing
ff ((c0, preLen, _):cc@(c1, preLen1, len):cs) vp vc p =
        if ((preLen1 / vc) - ((delta p c1) / vp)) >= -((0.1)^(7))
        then do r <- (binSearch (bsf c0 c1 vp vc p (preLen/vc)) (preLen/vc) (preLen1/vc))
                return (Just r)
        else ff (cc:cs) vp vc p

main = do
    n <- (getLine >>= return . read) :: IO Int
    c0 <- coord
    c <- makeList n 0 c0
    l <- getLine
    let (l1:l2:ll) = words l
        ivp = read l1 :: Int
        ivc = read l2 :: Int
        vp = realToFrac ivp
        vc = realToFrac ivc
    p <- coord
    a <- ff ((c0, 0, 0):c) vp vc p
    p <- if (a == Nothing)
         then putStrLn "NO"
         else let (Just (t, (x, y, z))) = a
              in printf "YES\n%.7f\n%.7f %.7f %.7f" t x y z
    return (0)


You are given an integer $$$n$$$ and an integer $$$k$$$.In one step you can do one of the following moves:   decrease $$$n$$$ by $$$1$$$;  divide $$$n$$$ by $$$k$$$ if $$$n$$$ is divisible by $$$k$$$. For example, if $$$n = 27$$$ and $$$k = 3$$$ you can do the following steps: $$$27 \rightarrow 26 \rightarrow 25 \rightarrow 24 \rightarrow 8 \rightarrow 7 \rightarrow 6 \rightarrow 2 \rightarrow 1 \rightarrow 0$$$.You are asked to calculate the minimum number of steps to reach $$$0$$$ from $$$n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of queries. The only line of each query contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 10^{18}$$$, $$$2 \le k \le 10^{18}$$$).

For each query print the minimum number of steps to reach $$$0$$$ from $$$n$$$ in single line.

NoteSteps for the first test case are: $$$59 \rightarrow 58 \rightarrow 57 \rightarrow 19 \rightarrow 18 \rightarrow 6 \rightarrow 2 \rightarrow 1 \rightarrow 0$$$.In the second test case you have to divide $$$n$$$ by $$$k$$$ $$$18$$$ times and then decrease $$$n$$$ by $$$1$$$.

module Main where

import Control.Monad
import System.IO
import Data.Char
import Data.Array
import qualified Data.Map as Map
import Data.List

isDivisible :: Integer -> Integer -> Bool
isDivisible a b
    | b == 0 = False
    | a < b = False
    | (a `mod` b) == 0 = True
    | otherwise = False

stepsToZero :: Integer -> Integer -> Integer -> Integer
stepsToZero k n count
    | n == 0 = count
    | otherwise =
        if isDivisible n k
            then stepsToZero k (n `div` k) (count + 1)
            else
               let delta = n `mod` k
               in stepsToZero k (n - delta) (count + delta)

main :: IO()
main = do

    q <- readLn :: IO Int
    forM_ [1..q] $ \q_itr -> do
        s <- getLine
        let ws = words s
        let nums = map read ws :: [Integer]
        let (n:k:_) = nums

        let result = stepsToZero k n 0
        putStrLn $ show result

import Data.Int
main = interact $ unlines . map (show . solve) . pairs . map read . tail . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
solve (0,_) = 0
solve (n,k) | n `mod` k == 0 = 1 + solve (n `div` k,k)
            | otherwise = n `mod` k + solve (n - n`mod` k,k)

{-# LANGUAGE BangPatterns #-}

import Control.Monad

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
      [n, k] <- map read.words <$> getLine
      print $ solve n k

solve :: Integer -> Integer -> Integer
solve n k = go 0 n
  where
    go !res x
        | x == 0 = res
        | r == 0 = go (res + 1) (quot x k)
        | otherwise = go (res + r) (x - r)
      where
        !r = rem x k

import Data.List

divNum :: Integer -> Integer -> Integer
divNum 0 _ = 0
divNum n k = mod n k + 1 + divNum (div n k) k

solve :: [Integer] -> String
solve [n, k] = show ((divNum n k) - 1)

main = interact $ intercalate "\n" .  map solve .  map (map (\x -> read x :: Integer) .  words) . tail . lines

import Data.List

divNum :: Integer -> Integer -> Integer
divNum 0 _ = 0
divNum n k = mod n k + 1 + divNum (div n k) k

solve :: [Integer] -> String
solve [n, k] = show  (divNum n $ k - 1)

main = interact $ intercalate "\n" .  map solve .  map (map (\x -> read x :: Integer) .  words) . tail . lines


Lee is going to fashionably decorate his house for a party, using some regular convex polygons...Lee thinks a regular $$$n$$$-sided (convex) polygon is beautiful if and only if he can rotate it in such a way that at least one of its edges is parallel to the $$$OX$$$-axis and at least one of its edges is parallel to the $$$OY$$$-axis at the same time.Recall that a regular $$$n$$$-sided polygon is a convex polygon with $$$n$$$ vertices such that all the edges and angles are equal.Now he is shopping: the market has $$$t$$$ regular polygons. For each of them print YES if it is beautiful and NO otherwise.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of polygons in the market.  Each of the next $$$t$$$ lines contains a single integer $$$n_i$$$ ($$$3 \le n_i \le 10^9$$$): it means that the $$$i$$$-th polygon is a regular $$$n_i$$$-sided polygon.

For each polygon, print YES if it's beautiful or NO otherwise (case insensitive).

NoteIn the example, there are $$$4$$$ polygons in the market. It's easy to see that an equilateral triangle (a regular $$$3$$$-sided polygon) is not beautiful, a square (a regular $$$4$$$-sided polygon) is beautiful and a regular $$$12$$$-sided polygon (is shown below) is beautiful as well.

solve :: Integer -> Bool
solve n = elem 90 $ map (\k -> mod (k*180 - ((k*360) `div` n)) 180) $ map (\q -> q*n `div` 360) $ filter (\q -> (mod (q * n) (360)) == 0) [1..359]
--solve n = elem 0 $ map (`mod` 4) [n, 2*n, 3*n]
{--solve n = let ks = [(ceiling (4 / fromIntegral(n)))..(floor (4- (4 / fromIntegral(n))))] in
    elem 0 $ map (\x -> (x*n) `mod` 4) ks--}
--solve n = 0 `elem` map (\x -> (4*x) `mod` n) [1..(n-1)]
--solve n = elem 0 (map (`mod` n) (map (*4) ([1..(n-1)])))

getInt::IO Integer
getInt=do
    line <- getLine
    let i = read line :: Integer
    return (i)

main::IO()
main=do
    t <- getInt
    for t where
        for 0 = return ()
        for t = do
            n <- getInt
            if solve n then putStrLn "YES" else putStrLn "NO"
            for (t-1)

solve :: String -> String
solve s
  | mod (read s) 4 == 0 = "YES"
  | otherwise = "No"

io :: String -> String
io s = unlines $ map solve $ drop 1 $ lines s

main :: IO ()
main = do
  interact io

module Main where

main = interact $ unlines . map (\x -> if  (read x :: Int) `mod` 4 == 0 then "YES" else "NO" ) .   tail . lines

repeatNTimes 0 _ = return ()
repeatNTimes n action =
 do
  action
  repeatNTimes (n-1) action

main = do
    input1 <- getLine
    let t = read input1 :: Int

    --main cycle
    repeatNTimes t (do
        input2 <- getLine
        let n = read input2 :: Int

        if mod n 4 == 0 then putStrLn "YES" else putStrLn "NO"
        )

import Control.Monad (replicateM_)
main = readLn >>= flip replicateM_ (readLn >>= putStrLn . f) where
    f x | x `mod` 4 == 0 = "YES"
    f _ = "NO"

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.List
import Data.Tuple

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ reverse curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

(|>) = flip ($)

main = do
  input <- getContents
  let _:tokens = read <$> split input :: [Integer]
      res = tokens |> unfoldr (\case
        []  -> Nothing
        n:rest  -> Just (ans, rest) where
          ans = if subres then "YES" else "NO"
          subres = (90*n `mod` 360 == 0)
        )
  sequence_ $ putStrLn <$> res

solve :: Integer -> String
solve n= if mod n 4 == 0 then "YES" else "NO"

parse :: String -> Integer
parse = read

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

solveCase :: Int -> IO()
solveCase 0 = return ()
solveCase t = do
  test <- getLine
  putStrLn . solve . parse  $ test
  solveCase (t-1)

getInt :: IO Int
getInt = fmap read getLine

main :: IO()
main = do
  n <- getInt
  solveCase n

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

process a | mod a 4 ==0 = "YES"
	  | otherwise = "NO"

main = do
		n<-read <$> getLine ::IO Int
		a<- map read <$> replicateM n getLine ::IO [Int]
		mapM_ putStrLn  $ map  process a

main = interact $ unlines . map process . map read . tail . lines
process x
    | mod x 4 == 0 = "YES"
    | otherwise = "NO"

solve :: Int -> Bool
solve n = let ks = [(ceiling (4 / fromIntegral(n)))..(floor (4- (4 / fromIntegral(n))))] in
    elem 0 $ map (\x -> (x*n) `mod` 4) ks
--solve n = 0 `elem` map (\x -> (4*x) `mod` n) [1..(n-1)]
--solve n = elem 0 (map (`mod` n) (map (*4) ([1..(n-1)])))

getInt::IO Int
getInt=do
    line <- getLine
    let i = read line :: Int
    return (i)

main::IO()
main=do
    t <- getInt
    for t where
        for 0 = return ()
        for t = do
            n <- getInt
            if solve n then putStrLn "YES" else putStrLn "NO"
            for (t-1)

getInt::IO Int
getInt=do
    line <- getLine
    let i = read line :: Int
    return (i)

main::IO()
main=do
    t <- getInt
    for t where
        for 0 = return ()
        for t = do
            n <- getInt
            if n `mod` 2 == 0 then putStrLn "YES" else putStrLn "NO"
            for (t-1)

solve :: Int -> Bool
solve n = elem 90 $ map (\k -> mod (k*180 - ((k*360) `div` n)) 180) $ map (\q -> q*n `div` 360) $ filter (\q -> (mod (q * n) (360)) == 0) [1..359]
--solve n = elem 0 $ map (`mod` 4) [n, 2*n, 3*n]
{--solve n = let ks = [(ceiling (4 / fromIntegral(n)))..(floor (4- (4 / fromIntegral(n))))] in
    elem 0 $ map (\x -> (x*n) `mod` 4) ks--}
--solve n = 0 `elem` map (\x -> (4*x) `mod` n) [1..(n-1)]
--solve n = elem 0 (map (`mod` n) (map (*4) ([1..(n-1)])))

getInt::IO Int
getInt=do
    line <- getLine
    let i = read line :: Int
    return (i)

main::IO()
main=do
    t <- getInt
    for t where
        for 0 = return ()
        for t = do
            n <- getInt
            if solve n then putStrLn "YES" else putStrLn "NO"
            for (t-1)

module Main where

main = interact $ unlines . map (\x -> let v = 90 / (360 / (read x :: Double) ) in if (v - (fromIntegral $ floor v )) == 0.0 then "YES" else "NO" ) .   tail . lines

module Main where

main = interact $ unlines . map (\x -> let v = map (/ (360 / (read x :: Double))) [90,270] in if (any (==0.0) $ zipWith (-) v $ map (fromIntegral .floor) v ) then "YES" else "NO" ) .   tail . lines

solve :: Integer -> String
solve n= if mod n 2 == 0 then "YES" else "NO"

parse :: String -> Integer
parse = read

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

solveCase :: Int -> IO()
solveCase 0 = return ()
solveCase t = do
  test <- getLine
  putStrLn . show . solve . parse  $ test
  solveCase (t-1)

getInt :: IO Int
getInt = fmap read getLine

main :: IO()
main = do
  n <- getInt
  solveCase n

solve :: Integer -> String
solve n= if mod n 2 == 0 then "YES" else "NO"

parse :: String -> Integer
parse = read

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

solveCase :: Int -> IO()
solveCase 0 = return ()
solveCase t = do
  test <- getLine
  putStrLn . solve . parse  $ test
  solveCase (t-1)

getInt :: IO Int
getInt = fmap read getLine

main :: IO()
main = do
  n <- getInt
  solveCase n

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

process a | div a 4 ==0 = "YES"
	  | otherwise = "NO"

main = do
		n<-read <$> getLine ::IO Int
		a<- map read <$> replicateM n getLine ::IO [Int]
		mapM_ putStrLn  $ map  process a


You are given an array a. Some element of this array ai is a local minimum iff it is strictly less than both of its neighbours (that is, ai < ai - 1 and ai < ai + 1). Also the element can be called local maximum iff it is strictly greater than its neighbours (that is, ai > ai - 1 and ai > ai + 1). Since a1 and an have only one neighbour each, they are neither local minima nor local maxima.An element is called a local extremum iff it is either local maximum or local minimum. Your task is to calculate the number of local extrema in the given array.

The first line contains one integer n (1 ≤ n ≤ 1000) — the number of elements in array a. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 1000) — the elements of array a.

Print the number of local extrema in the given array.

main = do
    n <- getLine
    xs <- (map read . words) `fmap` getLine :: IO [Int]
    print $ (length . filter localExtrema) (zip3 xs (tail xs) (tail (tail xs)))

localExtrema (x,y,z) = (x < y && y > z) || (x > y && y < z)

module Main where
main = getContents >>= print . exec
exec = solve . tail . map read . words
solve [_] = 0
solve [_, _] = 0
solve xs = sum $ zipWith3 (\a b c -> fromEnum $ (a < b && b > c) || (a > b && b < c)) xs (tail xs :: [Int]) (tail $ tail xs)

solve :: [Int] -> [Int]
solve (x:y:z:xs)
    | y < x && y < z || y > x && y > z = y : (solve (y:z:xs))
    | otherwise = solve (y:z:xs)
solve _ = []

main = do
    getLine
    getContents >>= print.length.solve.(map read).words

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

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

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

  localExtreme :: (Int, Int, Int) -> Bool
  localExtreme (a, b, c)
    | a < b && b > c = True
    | a > b && b < c = True
    | otherwise = False

  reduceExtreme :: Int -> [Int] -> Int
  reduceExtreme i (a:b:c:xs)
    | localExtreme (a, b, c) = reduceExtreme (i + 1) (b:c:xs)
    | otherwise = reduceExtreme i (b:c:xs)
  reduceExtreme i (b:c:[]) = i
  reduceExtreme i (c:[]) = i
  reduceExtreme i [] = i

  test :: IO()
  test = do
    let xs = []
    print $ reduceExtreme 0 xs

  main :: IO()
  main = do
    n <- getLine
    xs <- getLine >>= return . (map readInt) . words
    print $ reduceExtreme 0 xs

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

process n [a] = n
process n [a,b] = n
process n (a:b:c:ds) | a<b && c<b = process (n+1) (b:c:ds)
		     | a>b && c>b = process (n+1) (b:c:ds)
		     | otherwise = process n (b:c:ds)

main = do
		n<-read <$> getLine ::IO Int
		s<- map read <$> words <$> getLine ::IO [Int]
		print $ process 0 s

solve :: [Int] -> [Int]
solve (x:y:z:xs)
    | y < x && y < z || y > x && y > z = y : (solve (y:z:xs))
    | otherwise = solve (z:xs)
solve _ = []

main = do
    getLine
    getContents >>= print.length.solve.(map read).words


A new Berland businessman Vitaly is going to open a household appliances' store. All he's got to do now is to hire the staff.The store will work seven days a week, but not around the clock. Every day at least k people must work in the store.Berland has a law that determines the order of working days and non-working days. Namely, each employee must work for exactly n consecutive days, then rest for exactly m days, then work for n more days and rest for m more, and so on. Vitaly doesn't want to break the law. Fortunately, there is a loophole: the law comes into force on the day when the employee is hired. For example, if an employee is hired on day x, then he should work on days [x, x + 1, ..., x + n - 1], [x + m + n, x + m + n + 1, ..., x + m + 2n - 1], and so on. Day x can be chosen arbitrarily by Vitaly.There is one more thing: the key to the store. Berland law prohibits making copies of keys, so there is only one key. Vitaly is planning to entrust the key to the store employees. At the same time on each day the key must be with an employee who works that day — otherwise on this day no one can get inside the store. During the day the key holder can give the key to another employee, if he also works that day. The key will handed to the first hired employee at his first working day.Each employee has to be paid salary. Therefore, Vitaly wants to hire as few employees as possible provided that the store can operate normally on each day from 1 to infinity. In other words, on each day with index from 1 to infinity, the store must have at least k working employees, and one of the working employees should have the key to the store.Help Vitaly and determine the minimum required number of employees, as well as days on which they should be hired.

The first line contains three integers n, m and k (1 ≤ m ≤ n ≤ 1000, n ≠ 1, 1 ≤ k ≤ 1000).

In the first line print a single integer z — the minimum required number of employees. In the second line print z positive integers, separated by spaces: the i-th integer ai (1 ≤ ai ≤ 104) should represent the number of the day, on which Vitaly should hire the i-th employee. If there are multiple answers, print any of them.

gao n m k = takeWhile (<=m) $ concat $ iterate next $ all 1
  where
    all = replicate k
    next a = zipWith (+) (n-1: repeat n) $ all $ maximum a

main = do
  [n, m, k] <- fmap (map read . words) getLine
  let a = gao n (n+m) k
  print $ length a
  putStrLn $ unwords $ map show a

--216C

import Control.Monad (liftM)

solve :: [Int] -> [Int]
solve [n, m, 1]  =  [1, n .. n + m]
solve [n, m, k]  =
    replicate k 1
    ++
    (takeWhile (<= (n + m)) $ concatMap (\i -> i : replicate (k-1) (i+1)) [n, 2*n ..])

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

main :: IO ()
main  =  liftM (map read . words) getLine >>= prints . solve

main=getLine>>=s.map read.words
p=putStrLn.unwords.map show
s[n,m,k]
 | m+2<=n = do
     print $ 2*k
     p $ replicate k 1 ++ replicate k n
 | m+1==n = do
     print $ k+1+max 1 (k-1)
     p $ replicate k 1 ++ [n] ++ replicate (max 1 $ k-1) (n+1)
 | n==2 = do
     print $ k+2+max 1 (k-1)
     p $ replicate k 1 ++ [n] ++ replicate (max 1 $ k-1) (n+1) ++ [n+2]
 | m==n = do
     print $ k+2+max 0 (k-1)
     p $ replicate k 1 ++ [n] ++ replicate (max 0 $ k-1) (n+1) ++ [n+2]

gao n m k = concat $ takeWhile ((<=m) . maximum) $ iterate next $ all 1
  where
    all = replicate k
    next a = zipWith (+) (n-1: repeat n) $ all $ maximum a

main = do
  [n, m, k] <- fmap (map read . words) getLine
  let a = gao n (n+m) k
  print $ length a
  putStrLn $ unwords $ map show a

main=getLine>>=s.map read.words
p=putStrLn.unwords.map show
s[n,m,k]
 | m+2<=n = do
     print $ 2*k
     p $ replicate k 1 ++ replicate k n
 | m+1==n = do
     print $ k+2+max 0 (k-2)
     p $ replicate k 1 ++ [n] ++ replicate (max 1 $ k-1) (n+1)
 | m==n = do
     print $ k+2+max 0 (k-2)
     p $ replicate k 1 ++ [n] ++ replicate (max 0 $ k-1) (n+1) ++ [n+2]

main=getLine>>=s.map read.words
p=putStrLn.unwords.map show
s[n,m,k]
 | m+2<=n = do
     print $ 2*k
     p $ replicate k 1 ++ replicate k n
 | m+1==n = do
     print $ k+2+max 0 (k-2)
     p $ replicate k 1 ++ [n] ++ replicate (max 1 $ k-1) (n+1)
 | m==n = do
     print $ k+2+max 0 (k-2)
     p $ replicate k 1 ++ [n] ++ replicate (max 0 $ k-2) (n+1) ++ [n+2]

main=getLine>>=s.map read.words
p=putStrLn.unwords.map show
s[n,m,k]
 | m+2<=n = do
     print $ 2*k
     p $ replicate k 1 ++ replicate k n
 | m+1==n = do
     print $ k+2+max 0 (k-2)
     p $ replicate k 1 ++ [n] ++ replicate (max 1 $ k-1) (n+1)
 | m==n = do
     print $ k+2+max 0 (k-1)
     p $ replicate k 1 ++ [n] ++ replicate (max 0 $ k-1) (n+1) ++ [n+2]


Appleman has n cards. Each card has an uppercase letter written on it. Toastman must choose k cards from Appleman's cards. Then Appleman should give Toastman some coins depending on the chosen cards. Formally, for each Toastman's card i you should calculate how much Toastman's cards have the letter equal to letter on ith, then sum up all these quantities, such a number of coins Appleman should give to Toastman.Given the description of Appleman's cards. What is the maximum number of coins Toastman can get?

The first line contains two integers n and k (1 ≤ k ≤ n ≤ 105). The next line contains n uppercase letters without spaces — the i-th letter describes the i-th card of the Appleman.

Print a single integer – the answer to the problem.

NoteIn the first test example Toastman can choose nine cards with letter D and one additional card with any letter. For each card with D he will get 9 coins and for the additional card he will get 1 coin.

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

main = interact $ show . getAns . tail . words

getAns :: [String] -> Integer
getAns (k:xs:_) = calMax (read k) $ (sort . map (\xs -> ((toInteger . negate . length) xs, head xs)) . group . sort) xs

calMax :: Integer -> [(Integer, Char)] -> Integer
calMax _ [] = 0
calMax k ((n, c):xs)
	| k > negate n = calMax (k + n) xs + n * n
	| otherwise = k * k

import Data.List (genericLength, group, sort, sortBy)

main :: IO ()
main = getLine >>= \s -> getLine >>= print . solve (map read (words s) !! 1)

solve :: Integer -> String -> Integer
solve k = solve' k . sortBy (flip compare) . map genericLength . group . sort

solve' :: Integer -> [Integer] -> Integer
solve' _ [] = 0
solve' m (x:xs) | m <= x = m * m
                | otherwise = x * x + solve' (m - x) xs

import Control.Applicative
import Data.List

main :: IO ()
main = do
  [_, k] <- map read <$> words <$> getLine
  c <- getLine
  putStrLn $ show $ solve k c

solve :: Integer -> [Char] -> Integer
solve k c = ans
  where
    cs  = reverse . sort . map (fromIntegral . length) .  group . sort $ c
    ans = snd $ foldl' (\(l,a) x -> if l < x then (0, a+l*l) else (l-x,a+x*x) ) (k,fromIntegral 0) cs

import Data.List

main = interact $ show . sol . words

sol (_:k:str:_) = ans (read k) $ cal str

cal = reverse . sort . map (toInteger.length) . group . sort

ans 0 _  = 0
ans _ [] = 0
ans k (x:xs)
    | k >= x = x*x + ans (k-x) xs
    | otherwise = k*k

import Data.List (group, sort, sortBy)

main :: IO ()
main = getLine >>= \s -> getLine >>= print . solve (map read (words s) !! 1)

solve :: Int -> String -> Int
solve k = solve' k . sortBy (flip compare) . map length . group . sort

solve' :: Int -> [Int] -> Int
solve' _ [] = 0
solve' m (x:xs) | m <= x = m * m
                | otherwise = x * x + solve' (m - x) xs

import Control.Applicative
import Data.List

main :: IO ()
main = do
  [_, k] <- map read <$> words <$> getLine
  c <- getLine
  putStrLn $ show $ solve k c

solve :: Int -> [Char] -> Int
solve k c = ans
  where
    cs  = reverse . sort . map length .  group . sort $ c
    ans = snd $ foldl' (\(l,a) x -> if l < x then (0, a+l*l) else (l-x,a+x*x) ) (k,0) cs