Petya got an array $$$a$$$ of numbers from $$$1$$$ to $$$n$$$, where $$$a[i]=i$$$.He performed $$$n$$$ operations sequentially. In the end, he received a new state of the $$$a$$$ array.At the $$$i$$$-th operation, Petya chose the first $$$i$$$ elements of the array and cyclically shifted them to the right an arbitrary number of times (elements with indexes $$$i+1$$$ and more remain in their places). One cyclic shift to the right is such a transformation that the array $$$a=[a_1, a_2, \dots, a_n]$$$ becomes equal to the array $$$a = [a_i, a_1, a_2, \dots, a_{i-2}, a_{i-1}, a_{i+1}, a_{i+2}, \dots, a_n]$$$.For example, if $$$a = [5,4,2,1,3]$$$ and $$$i=3$$$ (that is, this is the third operation), then as a result of this operation, he could get any of these three arrays:  $$$a = [5,4,2,1,3]$$$ (makes $$$0$$$ cyclic shifts, or any number that is divisible by $$$3$$$);  $$$a = [2,5,4,1,3]$$$ (makes $$$1$$$ cyclic shift, or any number that has a remainder of $$$1$$$ when divided by $$$3$$$);  $$$a = [4,2,5,1,3]$$$ (makes $$$2$$$ cyclic shifts, or any number that has a remainder of $$$2$$$ when divided by $$$3$$$). Let's look at an example. Let $$$n=6$$$, i.e. initially $$$a=[1,2,3,4,5,6]$$$. A possible scenario is described below.  $$$i=1$$$: no matter how many cyclic shifts Petya makes, the array $$$a$$$ does not change.  $$$i=2$$$: let's say Petya decided to make a $$$1$$$ cyclic shift, then the array will look like $$$a = [\textbf{2}, \textbf{1}, 3, 4, 5, 6]$$$.  $$$i=3$$$: let's say Petya decided to make $$$1$$$ cyclic shift, then the array will look like $$$a = [\textbf{3}, \textbf{2}, \textbf{1}, 4, 5, 6]$$$.  $$$i=4$$$: let's say Petya decided to make $$$2$$$ cyclic shifts, the original array will look like $$$a = [\textbf{1}, \textbf{4}, \textbf{3}, \textbf{2}, 5, 6]$$$.  $$$i=5$$$: let's say Petya decided to make $$$0$$$ cyclic shifts, then the array won't change.  $$$i=6$$$: let's say Petya decided to make $$$4$$$ cyclic shifts, the array will look like $$$a = [\textbf{3}, \textbf{2}, \textbf{5}, \textbf{6}, \textbf{1}, \textbf{4}]$$$. You are given a final array state $$$a$$$ after all $$$n$$$ operations. Determine if there is a way to perform the operation that produces this result. In this case, if an answer exists, print the numbers of cyclical shifts that occurred during each of the $$$n$$$ operations.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases in the test. The descriptions of the test cases follow. The first line of the description of each test case contains one integer $$$n$$$ ($$$2 \le n \le 2\cdot10^3$$$) — the length of the array $$$a$$$. The next line contains the final state of the array $$$a$$$: $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) are written. All $$$a_i$$$ are distinct. It is guaranteed that the sum of $$$n$$$ values over all test cases does not exceed $$$2\cdot10^3$$$.

For each test case, print the answer on a separate line. Print -1 if the given final value $$$a$$$ cannot be obtained by performing an arbitrary number of cyclic shifts on each operation. Otherwise, print $$$n$$$ non-negative integers $$$d_1, d_2, \dots, d_n$$$ ($$$d_i \ge 0$$$), where $$$d_i$$$ means that during the $$$i$$$-th operation the first $$$i$$$ elements of the array were cyclic shifted to the right $$$d_i$$$ times. If there are several possible answers, print the one where the total number of shifts is minimal (that is, the sum of $$$d_i$$$ values is the smallest). If there are several such answers, print any of them.

NoteThe first test case matches the example from the statement.The second set of input data is simple. Note that the answer $$$[3, 2, 1]$$$ also gives the same permutation, but since the total number of shifts $$$3+2+1$$$ is greater than $$$0+0+1$$$, this answer is not correct.

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: Int -> [a] -> [a]
cShift 0 = id
cShift i = uncurry (flip (++)) . splitAt i

solve :: InType -> OutType
solve = reverse . go
  where go [] = []
        go xs = let l = length xs
                    i = (fromJust (elemIndex l xs) + 1) `mod` l
                in  i : go (init (cShift i xs))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let l = length xs
                    i = fromJust $ elemIndex l xs
                in  (i + 1) `mod` l : go (take (l - 1) (cShift xs (i + 1)))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Applicative            ( liftA2 )
import           Control.Monad.State
import qualified Data.Array                    as A
import qualified Data.ByteString.Lazy.Char8    as C
import           Data.Foldable
import           Data.Function                  ( (&)
                                                , on
                                                )
import           Data.Maybe                     ( fromJust )

type Scanner = State [C.ByteString]

scan :: Scanner a -> C.ByteString -> a
scan input = evalState input . C.lines

