You are given a palindromic string $$$s$$$ of length $$$n$$$.You have to count the number of indices $$$i$$$ $$$(1 \le i \le n)$$$ such that the string after removing $$$s_i$$$ from $$$s$$$ still remains a palindrome. For example, consider $$$s$$$ = "aba"  If we remove $$$s_1$$$ from $$$s$$$, the string becomes "ba" which is not a palindrome.  If we remove $$$s_2$$$ from $$$s$$$, the string becomes "aa" which is a palindrome.  If we remove $$$s_3$$$ from $$$s$$$, the string becomes "ab" which is not a palindrome. A palindrome is a string that reads the same backward as forward. For example, "abba", "a", "fef" are palindromes whereas "codeforces", "acd", "xy" are not.

The input consists of multiple test cases. The first line of the input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^3)$$$  — the number of test cases. Description of the test cases follows. The first line of each testcase contains a single integer $$$n$$$ $$$(2 \leq n \leq 10^5)$$$  — the length of string $$$s$$$. The second line of each test case contains a string $$$s$$$ consisting of lowercase English letters. It is guaranteed that $$$s$$$ is a palindrome. It is guaranteed that sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer  — the number of indices $$$i$$$ $$$(1 \le i \le n)$$$ such that the string after removing $$$s_i$$$ from $$$s$$$ still remains a palindrome.

NoteThe first test case is described in the statement.In the second test case, the indices $$$i$$$ that result in palindrome after removing $$$s_i$$$ are $$$3, 4, 5, 6$$$. Hence the answer is $$$4$$$. In the third test case, removal of any of the indices results in "d" which is a palindrome. Hence the answer is $$$2$$$.

-- https://codeforces.com/contest/1679/problem/D
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

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 Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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))

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

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "Yes"
                else "No"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: B8.ByteString -> Int
solve str = L.length middleGroup
  where
    groups = L.group $ B8.unpack str
    middleGroup = groups L.!! (L.length groups `div` 2)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        str <- B8.getLine <&> head . B8.words
        let answer = solve str
        printf "%d\n" answer

import           Control.Monad
import           Data.Function
import           Data.Functor
import           Data.List
main :: IO ()
main = do
    n <- getLine <&> read :: IO Int
    replicateM_ n $ do
        l <- getLine <&> read :: IO Int
        s <- getLine
        let g = group s
        length g & (`div` 2) & (g !!) & length & print
        return ()

module Main (main)
where

import           Data.List (intercalate)
import           System.IO (IO (..))

type Case = (Int, String)

main :: IO ()
main = intercalate "\n" <$> map show <$> map solve <$> (read <$> getLine >>= readNCases) >>= putStrLn

readNCases :: Int -> IO [Case]
readNCases n = sequence $ replicate n readOneCase

readOneCase :: IO Case
readOneCase = (\[a, b] -> (read a, b)) <$> (sequence $ replicate 2 getLine)