line :: Scanner C.ByteString
line = get >>= \case
  []     -> error "eof"
  s : ss -> put ss >> return s

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

main :: IO ()
main = C.interact solve

solve :: C.ByteString -> C.ByteString
solve input = input & scan parse & map (format . answer) & C.unlines

parse :: Scanner [(Int, A.Array Int Int)]
parse = do
  _ <- line
  many $ do
    n  <- int <$> line
    xs <- A.listArray (1, n) . map int . C.words <$> line
    return (n, xs)
  where
    int :: C.ByteString -> Int
    int = fst . fromJust . C.readInt

format :: [Int] -> C.ByteString
format = C.pack . unwords . map show

answer :: (Int, A.Array Int Int) -> [Int]
answer (n, xs) = reverse
  [ times `mod` value
  | ((times, value), _) <- take n . iterate (\(_, xs') -> toPair xs') $ toPair xs
  ]
  where
    toPair :: A.Array Int Int -> ((Int, Int), A.Array Int Int)
    toPair as = (it, as')
      where
        it  = iteration as
        as' = uncurry rotate it as

iteration :: Ord a => A.Array Int a -> (Int, a)
iteration xs = maximumBy (compare `on` snd) (A.assocs xs)

rotate :: Int -> Int -> A.Array Int a -> A.Array Int a
rotate times till =
  A.ixmap (1, till - 1) (\i -> ((i + times) `mod` (till + 1)) + ((i + times) `div` (till + 1)))

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let l = length xs
                    i = fromJust $ elemIndex l xs
                in  i + 1 : go (take (l - 1) (cShift xs (i + 1)))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let i = fromJust $ elemIndex (length xs) xs
                    pref = take i xs
                    suf  = drop (i + 1) xs
                in  i + 1 : go (cShift (pref ++ suf) i)

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let i = fromJust $ elemIndex (length xs) xs
                    pref = take i xs
                    suf  = drop (i + 1) xs
                in  i + 1 : go (pref ++ suf)

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines


Harry Potter and He-Who-Must-Not-Be-Named engaged in a fight to the death once again. This time they are located at opposite ends of the corridor of length l. Two opponents simultaneously charge a deadly spell in the enemy. We know that the impulse of Harry's magic spell flies at a speed of p meters per second, and the impulse of You-Know-Who's magic spell flies at a speed of q meters per second.The impulses are moving through the corridor toward each other, and at the time of the collision they turn round and fly back to those who cast them without changing their original speeds. Then, as soon as the impulse gets back to it's caster, the wizard reflects it and sends again towards the enemy, without changing the original speed of the impulse.Since Harry has perfectly mastered the basics of magic, he knows that after the second collision both impulses will disappear, and a powerful explosion will occur exactly in the place of their collision. However, the young wizard isn't good at math, so he asks you to calculate the distance from his position to the place of the second meeting of the spell impulses, provided that the opponents do not change positions during the whole fight.

The first line of the input contains a single integer l (1 ≤ l ≤ 1 000) — the length of the corridor where the fight takes place. The second line contains integer p, the third line contains integer q (1 ≤ p, q ≤ 500) — the speeds of magical impulses for Harry Potter and He-Who-Must-Not-Be-Named, respectively.

Print a single real number — the distance from the end of the corridor, where Harry is located, to the place of the second meeting of the spell impulses. Your answer will be considered correct if its absolute or relative error will not exceed 10 - 4.  Namely: let's assume that your answer equals a, and the answer of the jury is b. The checker program will consider your answer correct if .

NoteIn the first sample the speeds of the impulses are equal, so both of their meetings occur exactly in the middle of the corridor.

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  c <- getLine
  let l = read a :: Float
      p = read b :: Float
      q = read c :: Float
  print (l / (p + q) * p)

module Main
    where

-- toInts :: [String] -> [Int]
-- toInts = map read
--
-- splitStr :: Int -> String -> [Int]
-- splitStr n (' ':xs) = n : (splitStr 0 xs)
-- splitStr n ('1':xs) = splitStr (n * 10 + 1) xs
-- splitStr n ('2':xs) = splitStr (n * 10 + 2) xs
-- splitStr n ('3':xs) = splitStr (n * 10 + 3) xs
-- splitStr n ('4':xs) = splitStr (n * 10 + 4) xs
-- splitStr n ('5':xs) = splitStr (n * 10 + 5) xs
-- splitStr n ('6':xs) = splitStr (n * 10 + 6) xs
-- splitStr n ('7':xs) = splitStr (n * 10 + 7) xs
-- splitStr n ('8':xs) = splitStr (n * 10 + 8) xs
-- splitStr n ('9':xs) = splitStr (n * 10 + 9) xs
-- splitStr n ('0':xs) = splitStr (n * 10 + 0) xs
-- splitStr n [] = [n]
--
-- split s = splitStr 0 s
--
-- input = do   line <- getLine
--             sep <- return (split line)
--             return sep

-- solve :: Num -> Num -> Num -> Num
solve l a b = l * a / (a + b)

main = do   strl <- getLine
            l <- return (read strl)
            stra <- getLine
            a <- return (read stra)
            strb <- getLine
            b <- return (read strb)
            solution <- return (solve l a b)
            strsol <- return (show solution)
            putStrLn strsol

main = interact $ show . solve . map read . words
solve [l,p,q] = p * l / (p + q)

import Control.Applicative
main = do
  l <- to_f <$> getLine
  p <- to_f <$> getLine
  q <- to_f <$> getLine
  print $ l * p / (p + q)

to_f :: String -> Double
to_f str = read str :: Double

import Control.Applicative
import Control.Monad

main = ( (\[c,a,b] -> a * c / (a+b) ). (map (read :: String -> Double) ) . lines) <$> getContents >>= print

import Control.Applicative
import Control.Monad

solve :: [Double] -> Double
solve [c,a,b] = ( a / (a+b) ) * c

main = ( solve . (map (read :: String -> Double) ) . lines) <$> getContents >>= print

module Main where

main :: IO ()
main = do
   l <- readLn :: IO Double
   p <- readLn :: IO Double
   q <- readLn :: IO Double
   let t = (3 * l) / (p + q)
   print $ (t / 3) * p

main = do
    line <- getLine
    let l = read(line) :: Double
    line <- getLine
    let p = read(line) :: Double
    line <- getLine
    let q = read(line) :: Double

    let d = (p * l) / (p + q)

    print d

main :: IO ()
main = interact parse

parse input =
  let (l:p:q:_) = map read $ lines input
      t = l / (p + q)
      pt = p * t
  in show pt

main = do
    a <- getLine
    b <- getLine
    c <- getLine
    let s = read a :: Float
    let v1 = read b :: Float
    let v2 = read c :: Float
    putStrLn $ show $ s * v1 / (v1 + v2)

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

main=do
	[n,a,b]<-  map read.words  <$> getContents:: IO  [Int]
	print $ (fromIntegral a)/(fromIntegral (a+b)) *(fromIntegral n)

main = interact $ show. (\ (d:p:q:[]) -> d * p / (p + q)). map read. words

main = interact $ (++ "\n"). show. (\ (d:p:q:[]) -> d * p / (p + q)). map read. words

import Control.Applicative
import Control.Monad

main = do
    [l, h, v] <- replicateM 3 $ read <$> getLine
    print $ l / (h+v) * h

module Main (main)
    where

import Control.Monad (replicateM)

main :: IO ()
main = replicateM 3 readLn >>= print . solve
    where solve [l, p, q] = l*p/(p + q)

main :: IO()
main = print . solve . map read . words =<< getContents

solve :: [Float] -> Float
solve [l, p, q] = l * p / (p + q)

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

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

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

main = do
  l <- readLn
  p <- readLn
  q <- readLn

  print $ p*l/(p+q)

import Control.Monad
import System.IO
import Data.Char
import Data.Maybe
import Data.Ix
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Vector as Vector

readInt = read :: String -> Int
infixl 5 |>
a |> f = f a

infixl 5 ||>
m ||> f = liftM f m

readLines :: Int -> IO [String]
readLines 0 = return []
readLines n = do
	l1 <- getLine
	lns <- readLines (n - 1)
	return $ l1 : lns

main = do
	l <- getLine ||> (read) ||> (+ 0.0)
	p <- getLine ||> (read) ||> (+ 0.0)
	q <- getLine ||> (read) ||> (+ 0.0)
	t <- return $ l / (p + q)

	putStr $ show $ p * t

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
main = do
  l <- readLn::IO Double
  p <- readLn::IO Double
  q <- readLn::IO Double
  print $ p*l/(p+q)


You are given a string $$$s$$$ consisting of $$$n$$$ characters. Each character of $$$s$$$ is either 0 or 1.A substring of $$$s$$$ is a contiguous subsequence of its characters.You have to choose two substrings of $$$s$$$ (possibly intersecting, possibly the same, possibly non-intersecting — just any two substrings). After choosing them, you calculate the value of the chosen pair of substrings as follows:  let $$$s_1$$$ be the first substring, $$$s_2$$$ be the second chosen substring, and $$$f(s_i)$$$ be the integer such that $$$s_i$$$ is its binary representation (for example, if $$$s_i$$$ is 11010, $$$f(s_i) = 26$$$);  the value is the bitwise OR of $$$f(s_1)$$$ and $$$f(s_2)$$$. Calculate the maximum possible value you can get, and print it in binary representation without leading zeroes.

The first line contains one integer $$$n$$$ — the number of characters in $$$s$$$. The second line contains $$$s$$$ itself, consisting of exactly $$$n$$$ characters 0 and/or 1. All non-example tests in this problem are generated randomly: every character of $$$s$$$ is chosen independently of other characters; for each character, the probability of it being 1 is exactly $$$\frac{1}{2}$$$. This problem has exactly $$$40$$$ tests. Tests from $$$1$$$ to $$$3$$$ are the examples; tests from $$$4$$$ to $$$40$$$ are generated randomly. In tests from $$$4$$$ to $$$10$$$, $$$n = 5$$$; in tests from $$$11$$$ to $$$20$$$, $$$n = 1000$$$; in tests from $$$21$$$ to $$$40$$$, $$$n = 10^6$$$.  Hacks are forbidden in this problem.

Print the maximum possible value you can get in binary representation without leading zeroes.

NoteIn the first example, you can choose the substrings 11010 and 101. $$$f(s_1) = 26$$$, $$$f(s_2) = 5$$$, their bitwise OR is $$$31$$$, and the binary representation of $$$31$$$ is 11111.In the second example, you can choose the substrings 1110010 and 11100.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Data.Monoid as M
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int
import Data.Bits

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> B8.ByteString -> B8.ByteString
solve n s = B8.pack $ (L.dropWhile (== '0') answerPrefix) ++ answerSuffix
    where
        m = 60
        pValues = L.map (\c -> ord c - ord '0') $ B8.unpack s
        answer = L.map (\c -> chr $ c + ord '0') . L.maximumBy cmpP $ ps
        (answerPrefix, answerSuffix) = L.splitAt (n - 1) $ answer
        cmpP (a:as) (b:bs) = compare a b `M.mappend` cmpP as bs
        cmpP _ _ = EQ
        ps = do
            idx <- [1 .. m - 1]
            return . L.zipWith (.|.) pValues . L.take n $ L.replicate idx 0 ++ pValues

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    mask <- B8.getLine <&> B8.filter isAlphaNum
    let answer = solve n mask
    B8.putStrLn answer

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Data.Monoid as M
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int
import Data.Bits

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> B8.ByteString -> B8.ByteString
solve n s = B8.pack . L.map (\c -> chr $ c + ord '0') . L.maximumBy cmpP $ ps
    where
        m = 60
        pValues = L.map (\c -> ord c - ord '0') $ B8.unpack s
        cmpP (a:as) (b:bs) = compare a b `M.mappend` cmpP as bs
        cmpP _ _ = EQ
        ps = do
            idx <- [1 .. m - 1]
            return . L.zipWith (.|.) pValues . L.take n $ L.replicate idx 0 ++ pValues

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    mask <- B8.getLine <&> B8.filter isAlphaNum
    let answer = solve n mask
    B8.putStrLn answer

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Data.Monoid as M
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int
import Data.Bits

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: Int -> B8.ByteString -> B8.ByteString
solve n s = B8.pack . L.map (\c -> chr $ c + ord '0') . L.maximumBy cmpP $ ps
    where
        m = 60
        pValues = L.map (\c -> ord c - ord '0') $ B8.unpack s
        cmpP (a:as) (b:bs) = compare a b `M.mappend` cmpP as bs
        cmpP _ _ = EQ
        ps = do
            idx <- [0 .. m - 1]
            return . L.zipWith (.|.) pValues . L.take n $ L.replicate idx 0 ++ pValues

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    mask <- B8.getLine <&> B8.filter isAlphaNum
    let answer = solve n mask
    B8.putStrLn answer


$$$ \def\myred#1{\color{red}{\underline{\bf{#1}}}} \def\myblue#1{\color{blue}{\overline{\bf{#1}}}} $$$ $$$\def\RED{\myred{Red}} \def\BLUE{\myblue{Blue}}$$$You are given a sequence of $$$n$$$ non-negative integers $$$a_1, a_2, \ldots, a_n$$$. Initially, all the elements of the sequence are unpainted. You can paint each number $$$\RED$$$ or $$$\BLUE$$$ (but not both), or leave it unpainted. For a color $$$c$$$, $$$\text{Count}(c)$$$ is the number of elements in the sequence painted with that color and $$$\text{Sum}(c)$$$ is the sum of the elements in the sequence painted with that color.For example, if the given sequence is $$$[2, 8, 6, 3, 1]$$$ and it is painted this way: $$$[\myblue{2}, 8, \myred{6}, \myblue{3}, 1]$$$ (where $$$6$$$ is painted red, $$$2$$$ and $$$3$$$ are painted blue, $$$1$$$ and $$$8$$$ are unpainted) then $$$\text{Sum}(\RED)=6$$$, $$$\text{Sum}(\BLUE)=2+3=5$$$, $$$\text{Count}(\RED)=1$$$, and $$$\text{Count}(\BLUE)=2$$$.Determine if it is possible to paint the sequence so that $$$\text{Sum}(\RED) > \text{Sum}(\BLUE)$$$ and $$$\text{Count}(\RED) < \text{Count}(\BLUE)$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$3\le n\le 2\cdot 10^5$$$) — the length of the given sequence.  The second line of each test case contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$0\le a_i\le 10^9$$$) — the given sequence. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print YES if it is possible to paint the given sequence satisfying the above requirements, and NO otherwise. You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive response).

NoteIn the first test case, there is no possible way to paint the sequence. For example, if you paint the sequence this way: $$$[\myblue{1},\myblue{2},\myred{3}]$$$ (where $$$3$$$ is painted red, $$$1$$$ and $$$2$$$ are painted blue) then $$$\text{Count}(\RED)=1 < \text{Count}(\BLUE)=2$$$, but $$$\text{Sum}(\RED)=3 \ngtr \text{Sum}(\BLUE)=3$$$. So, this is not a possible way to paint the sequence.In the second test case, a possible way to paint the sequence is described in the statement. We can see that $$$\text{Sum}(\RED)=6 > \text{Sum}(\BLUE)=5$$$ and $$$\text{Count}(\RED)=1 < \text{Count}(\BLUE)=2$$$.In the third test case, there is no possible way to paint the sequence. For example, if you paint the sequence this way: $$$[\myred{3},\myred{5},\myblue{4}, \myblue{2}]$$$ (where $$$3$$$ and $$$5$$$ are painted red, $$$4$$$ and $$$2$$$ are painted blue) then $$$\text{Sum}(\RED) = 8 > \text{Sum}(\BLUE) = 6$$$ but $$$\text{Count}(\RED) = 2 \nless \text{Count}(\BLUE) = 2$$$. So, this is not a possible way to paint the sequence.In the fourth test case, it can be proven that there is no possible way to paint the sequence satisfying sum and count constraints.

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-1) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) a
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

main :: IO()
main = interact $ unlines.solve.tail.lines

-- >>> reverse$ scanr1 (+) [1,2,3,4,5]
-- [5,9,12,14,15]

import Data.List (sort)

main :: IO ()
main =
    let f 0 = return ()
        f t = solve >> f (t - 1)
    in readInt <$> getLine >>= f

solve :: IO ()
solve = readInt <$> getLine >>= \ n ->
    splitAt ((n+1) `div` 2) . sort . map readInt . words <$> getLine >>= \(l, r) ->
        putStrLn . check (sum $ take 2 l) (last r) (drop 2 l) . tail $ reverse r

check a b [] _ = if a < b then "YES" else "NO"
check a b _ [] = if a < b then "YES" else "NO"
check a b (l:ls) (r:rs) = if a < b then "YES" else check (a + l) (b + r) ls rs

readInt :: String -> Int
readInt = read

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-1) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) [1,2,3,4,5]
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

main :: IO()
main = interact $ unlines.solve.tail.lines

-- >>> drop 1 (scanl1 (+) [1,2,3,4,5])
-- [3,6,10,15]

-- >>> reverse$ scanr1 (+) [1,2,3,4,5]
-- [5,9,12,14,15]

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-2) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) [1,2,3,4,5]
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

main :: IO()
main = interact $ unlines.solve.tail.lines

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = if head a + (head.tail) a < last a then "YES" else "NO"
    where
        a :: [Int]
        a = (sort.map read.words) y