solve :: Case -> Int
solve (n, str)
  | odd n = (solve' $ reverse (take ((n + 1) `div` 2) str)) * 2 - 1
  | otherwise = (solve' $ reverse $ take (n `div` 2) str) * 2

solve' :: [Char] -> Int
solve' [] = 0
solve' [x] = 1
solve' (x:y:xs) = if (x == y) then 1 + solve' (y:xs) else 1


You are given an array $$$a$$$ consisting of $$$n$$$ integers. Initially all elements of $$$a$$$ are either $$$0$$$ or $$$1$$$. You need to process $$$q$$$ queries of two kinds:  1 x : Assign to $$$a_x$$$ the value $$$1 - a_x$$$.  2 k : Print the $$$k$$$-th largest value of the array. As a reminder, $$$k$$$-th largest value of the array $$$b$$$ is defined as following: Sort the array in the non-increasing order, return $$$k$$$-th element from it. For example, the second largest element in array $$$[0, 1, 0, 1]$$$ is $$$1$$$, as after sorting in non-increasing order it becomes $$$[1, 1, 0, 0]$$$, and the second element in this array is equal to $$$1$$$.

The first line contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n, q \le 10^5$$$) — the length of the given array and the number of queries. The second line contains $$$n$$$ integers $$$a_1, a_2, a_3, \dots, a_n$$$ ($$$0 \le a_i \le 1$$$) — elements of the initial array. Each of the following $$$q$$$ lines contains two integers. The first integer is $$$t$$$ ($$$1 \le t \le 2$$$) — the type of query.   If $$$t = 1$$$ the second integer is $$$x$$$ ($$$1 \le x \le n$$$) — the position of the modified number. You have to assign to $$$a_x$$$ the value $$$1 - a_x$$$. If $$$t = 2$$$ the second integer is $$$k$$$ ($$$1 \le k \le n$$$) — you need to print the $$$k$$$-th largest value of the array. It's guaranteed that there will be at least one query of the second type (satisfying $$$t = 2$$$).

For each query of the second type, print a single integer — the answer to the query.

NoteInitially $$$a = [1, 1, 0, 1, 0]$$$.The first operation is printing the third largest value, which is $$$1$$$.The second operation is assigning $$$a_2$$$ the value $$$0$$$, $$$a$$$ becomes $$$[1, 0, 0, 1, 0]$$$.The third operation is printing the third largest value, it is $$$0$$$.The fourth operation is printing the first largest value, it is $$$1$$$.The last operation is printing the fifth largest value, it is $$$0$$$.

import Control.Monad
import Data.Array.IO
import Data.IORef

main :: IO ()
main = do
    nAndQ <- (map (read :: String -> Int) . words) <$> getLine
    let n = nAndQ !! 0
        q = nAndQ !! 1
    arr <- newArray (1, n) 0 :: IO (IOArray Int Int)
    ns <- (map (read :: String -> Int) . words) <$> getLine
    count <- newIORef 0
    forM (zip [1..] ns) $ \(i, v) -> do
        writeArray arr i v
        modifyIORef count (if v == 1 then (+1) else id)
    forM [1..q] $ \_ -> do
        tv <- (map (read :: String -> Int) . words) <$> getLine
        let t = tv !! 0
            v = tv !! 1
        if t == 1 then do
            x <- readArray arr v
            writeArray arr v (1 - x)
            modifyIORef count (if x == 0 then (+1) else (\a -> a - 1))
        else do
            c <- readIORef count
            print $ if v <= c then 1 else 0
    pure ()

{-# LANGUAGE Safe #-}

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.IO.Safe

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q] <- readInts
  aLi <- readInts
  a <- lift (newListArray (1, n) aLi :: IO (IOUArray Int Int))
  let
    step ct () = do
      [t, x] <- readInts
      if  t == 2
        then  do
          ct <$ putInts [if  ct >= x  then  1  else  0]
        else  lift $ do
          v <- readArray a x
          (ct + 1 - 2*v) <$ writeArray a x (1-v)
  foldM_ step (foldl' (+) 0 aLi) (replicate q ())

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


One day Vitaly was going home late at night and wondering: how many people aren't sleeping at that moment? To estimate, Vitaly decided to look which windows are lit in the house he was passing by at that moment.Vitaly sees a building of n floors and 2·m windows on each floor. On each floor there are m flats numbered from 1 to m, and two consecutive windows correspond to each flat. If we number the windows from 1 to 2·m from left to right, then the j-th flat of the i-th floor has windows 2·j - 1 and 2·j in the corresponding row of windows (as usual, floors are enumerated from the bottom). Vitaly thinks that people in the flat aren't sleeping at that moment if at least one of the windows corresponding to this flat has lights on.Given the information about the windows of the given house, your task is to calculate the number of flats where, according to Vitaly, people aren't sleeping.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 100) — the number of floors in the house and the number of flats on each floor respectively. Next n lines describe the floors from top to bottom and contain 2·m characters each. If the i-th window of the given floor has lights on, then the i-th character of this line is '1', otherwise it is '0'.

Print a single integer — the number of flats that have lights on in at least one window, that is, the flats where, according to Vitaly, people aren't sleeping.

NoteIn the first test case the house has two floors, two flats on each floor. That is, in total there are 4 flats. The light isn't on only on the second floor in the left flat. That is, in both rooms of the flat the light is off.In the second test case the house has one floor and the first floor has three flats. The light is on in the leftmost flat (in both windows) and in the middle flat (in one window). In the right flat the light is off.

module Main where

-- A

split :: Char -> String -> [String]
split _ [] = [""]
split c (x:xs) | x == c = "" : rest
               | otherwise  = (x : head rest): tail rest
                where rest = split c xs

solution :: [String] -> Int -> Int
solution stringFloors roomsAmount =
    let
        floors = map (\line -> map read (split ' ' line) :: [Int]) stringFloors
        countWake = \floor -> sum [if floor !! (i*2) == 1 || floor !! (i*2+1) == 1 then 1 else 0 |i <- [0..roomsAmount - 1]]
    in
        sum (map countWake floors)

main = getLine >>=
    \houseParamsString ->
        let
            houseParamsList = map read (split ' ' houseParamsString) :: [Int]
            floorsAmount = houseParamsList !! 0
            rooms = houseParamsList !! 1
        in
            sequence (replicate floorsAmount getLine) >>=
                \floors ->
                    putStrLn $ show (solution floors rooms)

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

solve :: [Int] -> Int
solve [] = 0
solve (a:b:x) = let rest = solve x
                in if a == 0 && b == 0 then rest else 1 + rest

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

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

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

main = do
  [n, m] <- getInts
  ls <- replicateM n getInts

  let
    f [] = 0
    f (a:b:xs) = (if a == 1 || b == 1 then 1 else 0) + f xs

  print $ sum $ map f ls

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
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
  [n,m] <- readLists
  a <- readMatrix
  print $ sum $ [num|a0 <-a,let num = length $ filter (1<=) $ zipWith (+) [at|(it,at)<-zip [0..] a0,(mod it 2) == 0] [at|(it,at)<-zip [0..] a0,(mod it 2) == 1]]

main = interact $ show . f . map read . words
f (a:b:c) = f1 c
f1 [] = 0
f1 (0:0:a) = f1 a
f1 (a:b:c) = 1 + f1 c

main = interact $ show . length . filter (> 0) . map (uncurry (+)) . pairs . map read . drop 2 . words
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []

module Main where

import Data.Functor

main :: IO ()
main = do
   [rn,cn] <- words <$> getLine
   mx <- getMatrix (read rn) (2 * read cn)
   print $ calc mx

getMatrix :: Int -> Int -> IO [[Int]]
getMatrix rn cn = do
   rows <- take rn <$> lines <$> getContents
   return $ map (map read . take cn . words) rows

calc :: [[Int]] -> Int
calc = sum . map group2

group2 :: [Int] -> Int
group2 [] = 0
group2 (0:0:as) = 0 + group2 as
group2 (0:1:as) = 1 + group2 as
group2 (1:0:as) = 1 + group2 as
group2 (1:1:as) = 1 + group2 as
group2 _ = undefined

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

main :: IO ()
main = do
    flats <- drop 1 . chunksOf 2 . map (read::String->Int) . words <$> getContents
    print . length . filter (> 0) $ map sum flats

import Control.Applicative
import Control.Monad

solve :: [Int] -> Int
solve [] = 0
solve (x:y:ys) = signum (x + y) + solve ys

main :: IO ()
main = do
    [n,m] <- map read . words <$> getLine
    ws <- concatMap (map read . words) <$> replicateM n getLine
    print $ solve ws

import Control.Applicative
import Data.List

process n [] = n
process n (a:b:s) = process (if a+b>0 then (n+1) else n) s

main= do
	getLine
	s<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	print $ sum $ map (process 0) s

--ghc 7.10

import Data.Bits((.|.))

countFloorNonsleeping :: [Int] -> Int
countFloorNonsleeping (x:y:ys) = (x .|. y) + countFloorNonsleeping ys
countFloorNonsleeping _ = 0

countBuldingNonsleeping :: [[Int]] -> Int
countBuldingNonsleeping = sum . map countFloorNonsleeping

main = do
    nmStr <- getLine
    contents <- getContents
    let xss = map (map read . words) . lines $ contents
    print $ countBuldingNonsleeping xss


After the piece of a devilish mirror hit the Kay's eye, he is no longer interested in the beauty of the roses. Now he likes to watch snowflakes.Once upon a time, he found a huge snowflake that has a form of the tree (connected acyclic graph) consisting of n nodes. The root of tree has index 1. Kay is very interested in the structure of this tree.After doing some research he formed q queries he is interested in. The i-th query asks to find a centroid of the subtree of the node vi. Your goal is to answer all queries.Subtree of a node is a part of tree consisting of this node and all it's descendants (direct or not). In other words, subtree of node v is formed by nodes u, such that node v is present on the path from u to root.Centroid of a tree (or a subtree) is a node, such that if we erase it from the tree, the maximum size of the connected component will be at least two times smaller than the size of the initial tree (or a subtree).

The first line of the input contains two integers n and q (2 ≤ n ≤ 300 000, 1 ≤ q ≤ 300 000) — the size of the initial tree and the number of queries respectively. The second line contains n - 1 integer p2, p3, ..., pn (1 ≤ pi ≤ n) — the indices of the parents of the nodes from 2 to n. Node 1 is a root of the tree. It's guaranteed that pi define a correct tree. Each of the following q lines contain a single integer vi (1 ≤ vi ≤ n) — the index of the node, that define the subtree, for which we want to find a centroid.

For each query print the index of a centroid of the corresponding subtree. If there are many suitable nodes, print any of them. It's guaranteed, that each subtree has at least one centroid.

Note  The first query asks for a centroid of the whole tree — this is node 3. If we delete node 3 the tree will split in four components, two of size 1 and two of size 2.The subtree of the second node consists of this node only, so the answer is 2.Node 3 is centroid of its own subtree.The centroids of the subtree of the node 5 are nodes 5 and 6 — both answers are considered correct.

-- Codeforces 686D

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (2, n) xs :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            !szu <- readArray son u
            !szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        su <- readArray son u
                        r <- readArray centeroid maxv
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

-- Codeforces 686D

{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -optc-O0 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (2, n) xs :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            !szu <- readArray son u
            !szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        su <- readArray son u
                        r <- readArray centeroid maxv
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array
import qualified Data.ByteString.Char8 as BS

readInt b = let (Just (a, _)) = BS.readInt b in a

main = BS.interact $ BS.unlines . map (BS.pack . show) . solve . map readInt . BS.words

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> snd $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst $ ans ! c)) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array
import qualified Data.ByteString.Char8 as BS

readInt b = let (Just (a, _)) = BS.readInt b in a

main = BS.interact $ BS.unlines . map (BS.pack . show) . solve . map readInt . BS.words

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> snd $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

updateArray a i f = do
    v <- readArray a i
    writeArray a i (f v)

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> updateArray graph pi (i:)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid
                 | children == [] || (fst fat) * 2 <= weight = v
                 | otherwise = lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c
                 | (weight - (fst $ ans ! c)) * 2 <= weight = c
                 | otherwise = lift (pa ! c)

import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Array as A

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

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = A.array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (baricenter, weight)
          where baricenter = if children == [] || (snd fat) * 2 <= weight
                             then v
                             else lift $ fst fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map snd children)
                lift c = if (weight - (snd (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

-- Codeforces 686D

{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -optc-O0 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import qualified Data.ByteString.Char8 as BC
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Foldable
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:q:rest) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents
    let !(!xs, !qs) = splitAt (n - 1) rest

    -- build graph
    let !graph = runSTArray $ do
          graph <- newArray (1, n) [] :: ST s (STArray s Int [Int])
          for_ (zip [2..n] xs) $ \(i, x) -> do
              xs <- readArray graph x
              writeArray graph x (i:xs)
          return graph

    let !fa = listArray (1, n) (0:xs) :: UArray Int Int

    -- dfs
    let !centeroid = runSTUArray $ do
          son <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          centeroid <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
          -- dfs graph fa son centeroid 1
          return centeroid

    -- result
    BC.putStrLn . BC.intercalate "\n" . map (BC.pack . show . (!) centeroid) $ qs

  where

    dfs graph fa son centeroid u = do
        writeArray son u 1
        writeArray centeroid u u

        maxs <- forM (graph ! u) $ \v -> do
            dfs graph fa son centeroid v
            szu <- readArray son u
            szv <- readArray son v
            writeArray son u (szu + szv)
            return (szv, v)

        let !maxv = if null maxs then 0
                                 else snd . Data.List.maximum $ maxs

        if maxv /= 0
            then do
                a <- readArray son maxv
                b <- readArray son u
                if a * 2 > b
                    then do
                        r <- readArray centeroid maxv
                        su <- readArray centeroid u
                        r' <- goup fa son su r
                        writeArray centeroid u r'
                    else return ()
            else return ()

    goup fa son su now = do
        k <- readArray son now
        if (su - k) * 2 > su
            then goup fa son su (fa ! now) -- go up
            else return now

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

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

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

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

solve :: [Int] -> [Int]
solve (n:q:rest) = map (\i -> fst $ all ! i) queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (baricenter, weight)
          where baricenter = if children == [] || (snd fat) * 2 <= weight
                             then v
                             else lift $ fst fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map snd children)
                lift c = if (weight - (snd (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

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

solve :: [Int] -> [Int]
solve (n:q:rest) = if n < 1000 then map (\i -> snd $ all ! i) queries else queries
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)

import Control.Monad
{-import Control.Monad.ST
import Data.Array.ST-}
import Data.Array
import qualified Data.Map as M

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

solve :: [Int] -> [Int]
solve (n:q:rest) = if n < 1000 then map (\i -> snd $ all ! i) queries else map (\v->if v==[] then 0 else head v) $ elems graph
    where p = take (n-1) rest
          pa = array (2, n) ([2..] `zip` p)
          queries = take q $ drop (n-1) rest
          graph = toG n p
          all = dfs n graph pa

{-toG n p = runSTArray $ do
    graph <- newArray (1, n) []
    forM_ ([2..] `zip` p) $ \(i, pi) -> do
        vertices <- readArray graph pi
        writeArray graph pi (i:vertices)
    return graph-}

toG n p = array (1, n) $ M.toList $ foldl add g_empty $ [2..] `zip` p
  where g_empty = M.fromList $ [1..n] `zip` (repeat [])
        add m (i, pi) = M.update (\a -> Just (i:a)) pi m

dfs :: Int -> Array Int [Int] -> Array Int Int -> Array Int (Int, Int)
dfs n graph pa = ans
  where ans = array (1, n) $ [1..] `zip` (map getAns [1..n])
        getAns :: Int -> (Int, Int)
        getAns v = (weight, centroid)
          where centroid = if children == [] || (fst fat) * 2 <= weight
                           then v
                           else lift $ snd fat
                children = map (\i -> ans ! i) (graph ! v)
                fat = maximum children
                weight = 1 + (sum $ map fst children)
                lift c = if (weight - (fst (ans ! c))) * 2 <= weight
                         then c
                         else lift (pa ! c)


You are given an array $$$a$$$ consisting of $$$n$$$ integers. For each $$$i$$$ ($$$1 \le i \le n$$$) the following inequality is true: $$$-2 \le a_i \le 2$$$.You can remove any number (possibly $$$0$$$) of elements from the beginning of the array and any number (possibly $$$0$$$) of elements from the end of the array. You are allowed to delete the whole array.You need to answer the question: how many elements should be removed from the beginning of the array, and how many elements should be removed from the end of the array, so that the result will be an array whose product (multiplication) of elements is maximal. If there is more than one way to get an array with the maximum product of elements on it, you are allowed to output any of them. The product of elements of an empty array (array of length $$$0$$$) should be assumed to be $$$1$$$.

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases in the test. Then the descriptions of the input test cases follow. The first line of each test case description contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) —the length of array $$$a$$$. The next line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$|a_i| \le 2$$$) — elements of array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output two non-negative numbers $$$x$$$ and $$$y$$$ ($$$0 \le x + y \le n$$$) — such that the product (multiplication) of the array numbers, after removing $$$x$$$ elements from the beginning and $$$y$$$ elements from the end, is maximal. If there is more than one way to get the maximal product, it is allowed to output any of them. Consider the product of numbers on empty array to be $$$1$$$.

NoteIn the first case, the maximal value of the product is $$$2$$$. Thus, we can either delete the first three elements (obtain array $$$[2]$$$), or the last two and one first element (also obtain array $$$[2]$$$), or the last two elements (obtain array $$$[1, 2]$$$). Thus, in the first case, the answers fit: "3 0", or "1 2", or "0 2".In the second case, the maximum value of the product is $$$1$$$. Then we can remove all elements from the array because the value of the product on the empty array will be $$$1$$$. So the answer is "3 0", but there are other possible answers.In the third case, we can remove the first two elements of the array. Then we get the array: $$$[-2, 2, -1]$$$. The product of the elements of the resulting array is $$$(-2) \cdot 2 \cdot (-1) = 4$$$. This value is the maximum possible value that can be obtained. Thus, for this case the answer is: "2 0".

import Data.Array
import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= \n -> map read . words <$> getLine >>= pp . maxProd n
  where pp (l, r) = putStrLn (show l ++ " " ++ show r)

maxProd :: Int -> [Int] -> (Int, Int)
maxProd n as = let a = listArray (1, n) as in
                 snd . maximum . map (findMax a) $ splitIndices a

splitIndices :: Array Int Int -> [(Int, Int)]
splitIndices a = let zeroIndices = filter (\i -> (a!i) == 0) (range (bounds a))
                     (1, n) = bounds a
                 in
                   pairs $ 1 : concatMap (\zi -> [zi-1, zi+1]) zeroIndices ++ [n]
  where pairs [] = []
        pairs (x:y:xs) = (x,y):pairs xs

findMax :: Array Int Int -> (Int, Int) -> (Int, (Int, Int))
findMax a (l, r) | l > r = (0, (snd (bounds a), 0))
                 | otherwise = findMaxWithin a l r

findMaxWithin a l r = let (1, n) = bounds a
                          (pos, count) = foldl f (True, 0) (map (a!) (range (l, r)))
                      in
                        if pos
                        then (count, (l-1, n-r))
                        else max (negF a n count l r) (negB a n count l r)
  where f (pos, c) e = (if e > 0 then pos else not pos, c + (abs e) -1)

d2 c e = if abs e == 2 then c-1 else c
negF a n c i j | i > j = (1, (n, 0))
               | (a!i) < 0 = (d2 c (a!i), (i, n-j))
               | otherwise = negF a n (d2 c (a!i)) (i+1) j
negB a n c i j | i > j = (1, (n, 0))
               | (a!j) < 0 = (d2 c (a!j), (i-1, n-j+1))
               | otherwise = negB a n (d2 c (a!j)) i (j-1)

import Data.Array
import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= \n -> map read . words <$> getLine >>= pp . maxProd n
  where pp (l, r) = putStrLn (show l ++ " " ++ show r)

maxProd :: Int -> [Int] -> (Int, Int)
maxProd n as = let a = listArray (1, n) as in
                 snd . maximum . map (findMax a) $ splitIndices a

splitIndices :: Array Int Int -> [(Int, Int)]
splitIndices a = let zeroIndices = filter (\i -> (a!i) == 0) (range (bounds a))
                     (1, n) = bounds a
                 in
                   pairs $ 1 : concatMap (\zi -> [zi-1, zi+1]) zeroIndices ++ [n]
  where pairs [] = []
        pairs (x:y:xs) = (x,y):pairs xs

findMax :: Array Int Int -> (Int, Int) -> (Int, (Int, Int))
findMax a (l, r) | l > r = (1, (snd (bounds a), 0))
                 | otherwise = findMaxWithin a l r

findMaxWithin a l r = let (1, n) = bounds a
                          p = foldl (*) 1 (map (a!) (range (l, r)))
                      in
                        if p > 0
                        then (p, (l-1, n-r))
                        else max (negF a n p l r) (negB a n p l r)

negF a n p i j | i > j = (1, (i, n-i))
               | (a!i) < 0 = (div p (a!i), (i, n-j))
               | otherwise = negF a n (div p (a!i)) (i+1) j
negB a n p i j | i > j = (1, (i, n-i))
               | (a!j) < 0 = (div p (a!j), (i-1, n-j+1))
               | otherwise = negB a n (div p (a!j)) i (j-1)

import Data.Array
import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= \n -> map read . words <$> getLine >>= pp . maxProd n
  where pp (l, r) = putStrLn (show l ++ " " ++ show r)

maxProd :: Int -> [Int] -> (Int, Int)
maxProd n as = let a = listArray (1, n) as in
                 snd . maximum . map (findMax a) $ splitIndices a

splitIndices :: Array Int Int -> [(Int, Int)]
splitIndices a = let zeroIndices = filter (\i -> (a!i) == 0) (range (bounds a))
                     (1, n) = bounds a
                 in
                   pairs $ 1 : concatMap (\zi -> [zi-1, zi+1]) zeroIndices ++ [n]
  where pairs [] = []
        pairs (x:y:xs) = (x,y):pairs xs

findMax :: Array Int Int -> (Int, Int) -> (Int, (Int, Int))
findMax a (l, r) | l > r = (1, (l, snd (bounds a) - l))
                 | otherwise = findMaxWithin a l r

findMaxWithin a l r = let (1, n) = bounds a
                          p = foldl (*) 1 (map (a!) (range (l, r)))
                      in
                        if p > 0
                        then (p, (l-1, n-r))
                        else max (negF a n p l r) (negB a n p l r)

negF a n p i j | i > j = (1, (i, n-i))
               | (a!i) < 0 = (div p (a!i), (i, n-j))
               | otherwise = negF a n (div p (a!i)) (i+1) j
negB a n p i j | i > j = (1, (i, n-i))
               | (a!j) < 0 = (div p (a!j), (i-1, n-j+1))
               | otherwise = negB a n (div p (a!j)) i (j-1)


Once upon a time there was only one router in the well-known company Bmail. Years went by and over time new routers were purchased. Every time they bought a new router, they connected it to one of the routers bought before it. You are given the values $$$p_i$$$ — the index of the router to which the $$$i$$$-th router was connected after being purchased ($$$p_i < i$$$).There are $$$n$$$ routers in Boogle in total now. Print the sequence of routers on the path from the first to the $$$n$$$-th router.

The first line contains integer number $$$n$$$ ($$$2 \le n \le 200000$$$) — the number of the routers. The following line contains $$$n-1$$$ integers $$$p_2, p_3, \dots, p_n$$$ ($$$1 \le p_i < i$$$), where $$$p_i$$$ is equal to index of the router to which the $$$i$$$-th was connected after purchase.

Print the path from the $$$1$$$-st to the $$$n$$$-th router. It starts with $$$1$$$ and ends with $$$n$$$. All the elements in the path should be distinct.

{-# LANGUAGE ScopedTypeVariables #-}

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.IArray
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import Data.Int
import Data.Tree
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    predecessors <- (map readB8Int) <$> B8.words <$> B8.getLine
    let tree :: UArray Int Int = listArray (1, n) (0 : predecessors)
    let nodes = reverse . takeWhile (> 0) . iterate (\index -> tree ! index) $ n
    forM_ nodes $ \node -> do
        printf "%d " node


The official capital and the cultural capital of Berland are connected by a single road running through n regions. Each region has a unique climate, so the i-th (1 ≤ i ≤ n) region has a stable temperature of ti degrees in summer.This summer a group of m schoolchildren wants to get from the official capital to the cultural capital to visit museums and sights. The trip organizers transport the children between the cities in buses, but sometimes it is very hot. Specifically, if the bus is driving through the i-th region and has k schoolchildren, then the temperature inside the bus is ti + k degrees.Of course, nobody likes it when the bus is hot. So, when the bus drives through the i-th region, if it has more than Ti degrees inside, each of the schoolchild in the bus demands compensation for the uncomfortable conditions. The compensation is as large as xi rubles and it is charged in each region where the temperature in the bus exceeds the limit.To save money, the organizers of the trip may arbitrarily add or remove extra buses in the beginning of the trip, and between regions (of course, they need at least one bus to pass any region). The organizers can also arbitrarily sort the children into buses, however, each of buses in the i-th region will cost the organizers costi rubles. Please note that sorting children into buses takes no money.Your task is to find the minimum number of rubles, which the organizers will have to spend to transport all schoolchildren.

The first input line contains two integers n and m (1 ≤ n ≤ 105; 1 ≤ m ≤ 106) — the number of regions on the way and the number of schoolchildren in the group, correspondingly. Next n lines contain four integers each: the i-th line contains ti, Ti, xi and costi (1 ≤ ti, Ti, xi, costi ≤ 106). The numbers in the lines are separated by single spaces.

Print the only integer — the minimum number of roubles the organizers will have to spend to transport all schoolchildren. Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use cin, cout streams or the %I64d specifier.

NoteIn the first sample the organizers will use only one bus to travel through the first region. However, the temperature in the bus will equal 30 + 10 = 40 degrees and each of 10 schoolchildren will ask for compensation. Only one bus will transport the group through the second region too, but the temperature inside won't exceed the limit. Overall, the organizers will spend 100 + 10 + 10 = 120 rubles.

{-# OPTIONS_GHC -O2 -optc-O3 -fignore-asserts #-}
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao n [] = 0
gao n (a:b:x:y:t) = s + r
  where
    c = b - a
    m = (n + c - 1) `div` c
    r = gao n t
    s
      | c <= 0    = x * n + y
      | m == 1    = y
      | otherwise = minimum [x * n + y, m * y, (n - (m - 2) * c) * x + (m - 1) * y]

main = do
  (n:m:a) <- fmap (map (fromIntegral . fst . fromJust . C.readInt) . C.words) C.getContents
  print $ gao m a

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

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

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th==0 = cost+m*x
        | otherwise = min (cost+m*x) ((m+th-1)`div`th*cost)
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

{-# OPTIONS_GHC -O2 -optc-O3 -fignore-asserts #-}
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao n [] = 0
gao n (a:b:x:y:t) = s + r
  where
    c = b - a
    m = (n + c - 1) `div` c
    r = gao n t
    s
      | c <= 0    = x * n + y
      | m == 1    = y
      | otherwise = minimum [x * n + y, m * y, (n - (m - 2) * c) * x + (m - 1) * y]

main = do
  (n:m:a) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  print $ gao m a

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

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

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | m<=th = cost
        | th*x<=cost = cost + m*x
        | otherwise = ((m+th-1)`div`th)*cost
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

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

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th>m = cost
        | th*x < cost = m*x+cost
        | otherwise = q*cost + min cost (r*x)
       where
         th = max 0 $ tt-t
         (q,r) = divMod m th
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

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

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | th==0 = cost+m*x
        | m<=th = cost
        | (th+r)*x<=cost = cost + m*x
        | otherwise = q*cost
       where
         th = max 0 $ tt-t
         (q,r) = divMod (m+th-1) th
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words

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

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

main = do
  [_,m] <- map read.words <$> getLine
  let calc t tt x cost
        | cost-th*x>=0 = m*x+cost
        | otherwise = ((m+th-1)`div`th)*cost
       where
         th = max 0 $ tt-t
      toRoubles :: [Integer] -> [Integer]
      toRoubles (t:tt:x:cost:rest) = calc t tt x cost : toRoubles rest
      toRoubles [] = []
  B.getContents >>= print.sum.toRoubles.map readInteger.B.words


There are $$$n + 1$$$ cities, numbered from $$$0$$$ to $$$n$$$. $$$n$$$ roads connect these cities, the $$$i$$$-th road connects cities $$$i - 1$$$ and $$$i$$$ ($$$i \in [1, n]$$$).Each road has a direction. The directions are given by a string of $$$n$$$ characters such that each character is either L or R. If the $$$i$$$-th character is L, it means that the $$$i$$$-th road initially goes from the city $$$i$$$ to the city $$$i - 1$$$; otherwise it goes from the city $$$i - 1$$$ to the city $$$i$$$.A traveler would like to visit as many cities of this country as possible. Initially, they will choose some city to start their journey from. Each day, the traveler must go from the city where they currently are to a neighboring city using one of the roads, and they can go along a road only if it is directed in the same direction they are going; i. e., if a road is directed from city $$$i$$$ to the city $$$i + 1$$$, it is possible to travel from $$$i$$$ to $$$i + 1$$$, but not from $$$i + 1$$$ to $$$i$$$. After the traveler moves to a neighboring city, all roads change their directions to the opposite ones. If the traveler cannot go from their current city to a neighboring city, their journey ends; it is also possible to end the journey whenever the traveler wants to.The goal of the traveler is to visit as many different cities as possible (they can visit a city multiple times, but only the first visit is counted). For each city $$$i$$$, calculate the maximum number of different cities the traveler can visit during exactly one journey if they start in the city $$$i$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case consists of two lines. The first line contains one integer $$$n$$$ ($$$1 \le n \le 3 \cdot 10^5$$$). The second line contains the string $$$s$$$ consisting of exactly $$$n$$$ characters, each character is either L or R. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case, print $$$n + 1$$$ integers. The $$$i$$$-th integer should be equal to the maximum number of different cities the traveler can visit during one journey if this journey starts in the $$$i$$$-th city.

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  _ <- getLine
  s <- getLine
  let bs = group $ zipWith (\c i -> (c == 'L') == even i) s [0 :: Integer ..]
  let xs = bs >>= (\a -> replicate (length a) (length a, head a))
  let cs =
        zipWith3
          ( \(x1, b1) (x2, b2) i ->
              if even i
                then
                  ( if b1 && b2 then 1 else if b1 then 1 + x2 else 1 + x1
                  )
                else
                  ( if b1 then 1 + x1 else if b2 then 1 + x2 else 1
                  )
          )
          (head xs : xs)
          (xs ++ [last xs])
          [0 :: Integer ..]
  putStrLn $ unwords $ show <$> cs

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
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           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           GHC.IO.Handle              (hDuplicateTo)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             openFile, stdin, stdout)
import           Text.Printf                (printf)

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

solve :: Int -> B8.ByteString -> [Int]
solve n directions = do
        -- traceShowM nextRLs
        -- traceShowM prevRLs
        i <- [0 .. n]
        let nextRL = nextRLs UA.! (i + 1)
        let prevRL = prevRLs UA.! i
        return $ prevRL + 1 + nextRL
    where
        nextRLs :: UA.UArray Int Int
        nextRLs = STA.runSTUArray $ do
            dpRL <- STA.newArray (0, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            dpLR <- STA.newArray (0, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ (reverse [1 .. n]) $ \i -> do
                nextDpLR <- STA.readArray dpLR (i + 1)
                nextDpRL <- STA.readArray dpRL (i + 1)

                let lengthLR = if (directions `B8.index` (i - 1)) == 'L' then 1 + nextDpRL else 0
                    lengthRL = if (directions `B8.index` (i - 1)) == 'R' then 1 + nextDpLR else 0

                STA.writeArray dpLR i lengthLR
                STA.writeArray dpRL i lengthRL
            return dpRL

        prevRLs :: UA.UArray Int Int
        prevRLs = STA.runSTUArray $ do
            dpRL <- STA.newArray (-1, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            dpLR <- STA.newArray (-1, n + 1) 0 :: ST.ST s (STA.STUArray s Int Int)
            forM_ [1 .. n] $ \i -> do
                prevDpLR <- STA.readArray dpLR (i - 1)
                prevDpRL <- STA.readArray dpRL (i - 1)

                let lengthLR = if (directions `B8.index` (i - 1)) == 'R' then 1 + prevDpRL else 0
                    lengthRL = if (directions `B8.index` (i - 1)) == 'L' then 1 + prevDpLR else 0

                STA.writeArray dpLR i lengthLR
                STA.writeArray dpRL i lengthRL
            return dpRL

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        directions <- B8.getLine <&> head . B8.words

        let answer = solve n directions

        forM_ answer $ printf "%d "
        printf "\n"

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

import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Int

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]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    s <- readLine
    let
      evens = P.cycle $ P.pack "RL"
      evenStops = [i | (i, p) <- zip [0..] $ P.zipWith (/=) evens s, p] ++ [n]
      oddStops  = [i | (i, p) <- zip [0..] $ P.zipWith (==) evens s, p] ++ [n]
      step :: Int -> Int -> [Int] -> [(Int, Int)]
      step ix last li@(next:nexts)
        | ix > next  = step ix next nexts
        | otherwise  = (ix, next-last) : step (ix+2) last li
      step _ _ [] = []
      ans0 = step 0 (-1) evenStops
      ans1 = step 1 (-1) oddStops
      ans = map snd . sort $ ans0 ++ ans1
    lift . P.putStrLn . P.pack . unwords $ map show ans

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

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  _ <- getLine
  s <- getLine
  let bs = group $ zipWith (\c i -> (c == 'L') == even i) s [0 :: Integer ..]
  let xs = bs >>= (\a -> replicate (length a) (length a, head a))
  print xs
  let cs =
        zipWith3
          ( \(x1, b1) (x2, b2) i ->
              if even i
                then
                  ( if b1 && b2 then 1 else if b1 then 1 + x2 else 1 + x1
                  )
                else
                  ( if b1 then 1 + x1 else if b2 then 1 + x2 else 1
                  )
          )
          (head xs : xs)
          (xs ++ [last xs])
          [0 :: Integer ..]
  print cs


Fox Ciel is playing a mobile puzzle game called "Two Dots". The basic levels are played on a board of size n × m cells, like this:Each cell contains a dot that has some color. We will use different uppercase Latin characters to express different colors.The key of this game is to find a cycle that contain dots of same color. Consider 4 blue dots on the picture forming a circle as an example. Formally, we call a sequence of dots d1, d2, ..., dk a cycle if and only if it meets the following condition:  These k dots are different: if i ≠ j then di is different from dj.  k is at least 4.  All dots belong to the same color.  For all 1 ≤ i ≤ k - 1: di and di + 1 are adjacent. Also, dk and d1 should also be adjacent. Cells x and y are called adjacent if they share an edge. Determine if there exists a cycle on the field.

The first line contains two integers n and m (2 ≤ n, m ≤ 50): the number of rows and columns of the board. Then n lines follow, each line contains a string consisting of m characters, expressing colors of dots in each line. Each character is an uppercase Latin letter.

Output "Yes" if there exists a cycle, and "No" otherwise.

7 6
AAAAAB
ABBBAB
ABAAAB
ABABBB
ABAAAB
ABBBAB
AAAAAB

NoteIn first sample test all 'A' form a cycle.In second sample there is no such cycle.The third sample is displayed on the picture above ('Y' = Yellow, 'B' = Blue, 'R' = Red).

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

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

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

main = do
  [n, m] <- getInts
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, m)) $ concat a :: Array (Int, Int) Char

    f = or $ (flip evalState) Set.empty $ do
      forM ((,) <$> [1..n] <*> [1..m]) $ \v -> do
        m <- get
        if v `Set.member` m
           then return False
           else search (0, 0) v

    adj xy@(x, y) = filter (\xy'@(x, y) -> elem x [1..n] && elem y [1..m] && a'!xy' == a'!xy) [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

    search w u = do
      modify $ Set.insert u

      or <$> (forM (adj u) $ \v -> do
        m <- get
        if v `Set.member` m
         then return $ v /= w
         else search u v)

  putStrLn $ if f then "Yes" else "No"

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

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

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

main = do
  [n, m] <- getInts
  a <- replicateM n getLine

  let
    a' = listArray ((1, 1), (n, m)) $ concat a :: Array (Int, Int) Char

    f = or ((flip evalState) Set.empty $ do
      forM ((,) <$> [1..n] <*> [1..m]) $ \v -> do
        m <- get
        if v `Set.member` m
           then return False
           else search (0, 0) v)

    adj xy@(x, y) = filter (\xy'@(x, y) -> 1 <= x && x <= n && 1 <= y && y <= m && a'!xy' == a'!xy) [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

    search w u = do
      modify $ Set.insert u

      or <$> (forM (adj u) $ \v -> do
        m <- get
        if v `Set.member` m
         then return $ v /= w
         else search u v)

  putStrLn $ if f then "Yes" else "No"

import qualified Data.ByteString.Char8 as B
import qualified Data.Set as Set
import Data.List
import Data.Maybe

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Set.Set String -> Set.Set String
mark r c  = Set.insert (getNodeKey r c)

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Set.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Set.Set String -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if Set.notMember (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

import qualified Data.Map as Map
import Data.List
import Data.Maybe

adj::[String] -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where rows = length graph
        cols = length $ head graph
        getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Map.Map String Bool -> Map.Map String Bool
mark r c  = Map.insert (getNodeKey r c) True

hasCycle::[String] -> Bool
hasCycle graph = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Map.empty

findCycle::[String] -> (Char, Int, Int) -> (Char, Int, Int) -> Map.Map String Bool -> Bool
findCycle graph current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if isNothing $ Map.lookup (getNodeKey r c) marked
      then findCycle graph v current (mark r c marked)
      else v /= parent
    ) $ adj graph current

readLine = getLine >>= return . words

main = do
  _ <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph then "Yes" else "No"

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

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Map.Map String Bool -> Map.Map String Bool
mark r c  = Map.insert (getNodeKey r c) True

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Map.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Map.Map String Bool -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if isNothing $ Map.lookup (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

module Main where

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

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- replicateM n getLine
  B.putStrLn . B.pack $ main' n m $ concat field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = fst $ foldl check (False, []) [0..length str]
  where
    check (True, _) _ = (True, [])
    check (False, visited) ind
      | ind `elem` visited = (False, visited)
      | otherwise = (fst res, snd res ++ visited)
        where res = dfs ind Nothing [] (n,m, str)

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> (Bool, [Int])
dfs ind prev visited g@(h, w, graph)
  | ind >= length graph = (False, visited)
  | ind `elem` visited = (True, visited)
  | null sub' = (False, ind:visited)
  | otherwise = (or $ fst m', concat $ snd m')
  where
    sub = getSubNodes g ind
    sub' = case prev of
      Nothing -> sub
      Just x -> filter (/= x) sub
    m' = unzip $ map (\i -> dfs i (Just ind) (ind:visited) g) sub'

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(h, w, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> and [x >= 0, x < (length str), str!!x == str!!ind])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, fromMaybe)
import Data.Set (member, insert, empty, Set)
import Data.Map.Strict (lookup, fromList, toList, (!), Map, keys)
import Data.List (concatMap)
import Prelude hiding (lookup)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

neighbours :: (Int, Int) -> [(Int, Int)]
neighbours (x, y) =
  [ (x - 1, y)
  , (x, y - 1)
  , (x + 1, y)
  , (x, y + 1)
  ]

dfs :: Map (Int, Int) Char -> Set (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> (Bool, Set (Int, Int))
dfs field visited point prev =
  if member point visited then
    (True, visited)
  else
    let
      getPair k m =
        case lookup k m of
          Just v -> [(k, v)]
          Nothing -> []
      candidates =
        filter (fromMaybe (const True) $ fmap (/=) prev)
        . map fst
        . filter ((== field ! point) . snd)
        . concatMap (flip getPair field)
        . neighbours
        $ point
      folder res@(True, _) _ = res
      folder (_, visited) candidate =
        dfs field visited candidate (Just point)
    in
      foldl folder (False, insert point visited) candidates

reduce :: Map (Int, Int) Char -> Set (Int, Int) -> [(Int, Int)] -> Bool
reduce field visited [] = False
reduce field visited (point:points) =
  if member point visited then
    reduce field visited points
  else
    let (res, newVisited) = dfs field visited point Nothing
    in if res then res else reduce field newVisited points

main = do
  [rows, columns] <- readLine
  field <- sequence (take rows . repeat $ B.getLine >>= return . B.unpack) >>=
             return . fromList . concatMap (\(x, row) -> zipWith (\y ch -> ((x, y), ch)) [0..] row) . zip [0..]
  B.putStrLn . B.pack $ if reduce field empty (keys field) then "Yes" else "No"

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, catMaybes, fromMaybe)
import Data.Map (Map, lookup, insert, empty, union)
import Prelude hiding (lookup)
-- import Debug.Trace (traceShowId)

folder :: (Bool, Int, Map Int Int, (Char, Int), Map Int Int, [(Char, Int)]) -> (Char, (Char, Int)) -> (Bool, Int, Map Int Int, (Char, Int), Map Int Int, [(Char, Int)])
folder all@(res, nextId, mappings, (prevChar, prevGroup), nextMappings, collected) next@(nextChar, (prevLineChar, prevLineGroup)) =
  if res then -- fst . traceShowId $ (res, (all, next)) then
    all
  else
    if prevChar == nextChar then
      if (== prevGroup) . fromMaybe prevLineGroup $ lookup prevLineGroup mappings then
        (True, nextId, mappings, (nextChar, prevGroup), nextMappings, (nextChar, prevGroup):collected)
      else
        if prevChar == prevLineChar then
          let
            prevLineGroupMapping = lookup prevLineGroup mappings
            basePrevLineGroupMapping =
              prevLineGroupMapping >>= flip lookup nextMappings
            finalPrevLineGroupMapping =
              case basePrevLineGroupMapping of
                Just _ -> basePrevLineGroupMapping
                Nothing -> prevLineGroupMapping
          in
            ( False
            , nextId
            , insert prevLineGroup prevGroup mappings
            , (nextChar, prevGroup)
            , case basePrevLineGroupMapping of
                Just x -> insert prevGroup x nextMappings
                _ -> nextMappings
            , (nextChar, prevGroup):collected
            )
        else
          (False, nextId, mappings, (nextChar, prevGroup), nextMappings, (nextChar, prevGroup):collected)
    else
      if prevLineChar == nextChar then
        let new = (nextChar, fromMaybe prevLineGroup $ lookup prevLineGroup mappings)
        in (False, nextId, mappings, new, nextMappings, new:collected)
      else
        (False, nextId + 1, mappings, (nextChar, nextId), nextMappings, (nextChar, nextId):collected)

outerFolder :: (Bool, Int, Map Int Int, [(Char, Int)]) -> [Char] -> (Bool, Int, Map Int Int, [(Char, Int)])
outerFolder all@(res, nextId, mappings, prevLine) line =
  if res then
    all
  else
    let
      (newRes, newNextId, oldMappings, _, newMappings, newLine) =
        foldl folder (False, nextId, mappings, ('$', -1), empty, []) $ zip line prevLine
    in
      (newRes, newNextId, union newMappings oldMappings, reverse newLine)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  field <- sequence . take rows $ repeat (B.getLine >>= return . B.unpack)
  B.putStrLn . B.pack $
    case foldl outerFolder (False, 0, empty, take cols $ repeat ('$', -1)) field of
      (True, _, _, _) -> "Yes"
      _ -> "No"

import qualified Data.Map as Map
import Data.List
import Data.Maybe

adj::[String] -> (Int, Char) -> [(Int, Char)]
adj graph (i, v)
  | i > maxLength - 1 || i < 0 = []
  | otherwise = filter (\(_, x) -> x == v)
      $ map node
      $ filter (\x -> x >= 0 && x < maxLength)
        [
          if hasPrev i then i - 1 else -1,
          if hasNext i then i + 1 else -1,
          i - cols,
          i + cols
        ]
  where rows = length graph
        cols = length $ head graph
        maxLength = cols * rows
        hasPrev index = col index > 0
        hasNext index = col index < cols - 1
        row index =  floor (fromIntegral index / fromIntegral cols)
        col index = index - cols * row index
        node index = (index, (graph !! row index) !! col index)

hasCycle graph =
  isJust $ find (\node -> findCycle graph node node (Map.insert (fst node) True marked))
    $ zip [0..] (intercalate "" graph)
  where marked = Map.empty

findCycle::[String] -> (Int, Char) -> (Int, Char) -> Map.Map Int Bool -> Bool
findCycle graph current parent marked =
  isJust $ find (\node ->
    if isNothing $ Map.lookup (fst node) marked
      then findCycle graph node current (Map.insert (fst node) True marked)
      else node /= parent
    ) $ adj graph current

readLine = getLine >>= return . words

main = do
  _ <- readLine
  graph <- getContents >>= return . words
  print $ if hasCycle graph then "Yes" else "No"

import qualified Data.ByteString.Char8 as B
import qualified Data.Set as Set
import Data.List
import Data.Maybe

adj::[String] -> Int -> Int -> (Char, Int, Int) -> [(Char, Int, Int)]
adj graph rows cols (key, row, col) = filter (\(xKey, x, _) -> x >= 0 && xKey == key) [
    if col == 0 then ('a', -1, -1) else (getKey row (col - 1), row, col - 1),
    if col == cols - 1 then ('a', -1, -1) else (getKey row (col + 1), row, col + 1),
    if row == 0 then ('a', -1, -1) else (getKey (row - 1) col, row - 1, col),
    if row == rows - 1 then ('a', -1, -1) else (getKey (row + 1) col, row + 1, col)
  ]
  where getKey r c = (graph !! r) !! c

getNodeKey::Int -> Int -> String
getNodeKey r c = show r ++ "_" ++ show c

mark::Int -> Int -> Set.Set String -> Set.Set String
mark r c  = Set.insert (getNodeKey r c)

hasCycle::[String] -> Int -> Int -> Bool
hasCycle graph rows cols = isJust $ find
  (
    \(r, row) -> isJust $ find (\(c, key) -> findCycle graph rows cols (key, r, c) (key, r, c) (mark r c marked)) $ zip [0..] row
  ) $ zip [0..] graph
  where marked = Set.empty

findCycle::[String] -> Int -> Int -> (Char, Int, Int) -> (Char, Int, Int) -> Set.Set String -> Bool
findCycle graph rows cols current parent marked =
  isJust $ find (\v@(_, r, c) ->
    if Set.member (getNodeKey r c) marked
      then findCycle graph rows cols v current (mark r c marked)
      else v /= parent
    ) $ adj graph rows cols current

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine = B.getLine >>= return . map readInt . B.words

main = do
  [rows, cols] <- readLine
  graph <- getContents >>= return . words
  putStrLn $ id $ if hasCycle graph rows cols then "Yes" else "No"

module Main where

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

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- replicateM n getLine
  B.putStrLn . B.pack $ main' n m $ concat field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = any (\ind -> dfs ind Nothing [] (n,m, str)) [1..length str]

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> Bool
dfs ind prevInd visitedInd g@(w, h, graph)
  | ind >= length graph = False
  | ind `elem` visitedInd = True
  | null sub' = False
  | otherwise = or $ map (\i -> dfs i (Just ind) (ind:visitedInd) g) sub'
  where
    sub = getSubNodes g ind
    sub' = case prevInd of
      Nothing -> sub
      Just x -> filter (/= x) sub

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(w, h, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> str!!x == str!!ind) . filter (\x -> and [x /= ind, x >= 0, x < (length str)])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w

module Main where

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

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [n, m] <- readLine
  field <- getContents
  B.putStrLn . B.pack $ main' n m $ field

main' :: Int -> Int -> String -> String
main' n m str = if (dots n m str) then "Yes" else "No"

dots :: Int -> Int -> String -> Bool
dots n m str = any (\ind -> dfs ind Nothing [] (n,m, str)) [1..length str]

dfs :: Int -> Maybe Int -> [Int] -> (Int, Int, String) -> Bool
dfs ind prevInd visitedInd g@(w, h, graph)
  | ind >= length graph = False
  | ind `elem` visitedInd = True
  | null sub' = False
  | otherwise = or $ map (\i -> dfs i (Just ind) (ind:visitedInd) g) sub'
  where
    sub = getSubNodes g ind
    sub' = case prevInd of
      Nothing -> sub
      Just x -> filter (/= x) sub

getSubNodes :: (Int, Int, String) -> Int -> [Int]
getSubNodes g@(w, h, str) ind
  | i' == 1 = f' [r, t, b]
  | i' == 0  = f' [l, t, b]
  | otherwise = f' [r, l, t, b]
  where
    f' = filter (\x -> str!!x == str!!ind) . filter (\x -> and [x /= ind, x >= 0, x < (length str)])
    i' = mod (succ ind) w
    r = succ ind
    l = pred ind
    t = ind - w
    b = ind + w


Polycarpus has n friends in Tarasov city. Polycarpus knows phone numbers of all his friends: they are strings s1, s2, ..., sn. All these strings consist only of digits and have the same length. Once Polycarpus needed to figure out Tarasov city phone code. He assumed that the phone code of the city is the longest common prefix of all phone numbers of his friends. In other words, it is the longest string c which is a prefix (the beginning) of each si for all i (1 ≤ i ≤ n). Help Polycarpus determine the length of the city phone code.

The first line of the input contains an integer n (2 ≤ n ≤ 3·104) — the number of Polycarpus's friends. The following n lines contain strings s1, s2, ..., sn — the phone numbers of Polycarpus's friends. It is guaranteed that all strings consist only of digits and have the same length from 1 to 20, inclusive. It is also guaranteed that all strings are different.

Print the number of digits in the city phone code.

NoteA prefix of string t is a string that is obtained by deleting zero or more digits from the end of string t. For example, string "00209" has 6 prefixes: "" (an empty prefix), "0", "00", "002", "0020", "00209".In the first sample the city phone code is string "00".In the second sample the city phone code is an empty string.In the third sample the city phone code is string "770123456789".

diff :: String -> String -> Int
diff [] [] = 0
diff as bs | head as == head bs = 1 + diff (tail as) (tail bs)
           | otherwise          = 0

dafuq x = do
            let c = tail $lines x
            show.minimum.map (diff (head c)) $c

main = interact dafuq

main = do getContents >>= print . length . takeWhile (/='*') . foldl1 (zipWith (\i j -> if i == j then i else '*')) . tail . lines

import Data.List
commonPrefix :: [String] -> Int
commonPrefix = length . commonPart
    where commonPart = foldl1' step
              where step acc x = map fst . takeWhile (\(i,j) -> i == j) . zip acc $ x

main = interact $ show . commonPrefix . tail .  lines

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

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

hoge 'R' = 0
hoge 'P' = 1
hoge 'S' = 2

wins x y | a == b = False
         | (a - b) `mod` 3 == 1 = True
         | otherwise = False
  where
    (a, b) = (hoge x, hoge y)

play m ns ps = play' m 0 0 ns ps
  where
    play' 0 a b _  _  = (a, b)
    play' x a b (n:ns) (p:ps) | wins n p = play' (x - 1) a (b+1) ns ps
                              | wins p n = play' (x - 1) (a + 1) b ns ps
                              | otherwise = play' (x - 1) a b ns ps

longest as bs = longest' [] as bs
  where
    longest' stack (x:xs) (y:ys) | x == y = longest' (x:stack) xs ys
    longest' stack _ _ = reverse stack

loop _ []  = return 0
loop 0 lst = return $ length lst
loop n lst = do s <- readTerm
                let l = longest lst s
                loop (n - 1) l

main = do n <- readNum
          s <- readTerm
          l <- loop (n - 1) s
          print $ l

main = do
    numbers <- fmap (tail . lines) getContents
    print $ length $ foldl1 commonPrefix numbers
    where
        commonPrefix _      ""     = ""
        commonPrefix ""     _      = ""
        commonPrefix (x:xs) (y:ys) = if x == y then x:commonPrefix xs ys else ""

import qualified Data.List as L
main = interact $ show . solve . tail . words
solve s = length . takeWhile (\xs -> all (== head xs) xs) . L.transpose $ s

calc2 (x:a) (y:b)
    | x == y = (x:calc2 a b)
    | otherwise = []
calc2 _ _ = []

main = do
    contents <- getContents
    print $ length $ foldl1 calc2 (tail $ lines contents)

calc2 :: Eq a => [a] -> [a] -> [a]
calc2 (x:a) (y:b)
    | x == y = (x:calc2 a b)
    | otherwise = []
calc2 _ _ = []

calcn (x:y:xs) = calcn z
    where
        z = [calc2 x y] ++ xs
calcn (x:[]) = x

main = do
    contents <- getContents
    print $ length $ calcn $ tail $ lines contents

import Control.Applicative
import Data.List

solve :: [String] -> Int
solve d = if all ((d !! 0 !! 0 : []) `isPrefixOf`) d
          then 1 + (solve $ map (drop 1) d)
          else 0

main :: IO ()
main = do
  n <- getLine
  d <- words <$> getContents
  print $ solve d

getPrefix :: String -> String -> String
getPrefix [] _  =  []
getPrefix _ []  =  []
getPrefix (c1:s1) (c2:s2)
  | c1 == c2  =  c1 : getPrefix s1 s2
  | otherwise  =  []

main :: IO ()
main  =  do
    n <- readLn
    lines <- mapM (const getLine) [1..n]
    print $ length (foldl1 getPrefix lines)

import System.IO

readInputLoop :: Int -> IO [String]
readInputLoop 0 = do
    return []

readInputLoop n = do
     h <- getLine
     t <- readInputLoop (n - 1)
     return $ h:t

readInput :: IO [String]
readInput = do
    n_str <- getLine
    readInputLoop (read n_str::Int)

-- I don't care about tail recursion
lcp :: [String] -> Int
lcp list   | any null list                                        = 0
           | any (\str -> ((head str) /= head (head list))) list  = 0
           | otherwise                                            = 1 + (lcp $ map (drop 1) list)

main :: IO()
main = do
    x <- readInput
    putStrLn $ show $ lcp x

main = print . length . foldr1 commonPrefix . tail . lines =<< getContents
commonPrefix (a:as) (b:bs) | a == b    = a : commonPrefix as bs
commonPrefix _ _ = []

import Control.Monad
import Data.List
main = do
    n <- fmap read getLine
    s <- forM [1..n] (\_ -> getLine)
    print $ solve s 0
solve :: [String] -> Integer -> Integer
solve s n = if allEq $ map (genericTake $ n+1) s then solve s $ n+1 else n
allEq :: [String] -> Bool
allEq [] = True
allEq [x] = True
allEq (x:y:ys) = x == y && allEq (y:ys)

import Data.Functor

allEqual :: Eq a => [a] -> Bool
allEqual l = all (== head l) l

-- | Find longest common prefix size for strings of equal length.
prefixLen :: [String] -> Int
prefixLen species@(s:_) =
    let
        prefixes = map head species
    in
      if (length s /= 0) && (allEqual prefixes) then
          1 + (prefixLen $ map tail species)
      else 0

main :: IO ()
main = do
  -- read n (assume n ≥ 2)
  _ <- getLine
  numbers <- lines <$> getContents
  print $ prefixLen numbers

import Data.List
solve = length . takeWhile (((==) 1) . length . group) . transpose
parse = tail . lines
main = interact (show . solve . parse)


So, the Berland is at war with its eternal enemy Flatland again, and Vasya, an accountant, was assigned to fulfil his duty to the nation. Right now the situation in Berland is dismal — their both cities are surrounded! The armies of flatlanders stand on the borders of circles, the circles' centers are in the surrounded cities. At any moment all points of the flatland ring can begin to move quickly in the direction of the city — that's the strategy the flatlanders usually follow when they besiege cities.The berlanders are sure that they can repel the enemy's attack if they learn the exact time the attack starts. For that they need to construct a radar that would register any movement at the distance of at most r from it. Thus, we can install a radar at such point, that at least one point of the enemy ring will be in its detecting range (that is, at a distance of at most r). Then the radar can immediately inform about the enemy's attack. Due to the newest technologies, we can place a radar at any point without any problems. But the problem is that the berlanders have the time to make only one radar. Besides, the larger the detection radius (r) is, the more the radar costs.That's why Vasya's task (that is, your task) is to find the minimum possible detection radius for the radar. In other words, your task is to find the minimum radius r (r ≥ 0) such, that a radar with radius r can be installed at some point and it can register the start of the movements of both flatland rings from that point. In this problem you can consider the cities as material points, the attacking enemy rings - as circles with centers in the cities, the radar's detection range — as a disk (including the border) with the center at the point where the radar is placed.

The input files consist of two lines. Each line represents the city and the flatland ring that surrounds it as three space-separated integers xi, yi, ri (|xi|, |yi| ≤ 104; 1 ≤ ri ≤ 104) — the city's coordinates and the distance from the city to the flatlanders, correspondingly. It is guaranteed that the cities are located at different points.

Print a single real number — the minimum detection radius of the described radar. The answer is considered correct if the absolute or relative error does not exceed 10 - 6.

NoteThe figure below shows the answer to the first sample. In this sample the best decision is to put the radar at point with coordinates (2, 0).   The figure below shows the answer for the second sample. In this sample the best decision is to put the radar at point with coordinates (0, 0).

{-
import HUnit

eps  =  1e-06

testZero  =  Test "TestZero" $
    assertApproximate 0.0 (solve (0,0,1) (2,0,1)) eps

testInput1  =  Test "TestInput1" $
    assertApproximate 1.0 (solve (0,0,1) (6,0,3)) eps

testInput2  =  Test "TestInput2" $
    assertApproximate 11.142135623730951 (solve (-10,10,3) (10,-10,3)) eps

testInside  =  Test "TestInside" $
    assertApproximate 1.0 (solve (0,0,1) (0,0,3)) eps

testIntersect  =  Test "TestIntersect" $
    assertApproximate 0.0 (solve (0,0,1) (0,1,1)) eps

test  =  mapM_ run
  [
    testZero,
    testInput1,
    testInput2,
    testInside,
    testIntersect
  ]
-}
--------------------------------------------------------------------------------

solve :: (Double, Double, Double) -> (Double, Double, Double) -> Double
solve (x1, y1, r1) (x2, y2, r2)
  | d > r1 + r2  =  0.5 * (d - (r1 + r2))
  | d < max r1 r2 - min r1 r2  =  0.5 * (max r1 r2 - d - min r1 r2)
  | otherwise  =  0
  where
    d  =  sqrt ((x2-x1) * (x2-x1) + (y2-y1) * (y2-y1))

main :: IO ()
main  =  do
    [[x1, y1, r1], [x2, y2, r2]]  <-  mapM (const (getLine >>= return . map read . words)) [1,2]
    print $ solve (x1,y1,r1) (x2,y2,r2)

import System.IO
import Text.Printf
data Point = Point Double Double deriving (Show)
data Circle = Circle Point Double deriving (Show)

distance :: Point -> Point -> Double
distance ( Point x1 y1 ) (Point x2 y2) = sqrt $ (x1-x2)^2+(y1-y2)^2
r120d2b :: Circle -> Circle -> Double
r120d2b ( Circle ( Point x1 y1 ) r1 ) ( Circle ( Point x2 y2 ) r2)
        | d > rplusr = ( d - rplusr ) / 2
        | d < rminusr = ( abs(r2-r1) - d) / 2
        | otherwise = 0
        where rminusr = (max r2 r1) - ( min r2 r1)
              rplusr = r2 + r1
              d = distance (Point x1 y1 ) ( Point x2 y2)

makePoint :: Double -> Double -> Point
makePoint a b = (Point a b )
makeCircle :: Point -> Double -> Circle
makeCircle (Point a b ) c = (Circle (Point a b ) c )

rDouble :: String -> Double
rDouble = read

main = do
    line <- getLine
    let b = (map  rDouble ) ( words line)
    let c1 = makeCircle ( makePoint ( b !! 0 ) (b !! 1) ) ( b !! 2)
    line <- getLine
    let b = (map  rDouble ) ( words line)
    let c2 = makeCircle ( makePoint ( b !! 0 ) (b !! 1) ) ( b !! 2)
    printf "%0.8f\n" (r120d2b c1 c2 )

main = getContents >>= print.p. map (\x -> (map (\y -> read y :: Integer)).words $x).lines
	where
		p [[x1, y1, r1], [x2, y2, r2]]
		 | r1^2 < d && r2^2 < d && (r1 + r2)^2 >= d = 0
		 | (r1 + r2)^2 < d = (sqrt(fromIntegral d) - (fromIntegral r1) - (fromIntegral r2))/2.0
		 | (r1 + r2)^2 >= d && (r1 - r2)^2 <= d = 0
		 | True = (rr1 - dd - rr2)/2.0
		 | otherwise = error "out of bound"
		 where
		 	rr1 = fromIntegral $ max r1 r2
			rr2 = fromIntegral $ min r1 r2
			d = (x1 - x2)^2 + (y1 - y2)^2
			dd = sqrt $ fromIntegral d

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    (/ 2) . abs $ (dist p0 p1) - r0 - r1

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d > r0 + r1  = outside (p0, r0) (p1, r1)
    | d <= r0 + r1 && d + small >= big = 0
    | d + small < big = inside (p0, r0) (p1, r1)
    where
      small = min r0 r1
      big = max r0 r1
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

main = (print . solve . parse =<< getContents)

main = getContents >>= print.p. map (\x -> (map (\y -> read y :: Double)).words $x).lines
	where
		p [[x1, y1, r1], [x2, y2, r2]] = if (r1 + r2) ^ 2  >= (x1-x2)^2 + (y1-y2) ^2  then 0 else if r1 + r2 <= d then (d-r1-r2)/2 else 0
			where
				d = (sqrt $ ((x1 - x2)^2 + (y1 - y2)^2))

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    (/ 2) . abs $ (dist p0 p1) - r0 - r1

intersect (p0, r0) (p1, r1) =
    abs $ (r1 + r0 - (dist p0 p1)) / 2

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d > r0 + r1   = outside (p0, r0) (p1, r1)
    | d < max r0 r1 = inside (p0, r0) (p1, r1)
    | otherwise     = intersect (p0, r0) (p1, r1)
    where
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

main = (print . solve . parse =<< getContents)

inside (p0, r0) (p1, r1) =
    abs $ (big - d - small) / 2
    where
      big = max r1 r0
      small = min r1 r0
      d = dist p0 p1

outside (p0, r0) (p1, r1) =
    abs $ (dist p0 p1) - r0 - r1

intersect (p0, r0) (p1, r1) =
    abs $ (r1 + r0 - (dist p0 p1)) / 2

solve :: [[Double]] -> Double
solve [[x0, y0, r0], [x1, y1, r1]]
    | d < r0 + r1   = outside (p0, r0) (p1, r1)
    | d < max r0 r1 = inside (p0, r0) (p1, r1)
    | otherwise     = intersect (p0, r0) (p1, r1)
    where
      d = dist (x0, y0) (x1, y1)
      p0 = (x0, y0)
      p1 = (x1, y1)

dist (a, b) (c, d) = sqrt $ (a - c) ^ 2 + (b - d) ^ 2

parse :: String -> [[Double]]
parse = map ((map read) . words) . lines

main = (print . solve . parse =<< getContents)