main :: IO()
main = interact $ unlines.solve.tail.lines


Little Dormi received a histogram with $$$n$$$ bars of height $$$a_1, a_2, \ldots, a_n$$$ for Christmas. However, the more he played with his new histogram, the more he realized its imperfections, so today he wanted to modify it to his liking.To modify the histogram, Little Dormi is able to perform the following operation an arbitrary number of times: Select an index $$$i$$$ ($$$1 \le i \le n$$$) where $$$a_i>0$$$, and assign $$$a_i := a_i-1$$$.Little Dormi defines the ugliness score of his histogram (after performing some number of operations) as the sum of the vertical length of its outline and the number of operations he performed on it. And to make the histogram as perfect as possible, he would like to minimize the ugliness score after modifying it with some number of operations.However, as his histogram is very large, Little Dormi is having trouble minimizing the ugliness score, so as Little Dormi's older brother, help him find the minimal ugliness.Consider the following example where the histogram has $$$4$$$ columns of heights $$$4,8,9,6$$$:  The blue region represents the histogram, and the red lines represent the vertical portion of the outline. Currently, the vertical length of the outline is $$$4+4+1+3+6 = 18$$$, so if Little Dormi does not modify the histogram at all, the ugliness would be $$$18$$$.However, Little Dormi can apply the operation once on column $$$2$$$ and twice on column $$$3$$$, resulting in a histogram with heights $$$4,7,7,6$$$:  Now, as the total vertical length of the outline (red lines) is $$$4+3+1+6=14$$$, the ugliness is $$$14+3=17$$$ dollars. It can be proven that this is optimal.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 4 \cdot 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$4 \cdot 10^5$$$.

For each test case output one integer, the minimal ugliness Little Dormi can achieve with the histogram in that test case.

NoteExample $$$1$$$ is the example described in the statement.The initial histogram for example $$$2$$$ is given below:  The ugliness is currently $$$2+1+6+3+4=16$$$.By applying the operation once on column $$$1$$$, six times on column $$$3$$$, and three times on column $$$4$$$, we can end up with a histogram with heights $$$1,1,1,1,0,0$$$:  The vertical length of the outline is now $$$1+1=2$$$ and Little Dormi made $$$1+6+3=10$$$ operations, so the final ugliness is $$$2+10=12$$$, which can be proven to be optimal.

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

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

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

solve :: [Int64] -> Int64
solve xs = sum $ map calc $ zip3 xs (drop 1 xs) (drop 2 xs)
 where
    calc (a,b,c) =
        ((b - (a `max` c)) `max` 0) +
        (((b `min` c) - a) `max` 0) +
        (((b `min` a) - c) `max` 0)

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        a <- (0:) . (++[0]) . map (fromIntegral . parseInt) . BS.words <$> BS.getLine
        print $ solve a


Mr. Scrooge, a very busy man, decided to count the time he wastes on all sorts of useless stuff to evaluate the lost profit. He has already counted the time he wastes sleeping and eating. And now Mr. Scrooge wants to count the time he has wasted signing papers.Mr. Scrooge's signature can be represented as a polyline A1A2... An. Scrooge signs like that: first it places a pen at the point A1, then draws a segment from point A1 to point A2, then he draws a segment from point A2 to point A3 and so on to point An, where he stops signing and takes the pen off the paper. At that the resulting line can intersect with itself and partially repeat itself but Scrooge pays no attention to it and never changes his signing style. As Scrooge makes the signature, he never takes the pen off the paper and his writing speed is constant — 50 millimeters per second.Scrooge signed exactly k papers throughout his life and all those signatures look the same.Find the total time Scrooge wasted signing the papers.

The first line contains two integers n and k (2 ≤ n ≤ 100, 1 ≤ k ≤ 1000). Each of the following n lines contains the coordinates of the polyline's endpoints. The i-th one contains coordinates of the point Ai — integers xi and yi, separated by a space. All points Ai are different. The absolute value of all coordinates does not exceed 20. The coordinates are measured in millimeters.

Print one real number — the total time Scrooges wastes on signing the papers in seconds. The absolute or relative error should not exceed 10 - 6.

import Control.Monad

solve []       = 0
solve [a]      = 0
solve (a:b:cs) = solve (b:cs) + d
   where dx = fromIntegral $ (a!!0) - (b!!0)
         dy = fromIntegral $ (a!!1) - (b!!1)
         d  = sqrt . abs $ dx * dx + dy * dy

main = do
   [n, k] <- fmap (map read . words) getLine
   lst <- forM [1..n] $ \_ -> fmap (map read . words) getLine :: IO [Int]
   print $ solve lst * k / 50

-- vim: set expandtab:

getWords = fmap (map read . words) getLine

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

readPair = (\[x, y] -> (x, y)) . map read . words

main = do
	[n, k] <- getWords
	ps <- fmap (map readPair . lines) getContents
	let l = sum $ zipWith dist ps (tail ps)
	print $ k*l/50

module Main where
import Control.Applicative
import Control.Monad
import Data.List
main = do
    [n,k] <- map (read :: String -> Int) . words <$> getLine
    as <- replicateM n  (map (read :: String -> Double) . words <$> getLine)
    let s = (fromIntegral k) * ( sum $ zipWith (\x y -> sqrt  . sum . map  (**2.0) .  zipWith (-) x $ y) as $ tail as )
    print $ s / 50.0

module Main where

    -- Java-кресьтьяне должны страдать!

    import Data.List (foldl')

    type Point = (Double, Double)

    rho :: Point -> Point -> Double
    rho x y = sqrt ( (fst x - fst y)**2 + (snd x - snd y)**2 )

    lengths :: [Point] -> (Double, Point)
    lengths xs = foldl' summate (0, head xs) (tail xs)
      where summate (l, p) p' = (l + rho p p', p')

    main :: IO ()
    main = do
        [n, k] <- fmap (map read . words) getLine :: IO [Int]
        points <- sequence $
          replicate n $ do
              [x, y] <- fmap (map read . words) getLine :: IO [Double]
              return (x, y)
        putStrLn . show $ if (not . null) points
          then fst (lengths points) * fromIntegral k / 50
          else 0

import List

type Point = (Double, Double)

speed = 50

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

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

readPoint :: IO Point
readPoint = do
    [x, y] <- Main.reads
    return (x, y)

dist :: Point -> Point -> Double
dist (x1, y1) (x2, y2) = sqrt ((x1-x2)^2 + (y1-y2)^2)

near :: [a] -> [(a, a)]
near (x:y:[]) = [(x, y)]
near (x:y:xs) = (x, y):(near (y:xs))
near _ = error "near: List length < 2!"

solve :: [Point] -> Double
solve ps = sum (map (uncurry dist) (near ps))

main :: IO ()
main = do
    [n, k] <- Main.reads
    ans <- sequence (map (\n -> readPoint) [1..n])
    print (k * (solve ans) / speed)

sigLength (a:b:rest) =
    let dx = fst a - fst b
        dy = snd a - snd b
        d  = sqrt $ dx * dx + dy * dy
    in d + sigLength (b:rest)   -- lazyness may get TLE
sigLength _ = 0.0

solve ((_, k):ps) = (sigLength ps) / 50.0 * k

main = interact $ show.solve.map ((\[a, b] -> (read a, read b)).words).lines

main = interact $ show . distance . (map . map) read . map words . lines

distance :: [[Float]] -> Float
distance (x:ys) = last x * distance' ys / 50.0
  where
    distance' :: [[Float]] -> Float
    distance' xs = sum $ zipWith (\a b -> dbetweenp (abs (head a - head b)) (abs (last a - last b))) xs (drop 1 xs)
    dbetweenp w h = sqrt $ w^2 + h^2

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = (*) <$> ((!!1) . map read . words <$> getLine) <*> (solve <$> (map (map read . words) . lines <$> getContents)) >>= print

solve :: [[Double]] -> Double
solve xys = sum [ sqrt ((x - x') ** 2 + (y - y') ** 2) | ([x, y], [x', y']) <- zip xys (tail xys) ] / 50

import Control.Monad
main = do
  [n,k] <- fmap (map read . words) getLine
  ps <- replicateM n $ fmap (map read . words) getLine
  print $ fromIntegral k * sum (map dist (pairs ps)) / 50
dist ([x1,y1],[x2,y2]) = sqrt ((x2-x1)^2 + (y2-y1)^2)
pairs (a:b:cs) = (a,b) : pairs (b:cs)
pairs _ = []

module Main where

import Control.Monad

readP = do
  [x,y] <- (map read . words) `fmap` getLine
  return (x :: Double, y)

main = do
  [n,k] <- (map read . words) `fmap` getLine
  cs <- replicateM n readP
  print (answer cs k)

answer cs k = sum (zipWith dist cs (tail cs)) / 50 * (fromIntegral k)
  where
    dist (x1, y1) (x2, y2) = sqrt ((x1 - x2)^2 + (y1 - y2)^2)

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

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

readNums :: (Num a, Read a) => IO [a]
readNums = map read . words <$> getLine

distance :: (Double, Double) -> (Double, Double) -> Double
distance (y1, x1) (y2, x2) = sqrt $ (y1 - y2) ^ 2 + (x1 - x2) ^ 2

main :: IO ()
main = do
  [n, k :: Int] <- readNums
  as <- replicateM n $ do
    [a, b :: Double] <- readNums
    return (a, b)
  let !d = sum $ zipWith distance as (tail as)
  printf "%08f\n" $ d * fromIntegral k / 50

import Data.List
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as BS

solve :: [[Integer]] -> BS.ByteString
solve xs = BS.pack.show $ ( ret *  fromIntegral b ) / 50.0   where
	( first , rest ) = ( head xs , tail xs )
	( a , b ) = ( head first , last first )
	ret = helpSolve rest where
	  helpSolve :: [[ Integer ]] -> Double
	  helpSolve [] = 0.0
	  helpSolve [ x ] = 0.0
	  helpSolve ( x : y : xs ) =  ( sqrt.fromIntegral $ ( x_1 - x_2 ) ^ 2 + ( y_1 - y_2 ) ^ 2  )  + helpSolve ( y : xs ) where
		x_1 = head x
		y_1 = last x
		x_2 = head y
		y_2 = last y

reaD :: BS.ByteString -> Integer
reaD = fst. fromJust . BS.readInteger

main = BS.interact $  solve . map ( map reaD . BS.words ) . BS.lines

dist :: [Int] -> [Int] -> Double
dist [a, b] [c, d] = sqrt.fromIntegral $ dx^2 + dy^2
  where dx = a - c
        dy = b - d
main = do
  [_, k] <- getLine >>= return. map read. words :: IO [Double]
  as <- getContents >>= return. map (map read. words). lines :: IO [[Int]]
  print. (/50). (*k). sum $ zipWith dist (drop 1 as) as

import Control.Applicative
import Control.Monad

dst (x1, y1) (x2, y2) = sqrt $ dx*dx + dy*dy
  where dx = (x1 - x2)
        dy = (y1 - y2)

solve (p1:p2:r) = dst p1 p2 + solve (p2:r)
solve _ = 0

main = do
  [n, k] <- map read .words <$> getLine
  points <- replicateM n $ map read . words <$> getLine >>= \[a,b] -> return (a,b)
  print $ solve points * (fromIntegral k) / 50

import           Control.Monad
import           Data.List

dist :: (Integral a, Floating b) => (a, a) -> (a, a) -> b
dist (x1, y1) (x2, y2) = sqrt $ (fromIntegral x1 - fromIntegral x2)^2 + (fromIntegral y1 - fromIntegral y2)^2

unfolder :: [(Int, Int)] -> Maybe (Double, [(Int, Int)])
unfolder (a:b:rest) = Just (dist a b, b:rest)
unfolder _ = Nothing

main :: IO ()
main = do
  [n, k] <- map (read :: String -> Int) . words <$> getLine
  print =<< (/50) . (fromIntegral k *) . sum . unfoldr unfolder . map ((\[a,b]->(a,b)) . map (read :: String -> Int) . words) <$> replicateM n getLine

import Data.Bits

-- import Data.List (List)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import System.IO
import Text.Read

parseLine :: IO Point
parseLine = do
  input <- getLine
  let (x:y:_) = (map read . words) input :: [Double]
  let p = Pt x y
  return p

data Point =
  Pt
    { pointx, pointy :: Double
    }

distance :: Point -> Point -> Double
distance p1 p2 =
  sqrt ((^) (pointx p1 - pointx p2) 2 + (^) (pointy p1 - pointy p2) 2)

solveN :: Int -> Point -> Double -> IO Double
solveN 0 lastp ans = return ans
solveN n last_p ans
  -- print $ "ans = " ++ show ans
 = do
  p <- parseLine
  solveN (n - 1) p (ans + distance p last_p)

main :: IO ()
main = do
  input <- getLine
  let (n:k:_) = (map read . words) input :: [Int]
  p <- parseLine
  input <- solveN (n - 1) p 0.0
  print $ input * fromIntegral k / 50.0

parse :: Read a => Floating a => String -> (Int, a, [[a]])
parse stuff =
    let [n, k] : nums = map words $ lines stuff in
    (read n, read k, map (map read) nums)

calc :: Show a => Read a => Floating a => [[a]] -> a -> a
calc [[_, _]] acc = acc
calc l@([x0, y0]:[x1, y1]:xs) acc =
    calc (tail l) (acc + dist x0 y0 x1 y1)
    where
      dist x0 y0 x1 y1 = sqrt $ (x0 - x1)^2 + (y0 - y1)^2

main = do
  stuff <- getContents
  let (_, k, points) = parse stuff
      result = calc points 0
  putStrLn $ show ((result / 50) * k)

module Main where

    -- Java-кресьтьяне должны страдать!

    import Data.List (foldl')

    type Point = (Double, Double)

    rho :: Point -> Point -> Double
    rho x y = sqrt ( (fst x - fst y)**2 + (snd x - snd y)**2 )

    lengths :: [Point] -> (Double, Point)
    lengths xs = foldl' summate (0, head xs) (tail xs)
      where summate (l, p) p' = (l + rho p p', p')

    main :: IO ()
    main = do
        [n, k] <- fmap (map read . words) getLine :: IO [Int]
        points <- sequence $
          replicate n $ do
              [x, y] <- fmap (map read . words) getLine :: IO [Double]
              return (x, y)
        putStrLn . show $ if (not . null) points
          then fst (lengths points) / 50
          else 0


You are given a rooted tree with n vertices. The vertices are numbered from 1 to n, the root is the vertex number 1.Each vertex has a color, let's denote the color of vertex v by cv. Initially cv = 0.You have to color the tree into the given colors using the smallest possible number of steps. On each step you can choose a vertex v and a color x, and then color all vectices in the subtree of v (including v itself) in color x. In other words, for every vertex u, such that the path from root to u passes through v, set cu = x.It is guaranteed that you have to color each vertex in a color different from 0.You can learn what a rooted tree is using the link: https://en.wikipedia.org/wiki/Tree_(graph_theory).

The first line contains a single integer n (2 ≤ n ≤ 104) — the number of vertices in the tree. The second line contains n - 1 integers p2, p3, ..., pn (1 ≤ pi < i), where pi means that there is an edge between vertices i and pi. The third line contains n integers c1, c2, ..., cn (1 ≤ ci ≤ n), where ci is the color you should color the i-th vertex into. It is guaranteed that the given graph is a tree.

Print a single integer — the minimum number of steps you have to perform to color the tree into given colors.

NoteThe tree from the first sample is shown on the picture (numbers are vetices' indices):On first step we color all vertices in the subtree of vertex 1 into color 2 (numbers are colors):On seond step we color all vertices in the subtree of vertex 5 into color 1:On third step we color all vertices in the subtree of vertex 2 into color 1:The tree from the second sample is shown on the picture (numbers are vetices' indices):On first step we color all vertices in the subtree of vertex 1 into color 3 (numbers are colors):On second step we color all vertices in the subtree of vertex 3 into color 1:On third step we color all vertices in the subtree of vertex 6 into color 2:On fourth step we color all vertices in the subtree of vertex 4 into color 1:On fith step we color all vertices in the subtree of vertex 7 into color 3:

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  ps <- zip [2..] `fmap` replicateM (n - 1) poi
  cs <- replicateM n poi
  return $ show $ solve n ps cs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n ps cs0 = dfs g (\u vs c s -> let cu = cs!u in foldl (\s' f -> f cu s') (s + fromEnum (cu /= c)) vs) 0 0
  where
  g = accumArray (flip (:)) [] (1, n) $ concatMap (\(a, b) -> [(a, b), (b, a)]) ps
  cs = listArray (1, n) cs0 :: UArray Int Int

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

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

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n], es, cs] = [ show $ sol' ((0,1): zip [2..] es) ca ]
  where
    ca = listArray (0,n) (0:cs)

sol' [] _ = 0
sol' ((p,v):vs) ca = (fromBool (ca!p /= ca!v )) + sol' vs ca

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

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

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

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

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

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

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

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

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

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

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[n], es, cs] = [ show $ sol' ((0,1): zip [1..] es) ca ]
  where
    ca = listArray (0,n) (0:cs)

sol' [] _ = 1
sol' ((p,v):vs) ca = (fromBool (ca!p /= ca!v )) + sol' vs ca

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

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

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

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

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

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

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

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

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