Petya studies at university. The current academic year finishes with $$$n$$$ special days. Petya needs to pass $$$m$$$ exams in those special days. The special days in this problem are numbered from $$$1$$$ to $$$n$$$.There are three values about each exam:  $$$s_i$$$ — the day, when questions for the $$$i$$$-th exam will be published,  $$$d_i$$$ — the day of the $$$i$$$-th exam ($$$s_i < d_i$$$),  $$$c_i$$$ — number of days Petya needs to prepare for the $$$i$$$-th exam. For the $$$i$$$-th exam Petya should prepare in days between $$$s_i$$$ and $$$d_i-1$$$, inclusive. There are three types of activities for Petya in each day: to spend a day doing nothing (taking a rest), to spend a day passing exactly one exam or to spend a day preparing for exactly one exam. So he can't pass/prepare for multiple exams in a day. He can't mix his activities in a day. If he is preparing for the $$$i$$$-th exam in day $$$j$$$, then $$$s_i \le j < d_i$$$.It is allowed to have breaks in a preparation to an exam and to alternate preparations for different exams in consecutive days. So preparation for an exam is not required to be done in consecutive days.Find the schedule for Petya to prepare for all exams and pass them, or report that it is impossible.

The first line contains two integers $$$n$$$ and $$$m$$$ $$$(2 \le n \le 100, 1 \le m \le n)$$$ — the number of days and the number of exams. Each of the following $$$m$$$ lines contains three integers $$$s_i$$$, $$$d_i$$$, $$$c_i$$$ $$$(1 \le s_i < d_i \le n, 1 \le c_i \le n)$$$ — the day, when questions for the $$$i$$$-th exam will be given, the day of the $$$i$$$-th exam, number of days Petya needs to prepare for the $$$i$$$-th exam.  Guaranteed, that all the exams will be in different days. Questions for different exams can be given in the same day. It is possible that, in the day of some exam, the questions for other exams are given.

If Petya can not prepare and pass all the exams, print -1. In case of positive answer, print $$$n$$$ integers, where the $$$j$$$-th number is:   $$$(m + 1)$$$, if the $$$j$$$-th day is a day of some exam (recall that in each day no more than one exam is conducted),  zero, if in the $$$j$$$-th day Petya will have a rest,  $$$i$$$ ($$$1 \le i \le m$$$), if Petya will prepare for the $$$i$$$-th exam in the day $$$j$$$ (the total number of days Petya prepares for each exam should be strictly equal to the number of days needed to prepare for it).Assume that the exams are numbered in order of appearing in the input, starting from $$$1$$$.If there are multiple schedules, print any of them.

NoteIn the first example Petya can, for example, prepare for exam $$$1$$$ in the first day, prepare for exam $$$2$$$ in the second day, pass exam $$$1$$$ in the third day, relax in the fourth day, and pass exam $$$2$$$ in the fifth day. So, he can prepare and pass all exams.In the second example, there are three days and two exams. So, Petya can prepare in only one day (because in two other days he should pass exams). Then Petya can not prepare and pass all exams.

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntMap.Strict as M
import qualified Data.IntSet as S
import Data.List
import Data.Maybe
import Data.Ord

main = do
  inp <- fmap B.lines B.getContents
  let [n,m] = map readI $ B.words $ inp!!0
  let dss = map (map readI . B.words) $ tail inp
  putStrLn $ unwords $ map show $ solve n m dss

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

type Acc = M.IntMap (Either Int ())

solve :: Int -> Int -> [[Int]] -> [Int]
solve n m xss =
  if (-1)`elem`ans then [-1] else ans
  where
    ans :: [Int]
    ans = map fst $ tail $ scanl next (0,M.empty) [1..n]

    days :: S.IntSet
    days = S.fromList $ map (\[s,d,c]->d) xss

    prepares :: [(Int,[Int])]
    prepares = sortBy (comparing (\(_,[s,d,c])->d)) $ zip [1..] xss

    next :: (Int,Acc) -> Int -> (Int,Acc)
    next (_,acc) i
      | S.member i days = maybe (-1,acc) (either (const (-1,acc)) (const (m+1,acc))) (M.lookup i acc)
      | otherwise       = head $ mapMaybe (f (i,acc)) prepares ++ [(0,acc)]

    f :: (Int,Acc) -> (Int,[Int]) -> Maybe (Int,Acc)
    f (i,acc) (k,[s,d,c])
      | M.lookup d acc == Just (Right()) = Nothing
      | i < s                            = Nothing
      | otherwise                        = Just (k, M.insertWith (g c) d (if c==1 then Right () else Left 1) acc)

    g :: Int -> Either Int () -> Either Int () -> Either Int ()
    g c _ (Left y) | y+1>= c   = Right ()
                   |otherwise  = Left (y+1)
    g _ _ (Right _)            = Right ()

import qualified Data.ByteString.Lazy.Char8 as B
import Data.List
import Data.Ord

main = do
  inp <- fmap B.lines B.getContents
  let [n,m] = map readI $ B.words $ inp!!0
  let dss = map (map readI . B.words) $ tail inp
  putStrLn $ unwords $ map show $ solve n m dss

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

solve :: Int -> Int -> [[Int]] -> [Int]
solve n m xss =
  if (-1)`elem`ans then [-1] else ans
  where
    ans = tail $ map fst $ scanl g (0,([],es)) [1..n]

    ds = zip (map f0 xss) [1..]
    es = sortBy (comparing f1) (zip [1..] xss)

    f0 [s,d,c] = d
    f1 (i,[s,d,c]) = (s,d)

    g (_,(ok,[])) i
        |i`elem`map fst ds = (m+1,(ok,[]))
        | otherwise        = (0,(ok,[]))
    g (_,(ok,((k,[s,d,c]):ss))) i
        |i`elem`map fst ds = case lookup i ds of
                               Just j | j`elem`ok -> (m+1,(ok,((k,[s,d,c]):ss)))
                                      | otherwise -> (-1,([],[]))
        | i<s       = (0  ,((ok,(k,[s,d,c]):ss)))
        | c-1 > 0   = (k  ,((ok,(k,[s,d,c-1]):ss)))
        |otherwise  = (k  ,((k:ok),ss))

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.IntMap.Strict as M
import qualified Data.IntSet as S
import Data.List
import Data.Maybe
import Data.Ord

main = do
  inp <- fmap B.lines B.getContents
  let [n,m] = map readI $ B.words $ inp!!0
  let dss = map (map readI . B.words) $ tail inp
  putStrLn $ unwords $ map show $ solve n m dss

readI :: B.ByteString -> Int
readI s = case B.readInt s of Just (n,_) -> n

type Acc = M.IntMap (Either Int ())

solve :: Int -> Int -> [[Int]] -> [Int]
solve n m xss =
  ans --  if (-1)`elem`ans then [-1] else ans
  where
    ans :: [Int]
    ans = map fst $ tail $ scanl next (0,M.empty) [1..n]

    days :: S.IntSet
    days = S.fromList $ map (\[s,d,c]->d) xss

    prepares :: [(Int,[Int])]
    prepares = sortBy (comparing (\(_,[s,d,c])->d)) $ zip [1..] xss

    next :: (Int,Acc) -> Int -> (Int,Acc)
    next (_,acc) i
      | S.member i days = maybe (-1,acc) (either (const (-1,acc)) (const (m+1,acc))) (M.lookup i acc)
      | otherwise       = head $ mapMaybe (f (i,acc)) prepares ++ [(0,acc)]

    f :: (Int,Acc) -> (Int,[Int]) -> Maybe (Int,Acc)
    f (i,acc) (k,[s,d,c])
      | M.lookup d acc == Just (Right()) = Nothing
      | i < s                            = Nothing
      | otherwise                        = Just (k, M.insertWith (g c) d (if c==1 then Right () else Left 1) acc)

    g :: Int -> Either Int () -> Either Int () -> Either Int ()
    g c _ (Left y) | y+1>= c   = Right ()
                   |otherwise  = Left (y+1)
    g _ _ (Right _)            = Right ()


A famous Berland's painter Kalevitch likes to shock the public. One of his last obsessions is chess. For more than a thousand years people have been playing this old game on uninteresting, monotonous boards. Kalevitch decided to put an end to this tradition and to introduce a new attitude to chessboards.As before, the chessboard is a square-checkered board with the squares arranged in a 8 × 8 grid, each square is painted black or white. Kalevitch suggests that chessboards should be painted in the following manner: there should be chosen a horizontal or a vertical line of 8 squares (i.e. a row or a column), and painted black. Initially the whole chessboard is white, and it can be painted in the above described way one or more times. It is allowed to paint a square many times, but after the first time it does not change its colour any more and remains black. Kalevitch paints chessboards neatly, and it is impossible to judge by an individual square if it was painted with a vertical or a horizontal stroke.Kalevitch hopes that such chessboards will gain popularity, and he will be commissioned to paint chessboards, which will help him ensure a comfortable old age. The clients will inform him what chessboard they want to have, and the painter will paint a white chessboard meeting the client's requirements.It goes without saying that in such business one should economize on everything — for each commission he wants to know the minimum amount of strokes that he has to paint to fulfill the client's needs. You are asked to help Kalevitch with this task.

The input file contains 8 lines, each of the lines contains 8 characters. The given matrix describes the client's requirements, W character stands for a white square, and B character — for a square painted black. It is guaranteed that client's requirments can be fulfilled with a sequence of allowed strokes (vertical/column or horizontal/row).

Output the only number — the minimum amount of rows and columns that Kalevitch has to paint on the white chessboard to meet the client's requirements.

WWWBWWBW
BBBBBBBB
WWWBWWBW
WWWBWWBW
WWWBWWBW
WWWBWWBW
WWWBWWBW
WWWBWWBW

WWWWWWWW
BBBBBBBB
WWWWWWWW
WWWWWWWW
WWWWWWWW
WWWWWWWW
WWWWWWWW
WWWWWWWW

import List
main = do interact (show . gao . map (map (=='B')) . lines)
gao a = if b == 16 then 8 else b where
	b = f a + f (transpose a)
	f = length . filter id . map and

module Main where

import Data.List

ans 8 8 = 8
ans n m = n+m

solve :: [String] -> Int
solve board = ans (rows board) (rows (transpose board)) where
    rows brd = foldl isStroke 0 brd where
        isStroke cnt row
            | all (=='B') row = cnt+1
            | otherwise       = cnt

readBoard 0 = return []
readBoard n = do
    s <- getLine
    b <- readBoard (n-1)
    return (s:b)

main = do
    board <- readBoard 8
    print (solve board)

import Control.Monad

count :: [String] -> Int
count = snd . foldr step (False, 0)
  where
    step s (vCounted, n)
        | all (=='B') s = (vCounted, n + 1)
        | not vCounted = (True, n + length (filter (=='B') s))
        | otherwise = (vCounted, n)

main = do
    b <- replicateM 8 getLine
    print $ count b

import Data.Array
import Data.Bits

make2DArray :: [[a]] -> Array (Int, Int) a
make2DArray lst = let len1 = (length lst) - 1
                      len2 = (length $ lst !! 0) - 1
                  in  array ((0, 0), (len1, len2))
                    [ ((i, j), (lst !! i) !! j) | i <- [0..len1], j <- [0..len2] ]

popCount :: (Bits a, Num t) => a -> t
popCount x = popCount' x 0
  where
    popCount' 0 a = a
    popCount' x a = let b  = x .&. (-x)
                        xx = x `xor` b
                    in popCount' xx (a + 1)

bit2lst :: Bits a => a -> [Int]
bit2lst x = bit2lst' x 0 []
  where
    bit2lst' 0 i a = a
    bit2lst' x i a = let ii = shiftL 1 i
                     in if (x .&. ii) == 0
                        then bit2lst' x (i + 1) a
                        else bit2lst' (x `xor` ii) (i + 1) (i:a)

bitOf :: Bits a => a -> Int -> Bool
bitOf x i = (x .&. (shiftL 1 i)) /= 0

solve :: [String] -> Int
solve lst = let max = shiftL 1 8 :: Int
                can = [(i, j) | i <- [0..max-1], j <- [0..max-1]]
            in solve' can 16
              where
                arr = make2DArray lst

                solve' (x:xs) a = let xx = fst x
                                      yy = snd x
                                      ans = (popCount xx) + (popCount yy)
                                      d = [ if (bitOf xx i) || (bitOf yy j)
                                            then (arr ! (j, i)) == 'B'
                                            else (arr ! (j, i)) == 'W'
                                          | i <- [0..7], j <- [0..7] ]
                                  in if ans < a && foldl (&&) True d
                                     then solve' xs ans
                                     else solve' xs a
                solve'     [] a = a

main :: IO()
main = do cs <- getContents
          let ln = lines cs
          print $ solve ln

import Control.Monad (replicateM)
import List (transpose)

--------------------------------------------------------------------------------
{-
import HUnit

names :: [String]
names  =  ["Input 1", "Input 2", "WA", "Border", "Black"]

tests :: [[String]]
tests  =
  [
    [ "WWWBWWBW",
      "BBBBBBBB",
      "WWWBWWBW",
      "WWWBWWBW",
      "WWWBWWBW",
      "WWWBWWBW",
      "WWWBWWBW",
      "WWWBWWBW" ],
    [ "WWWWWWWW",
      "BBBBBBBB",
      "WWWWWWWW",
      "WWWWWWWW",
      "WWWWWWWW",
      "WWWWWWWW",
      "WWWWWWWW",
      "WWWWWWWW" ],
    [ "BBBBBBBB",
      "BBBBBBBB",
      "BWWWWWWW",
      "BWWWWWWW",
      "BWWWWWWW",
      "BWWWWWWW",
      "BWWWWWWW",
      "BWWWWWWW" ],
    [ "BBBBBBBB",
      "BWWWWWWB",
      "BWWWWWWB",
      "BWWWWWWB",
      "BWWWWWWB",
      "BWWWWWWB",
      "BWWWWWWB",
      "BBBBBBBB" ],
    [ "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB",
      "BBBBBBBB" ]
  ]

results  =  [3, 1, 3, 4, 8]

allTests :: Test
allTests  =  TestList "AllTests" $
    zipWith3 (\name lines ans -> Test name $ assertEq ans $ solve lines) names tests results

test :: IO ()
test  =  run allTests
-}
--------------------------------------------------------------------------------

size :: Int
size  =  8

solve :: [String] -> Int
solve lines
  | any (== size) [n, m]  =  min n m
  | otherwise  =  n + m
  where
    n  =  length $ filter (all (== 'B')) lines
    m  =  length $ filter (all (== 'B')) $ transpose lines

main :: IO ()
main  =  replicateM size getLine >>= print . solve

import Data.List

solve :: [String] -> Int
solve s = let
    f = length . filter ('W' `notElem`)
    total = f s + f (transpose s)
    in case total of
        16 -> 8
        n -> n

main = interact $ show . solve . lines

main = do
  l1 <- getLine
  l2 <- getLine
  l3 <- getLine
  l4 <- getLine
  l5 <- getLine
  l6 <- getLine
  l7 <- getLine
  l8 <- getLine
  print (solve l1 l2 l3 l4 l5 l6 l7 l8)

solve :: String -> String -> String -> String -> String -> String -> String -> String -> Int
solve l1 l2 l3 l4 l5 l6 l7 l8
  | b_in_row + b_in_col == 16 = 8
  | otherwise = b_in_row + b_in_col
  where b_in_col = sum [b_in l1, b_in l2, b_in l3, b_in l4, b_in l5, b_in l6, b_in l7, b_in l8]
        b_in l = if (l == "BBBBBBBB") then 1 else 0
        b_in_row = sum (map b_in_r [0..7])
        b_in_r n = if ( ((l1 !! n) == 'B') && ((l2 !! n) == 'B') && ((l3 !! n) == 'B') && ((l4 !! n) == 'B') && ((l5 !! n) == 'B') && ((l6 !! n) == 'B') && ((l7 !! n) == 'B') && ((l8 !! n) == 'B') ) then 1 else 0

import Data.List

main :: IO()
main = do interact (show . gao . lines)

gao :: [String] -> Int
gao s
    | n == 64 = 8
    | otherwise = f s + f (transpose s)
        where
            n = length $ filter (\x -> x == 'B') $ unlines s
            f s = length $ filter (\x -> 'W' `notElem` x) s

import Data.List

main :: IO()
main = do interact (show . gao . lines)

gao :: [String] -> Int
gao s
    | n == 64 = 8
    | otherwise = f s + f (transpose s)
        where
            n = length $ filter (== 'B') $ unlines s
            f = length . filter ('W' `notElem`)

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

solve :: [String] -> [String]
solve = fmap return $ do
  xs <- take 8
  return . show $ case partition (all (== 'B')) xs of
    (_ , []   ) -> 8
    (as, b : _) -> length as + length (filter (== 'B') b)

main = interact $ unlines . solve . lines

module Main where

import Data.List (transpose)

main :: IO ()
main = interact $ show . solve . lines

solve :: [String] -> Int
solve board = if total == 16 then 8 else total
  where
    total = count board + count (transpose board)
    count = length . filter (all ('B' ==))

import Control.Monad
import Data.List

qq=sequence(replicate 8 [True,False])

pl True _ = replicate 8 'B'
pl False l = l

paint = zipWith pl

s l=minimum$ do
   vs <- qq
   hs <- qq
   guard $ l == (paint vs $ transpose(paint hs (replicate 8 (replicate 8 'W'))))
   return (length $ filter id (vs ++ hs))

main=interact$show.s.lines

import Data.List

parse = lines

solve ::[[Char]] -> Int
solve l =
  let
    res = (calc l) + (calc $ transpose l)
    calc = length . filter id . map (all (== 'B'))
  in
    if res == 16
    then 8
    else res

present = show

main = interact $ present . solve . parse

import Data.Array
import Data.Bits

make2DArray :: [[a]] -> Array (Int, Int) a
make2DArray lst = let len1 = (length lst) - 1
                      len2 = (length $ lst !! 0) - 1
                  in  array ((0, 0), (len1, len2))
                    [ ((i, j), (lst !! i) !! j) | i <- [0..len1], j <- [0..len2] ]

popCount :: (Bits a, Num t) => a -> t
popCount x = popCount' x 0
  where
    popCount' 0 a = a
    popCount' x a = let b  = x .&. (-x)
                        xx = x `xor` b
                    in popCount' xx (a + 1)

bit2lst :: Bits a => a -> [Int]
bit2lst x = bit2lst' x 0 []
  where
    bit2lst' 0 i a = a
    bit2lst' x i a = let ii = shiftL 1 i
                     in if (x .&. ii) == 0
                        then bit2lst' x (i + 1) a
                        else bit2lst' (x `xor` ii) (i + 1) (i:a)

bitOf :: Bits a => a -> Int -> Bool
bitOf x i = (x .&. (shiftL 1 i)) /= 0

solve :: [String] -> Int
solve lst = let max = shiftL 1 8 :: Int
                can = [(i, j) | i <- [0..max-1], j <- [0..max-1]]
            in solve' can 16
              where
                arr = make2DArray lst

                solve' (x:xs) a = let xx = fst x
                                      yy = snd x
                                      ans = (popCount xx) + (popCount yy)
                                      d = [ if (bitOf xx i) || (bitOf yy j)
                                            then 'W'
                                            else arr ! (j, i)
                                          | i <- [0..7], j <- [0..7] ]
                                  in if ans < a && (not $ elem 'B' d)
                                     then solve' xs ans
                                     else solve' xs a
                solve'     [] a = a

main :: IO()
main = do cs <- getContents
          let ln = lines cs
          print $ solve ln

main = do
  l1 <- getLine
  l2 <- getLine
  l3 <- getLine
  l4 <- getLine
  l5 <- getLine
  l6 <- getLine
  l7 <- getLine
  l8 <- getLine
  print (solve l1 l2 l3 l4 l5 l6 l7 l8)

solve :: String -> String -> String -> String -> String -> String -> String -> String -> Int
solve l1 l2 l3 l4 l5 l6 l7 l8
  | b_in_l1 == 8 = 8
  | otherwise = b_in_l1 + b_in_col
  where b_in_l1 = length (filter (== 'B') l1)
        b_in_col = sum [b_in l1, b_in l2, b_in l3, b_in l4, b_in l5, b_in l6, b_in l7, b_in l8]
        b_in l = if (l == "BBBBBBBB") then 1 else 0

import Control.Monad
import Data.List

qq=sequence(replicate 8 [True,False])

good (str, True) = all (=='B') str
good _ = True

w :: [String] -> [Bool] -> [Int]
w l f | all good z = [length (filter snd z) + length (filter (any (=='B')) $ transpose $ map fst $ filter (not . snd) z)]
    | otherwise = []
 where
  z = zip l f

s l=minimum$qq>>=w l

main=interact$show.s.lines


Karen is getting ready for a new school day!  It is currently hh:mm, given in a 24-hour format. As you know, Karen loves palindromes, and she believes that it is good luck to wake up when the time is a palindrome.What is the minimum number of minutes she should sleep, such that, when she wakes up, the time is a palindrome?Remember that a palindrome is a string that reads the same forwards and backwards. For instance, 05:39 is not a palindrome, because 05:39 backwards is 93:50. On the other hand, 05:50 is a palindrome, because 05:50 backwards is 05:50.

The first and only line of input contains a single string in the format hh:mm (00 ≤  hh  ≤ 23, 00 ≤  mm  ≤ 59).

Output a single integer on a line by itself, the minimum number of minutes she should sleep, such that, when she wakes up, the time is a palindrome.

NoteIn the first test case, the minimum number of minutes Karen should sleep for is 11. She can wake up at 05:50, when the time is a palindrome.In the second test case, Karen can wake up immediately, as the current time, 13:31, is already a palindrome.In the third test case, the minimum number of minutes Karen should sleep for is 1 minute. She can wake up at 00:00, when the time is a palindrome.

module Main where
import qualified Data.ByteString.Char8 as B
import Text.Printf
import Control.Applicative

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

t2s t = B.pack $ printf "%02d:%02d" h m
  where
    (h, m) = (t `rem` 1440) `quotRem` 60

s2t s = h * 60 + m
  where
    (h:m:_) = map readInt $ B.split ':' s

solve s = length $ takeWhile ((/=) <*> B.reverse) $ map t2s [(s2t s)..]

main = B.getLine >>= print . solve . B.filter (/= '\r')

import Data.Char

main = do
  [a, b, c, d, e] <- getLine
  print $ solve [n a, n b, n d, n e]
      where
        n x = ord x - ord '0'

--solve :: [Int] -> Int
solve a = fst . head . dropWhile (not . isPal . snd) $ zip [0..] (iterate increment a)
    where
      increment [2, 3, 5, 9] = [0, 0, 0, 0]
      increment [h, 9, 5, 9] = [h+1, 0, 0, 0]
      increment [h, h', 5, 9] = [h, h'+1, 0, 0]
      increment [h, h', m, 9] = [h, h', m+1, 0]
      increment [h, h', m, m'] = [h, h', m, m' + 1]
      isPal a = a == reverse a

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

main = print . solve =<< getLine

ispari v = s == r where
    s = tail $ show v
    r = reverse s

inc v = v2 where
    h = mod (div v 100) 100
    m = mod v 100
    (h2, m2) = if m == 59 then (h+1, 0) else (h, m+1)
    v2 = (if h2 > 23 then 0 else h2) * 100 + m2 + 10000

calc v
    | ispari v  = 0
    | otherwise = 1 + calc (inc v)

solve s = calc val where
    hs = read $ take 2 s
    ms = read $ drop 3 s
    val = hs * 100 + ms + 10000

padZero s
	|length s ==1 = '0':s
	|otherwise =s
createS h m = padZero(show h)++padZero(show m)
isPal s = s== reverse s
allS=([createS h m|h<-[0..23],m<-[0..59]]) ++["0000"]

firstPas (h,m) = length $ takeWhile (\x->not (isPal x)) $ dropWhile (/=(createS h m)) allS

parse x=(read (take 2 x)::Int,read (drop 3 x)::Int)
main=do
	time<-getLine
	print $ (firstPas.parse) time

main=getLine>>=print.f
f[h1,h2,_,m1,m2] = length.takeWhile (not.isPalindrome.show) $ iterate suc (T h m)
  where
    h, m :: Int
    h = read[h1, h2]
    m = read[m1, m2]

isPalindrome xs = xs == reverse xs

data T = T Int Int

instance Show T where
    show (T h m) = hh ++ mm
      where
        hh | h <= 9 = "0" ++ show h
           | otherwise = show h
        mm | m <= 9 = "0" ++ show m
           | otherwise = show m

suc (T 23 59) = T 0 0
suc (T h 59) = T (h + 1) 0
suc (T h m) = T h (m + 1)

main = do
    tstr_ <- getLine
    let
	[t1,t2,':',m1,m2] = tstr_

	check tt mm = let
			    tstr = if tt<10
				    then '0':(show tt)
				    else show tt
			    mstr = if mm<10
				    then '0':(show mm)
				    else show mm

			    str = tstr++mstr
			in
			    str == reverse str

	succeed v tt mm
	  | check tt mm = v
	  | otherwise	= let
				(hplus,mm') = (mm+1) `quotRem` 60
				tt' = (tt+hplus) `rem` 24
			    in
				succeed (v+1) tt' mm'

    print $ succeed 0 (read $ [t1,t2]) (read $ [m1,m2])

import Data.Char

main = do
  [a, b, c, d, e] <- getLine
  print $ solve [n a, n b, n d, n e]
      where
        n x = ord x - ord '0'

--solve :: [Int] -> Int
solve a = fst . head . dropWhile (not . isPal . snd) $ zip [0..] (iterate increment a)
    where
      increment [h, 9, 5, 9] = [h+1, 0, 0, 0]
      increment [h, h', 5, 9] = [h, h'+1, 0, 0]
      increment [h, h', m, 9] = [h, h', m+1, 0]
      increment [h, h', m, m'] = [h, h', m, m' + 1]
      isPal a = a == reverse a

main=getLine>>=print.f
f[h1,h2,_,m1,m2]
  | m <= m' = m' - m
  | h == 0 = 60 - m + 10
  | h == 23 = 60 - m
  | otherwise = 60 + m' - m
  where
    h, m :: Int
    h = read[h1, h2]
    m = read[m1, m2]
    m' = read[h2, h1]

main=getLine>>=print.f
f[h1,h2,_,m1,m2]
  | m <= m' = m' - m
  | h == 23 = 60 - m
  | otherwise = 60 + m' - m
  where
    h, m :: Int
    h = read[h1, h2]
    m = read[m1, m2]
    m' = read[h2, h1]


A permutation p of size n is an array such that every integer from 1 to n occurs exactly once in this array.Let's call a permutation an almost identity permutation iff there exist at least n - k indices i (1 ≤ i ≤ n) such that pi = i.Your task is to count the number of almost identity permutations for given numbers n and k.

The first line contains two integers n and k (4 ≤ n ≤ 1000, 1 ≤ k ≤ 4).

Print the number of almost identity permutations for given n and k.

module Main where
import Data.Int

main = getLine >>= print . exec
exec = solve . map read . words
solve [n, k] = sum $ take (fromIntegral k + 1) $  zipWith (*) zs cs
  where
  zs = scanl (\s (i, d) -> i * s + d) 1 $ zip [1..n] (cycle [-1, 1]) :: [Int64]
  cs = [1, n, (n - 1) * n `quot` 2, (n - 2) * (n - 1) * n `quot` 6, (n - 3) * (n - 2) * (n - 1) * n `quot` 24]

module Main where
import Data.Int

main = getLine >>= print . exec
exec = solve . map read . words
solve [n, k] = sum $ take (fromIntegral k + 1) $  zipWith (*) zs cs
  where
  zs = [1, 0, 1, 2, 9, 44]
  cs = [1, n, (n - 1) * n `quot` 2, (n - 2) * (n - 1) * n `quot` 6, (n - 3) * (n - 2) * (n - 1) * n `quot` 24]

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

choose :: Integer -> Integer -> Integer
choose n 0 = 1
choose 0 k = 0
choose n k = choose (n - 1) (k - 1) * n `div` k

solve :: [Integer] -> Integer
solve [n, k] = 1 + solve' 2 [1, 2, 9]
    where solve' :: Integer -> [Integer] -> Integer
          solve' i [] = 0
          solve' i (c:cx) | i > k = 0
                          | otherwise = (choose n i) * c + solve' (i + 1) cx

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

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

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

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

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

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

  doOut :: Integer -> Integer -> Integer
  doOut n 1 = 1
  doOut n 2
    | n == 1 = 1
    | n == 2 = 2
    | otherwise =  (doOut (n - 1) 2) + (n - 1)
  doOut n 3
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | otherwise = (doOut (n - 1) 3) + (n - 1) * (n - 1)
  doOut n 4
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | n == 4 = 24
    | otherwise =
      let prev = doOut (n - 1) 4
          q = (n - 1) * (n -1) * (n - 1)
          t = sum [1..(n - 2)]
          m = n - 7
          in prev + q + (t * m)

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . (map readInteger) . words
    print $ doOut n k

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

choose :: Int -> Int -> Int
choose n 0 = 1
choose 0 k = 0
choose n k = choose (n - 1) (k - 1) * n `div` k

solve :: [Int] -> Int
solve [n, k] = 1 + solve' 2 [1, 2, 9]
    where solve' :: Int -> [Int] -> Int
          solve' i [] = 0
          solve' i (c:cx) | i > k = 0
                          | otherwise = (choose n i) * c + solve' (i + 1) cx

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

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

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

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

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

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

  doOut :: Int -> Int -> Int
  doOut n 1 = 1
  doOut n 2
    | n == 1 = 1
    | n == 2 = 2
    | otherwise = (doOut (n - 1) 2) + (n - 1)
  doOut n 3
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | otherwise = (doOut (n - 1) 3) + (n - 1) * (n - 1)
  doOut n 4
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | n == 4 = 24
    | otherwise =
      let prev = doOut (n - 1) 4
          q = (n - 1) * (n -1) * (n - 1)
          t = sum [1..(n - 2)]
          m = n - 7
          in prev + q + (t * m)

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . (map readInt) . words
    print $ doOut n k

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

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

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

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

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

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

  doOut :: Int -> Int -> Int
  doOut n 1 = n
  doOut n 2 = (doOut (n - 1) 2) + (n - 1)
  doOut n 3
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | otherwise = (doOut (n - 1) 3) + (n - 1) * (n - 1)
  doOut n 4
    | n == 1 = 1
    | n == 2 = 2
    | n == 3 = 6
    | n == 4 = 24
    | otherwise =
      let prev = doOut (n - 1) 4
          q = (n - 1) * (n -1) * (n - 1)
          t = sum [1..(n - 2)]
          m = n - 7
          in prev + q + (t * m)

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . (map readInt) . words
    print $ doOut n k


A string $$$s$$$ of length $$$n$$$ can be encrypted by the following algorithm:  iterate over all divisors of $$$n$$$ in decreasing order (i.e. from $$$n$$$ to $$$1$$$),  for each divisor $$$d$$$, reverse the substring $$$s[1 \dots d]$$$ (i.e. the substring which starts at position $$$1$$$ and ends at position $$$d$$$). For example, the above algorithm applied to the string $$$s$$$="codeforces" leads to the following changes: "codeforces" $$$\to$$$ "secrofedoc" $$$\to$$$ "orcesfedoc" $$$\to$$$ "rocesfedoc" $$$\to$$$ "rocesfedoc" (obviously, the last reverse operation doesn't change the string because $$$d=1$$$).You are given the encrypted string $$$t$$$. Your task is to decrypt this string, i.e., to find a string $$$s$$$ such that the above algorithm results in string $$$t$$$. It can be proven that this string $$$s$$$ always exists and is unique.

The first line of input consists of a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — the length of the string $$$t$$$. The second line of input consists of the string $$$t$$$. The length of $$$t$$$ is $$$n$$$, and it consists only of lowercase Latin letters.

Print a string $$$s$$$ such that the above algorithm results in $$$t$$$.

NoteThe first example is described in the problem statement.

main = do
    n <- read `fmap` getLine :: IO Int
    s <- getLine
    let divs = [d | d <- [2..n], n `mod` d == 0]
    putStrLn $ foldl f s divs

f :: String -> Int -> String
f s d = (reverse (take d s)) ++ (drop d s)

import Data.List

f::Int->Int->[Int]->[Int]
f n m ans
   |m==1 =ans
   |n `mod` m==0=let t1=reverse (take m ans)
                     t2=(drop m ans)
                 in f n (m - 1) (t1++t2)
   |otherwise=f n (m-1) ans

main = do
       e1<-getLine
       e2<-getLine
       let m=read e1::Int
       putStrLn $ map snd $ sort $zip (f m m [0..(m-1)]) e2

divisors :: Int -> [Int]
divisors n = [x | x <- [1..n], n `mod` x == 0]

cypher :: Int -> [a] -> [a]
cypher n lst = cypher' (divisors n) lst
  where cypher' []     lst' = lst'
        cypher' (x:xs) lst' = cypher' xs $ reverse (take x lst') ++ (drop x lst')

restore_map :: String -> [Int] -> String
restore_map s [] = []
restore_map s (x: xs) = (s !! x: restore_map s xs)

solve :: String -> String
solve s = restore_map s $ cypher n [0..n-1]
  where n = length s

main :: IO()
main = do
  _ <- getLine
  l <- getLine
  putStrLn $ solve l

import Data.List

f::Int->Int->[Int]->[Int]
f n m ans
   |m==1 =ans
   |otherwise=let t1=reverse (take m ans)
                  t2=(drop m ans)
              in f n (m `div` 2) (t1++t2)

main = do
       e1<-getLine
       e2<-getLine
       let m=read e1::Int
       putStrLn $ map snd $ sort $zip (f m m [0..(m-1)]) e2


Alice and Bob play 5-in-a-row game. They have a playing field of size 10 × 10. In turns they put either crosses or noughts, one at a time. Alice puts crosses and Bob puts noughts.In current match they have made some turns and now it's Alice's turn. She wonders if she can put cross in such empty cell that she wins immediately.Alice wins if some crosses in the field form line of length not smaller than 5. This line can be horizontal, vertical and diagonal.

You are given matrix 10 × 10 (10 lines of 10 characters each) with capital Latin letters 'X' being a cross, letters 'O' being a nought and '.' being an empty cell. The number of 'X' cells is equal to the number of 'O' cells and there is at least one of each type. There is at least one empty cell. It is guaranteed that in the current arrangement nobody has still won.

Print 'YES' if it's possible for Alice to win in one turn by putting cross in some empty cell. Otherwise print 'NO'.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Control.Monad
import Data.List

main = do
  g <- replicateM 10 getLine
  putStr $ if solve g then "YES" else "NO"

solve g = ok g || ok (transpose g) || ok (diags g) || ok (diags $ reverse g)
  where ok = any (any (\w -> notElem 'O' w && (length (filter (== 'X') w) >= 4)) . windows 5)

diags = tail . go []
  where
    go p r = map head p : case r of
      [] -> transpose ts
      (r:rs) -> go (r:ts) rs
      where ts = map tail p

windows n xs = zipWith const (map (take n) $ tails xs) (drop (n - 1) xs)

import Data.List
import Control.Applicative

data Cell = Cross | Nought | Empty
    deriving (Show, Eq)

parseCell :: Char -> Cell
parseCell 'X' = Cross
parseCell 'O' = Nought
parseCell '.' = Empty

type Field = [[Cell]]

parseField :: String -> Field
parseField = (map (\x -> map parseCell x)) . lines

getDiagonals' :: Field -> [[Cell]]
getDiagonals' field =
    map (map head) . (takeWhile (not . null)) . (iterate (filter (not . null) . map tail)) . map (\(row, i) -> drop i row) $ zip field [0..]

getDiagonals :: Field -> [[Cell]]
getDiagonals field =
    concat . map getDiagonals' $ ([id, transpose] <*> [field, map reverse field])

getLines :: Field -> [[Cell]]
getLines field = concat [field, transpose field, getDiagonals field]

winCriteria = foldl1' (\f g -> \x -> (f x) || (g x)) $ map isInfixOf [
    [Cross, Cross, Cross, Cross, Cross],
    [Empty, Cross, Cross, Cross, Cross],
    [Cross, Empty, Cross, Cross, Cross],
    [Cross, Cross, Empty, Cross, Cross],
    [Cross, Cross, Cross, Empty, Cross],
    [Cross, Cross, Cross, Cross, Empty]]

isPotentialWin :: Field -> Bool
isPotentialWin field = any winCriteria (getLines field)

bool2YesNo :: Bool -> String
bool2YesNo b = if b then "YES" else "NO"

main = interact (bool2YesNo . isPotentialWin . parseField)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.List

main = do
  g <- replicateM 10 getLine
  putStr $ if solve g then "YES" else "NO"

solve :: [String] ->  Bool
solve g = ok g || ok (transpose g) || ok (diags g) || ok (diags $ reverse g)
  where ok = any (any (\c -> notElem 'O' c && ((>= 4) $ length $ filter (== 'X') c)) . chunks 5)

diags = tail . go []
  where
    go b ess = map head b : case ess of
      [] -> transpose ts
      (e:es) -> go (e:ts) es
      where ts = map tail b

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

chunks :: Int -> [a] -> [[a]]
chunks _ [] = []
chunks n xs =
    let (ys, zs) = splitAt n xs
    in  ys : chunks n zs

{-
neg R
pos M
-}

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Control.Monad
import Data.List

main = do
  g <- replicateM 10 getLine
  putStr $ if solve g then "YES" else "NO"

solve g = ok g || ok (transpose g) || ok (diags g) || ok (diags $ reverse g)
  where ok = any (any ((>= 4) . length . filter (== 'X') . map (\k -> if k == '.' then 'X' else k)) . windows 5)

diags = tail . go []
  where
    go p r = map head p : case r of
      [] -> transpose ts
      (r:rs) -> go (r:ts) rs
      where ts = map tail p

windows n xs = zipWith const (map (take n) $ tails xs) (drop (n - 1) xs)


Limak is a little polar bear. Polar bears hate long strings and thus they like to compress them. You should also know that Limak is so young that he knows only first six letters of the English alphabet: 'a', 'b', 'c', 'd', 'e' and 'f'.You are given a set of q possible operations. Limak can perform them in any order, any operation may be applied any number of times. The i-th operation is described by a string ai of length two and a string bi of length one. No two of q possible operations have the same string ai.When Limak has a string s he can perform the i-th operation on s if the first two letters of s match a two-letter string ai. Performing the i-th operation removes first two letters of s and inserts there a string bi. See the notes section for further clarification.You may note that performing an operation decreases the length of a string s exactly by 1. Also, for some sets of operations there may be a string that cannot be compressed any further, because the first two letters don't match any ai.Limak wants to start with a string of length n and perform n - 1 operations to finally get a one-letter string "a". In how many ways can he choose the starting string to be able to get "a"? Remember that Limak can use only letters he knows.

The first line contains two integers n and q (2 ≤ n ≤ 6, 1 ≤ q ≤ 36) — the length of the initial string and the number of available operations. The next q lines describe the possible operations. The i-th of them contains two strings ai and bi (|ai| = 2, |bi| = 1). It's guaranteed that ai ≠ aj for i ≠ j and that all ai and bi consist of only first six lowercase English letters.

Print the number of strings of length n that Limak will be able to transform to string "a" by applying only operations given in the input.

2 8
af e
dc d
cc f
bc b
da b
eb a
bb b
ff c

NoteIn the first sample, we count initial strings of length 3 from which Limak can get a required string "a". There are 4 such strings: "abb", "cab", "cca", "eea". The first one Limak can compress using operation 1 two times (changing "ab" to a single "a"). The first operation would change "abb" to "ab" and the second operation would change "ab" to "a".Other three strings may be compressed as follows:   "cab"  "ab"  "a"  "cca"  "ca"  "a"  "eea"  "ca"  "a" In the second sample, the only correct initial string is "eb" because it can be immediately compressed to "a".

{-
instructions go here...
-}

module Main where
import Data.Array ((!), listArray, range)

getLines :: Int -> IO [String]
getLines n = sequence $ replicate n getLine

solve :: Int -> [(String, Char)] -> Integer
solve n qs = sum [arr ! (c,n) | c <- ['a'..'f']]
  where arr = listArray arrBounds [dp c l | (c,l) <- range arrBounds]
        arrBounds = (('a',1), ('f',n))
        dp :: Char -> Int -> Integer
        dp 'a' 1 = 1
        dp _ 1 = 0
        dp fstChr len = sum [toInteger (length $ viableExpansions fstChr reduceTo qs)
                            * (arr ! (reduceTo, len - 1))
                            | reduceTo <- "abcdef"]

viableExpansions :: Char -> Char -> [(String, Char)] -> [(String, Char)]
viableExpansions lp r = filter (\(lp':_, r') -> lp == lp' && r == r')

main :: IO ()
main = do
  line1 <- getLine
  let [n,q] = map read (words line1) :: [Int]
  qLines <- getLines q
  let qs = map ((\[a,b] -> (a, head b)) . words) qLines :: [(String, Char)]
  putStrLn $ show $ solve n qs


A group of university students wants to get to the top of a mountain to have a picnic there. For that they decided to use a cableway.A cableway is represented by some cablecars, hanged onto some cable stations by a cable. A cable is scrolled cyclically between the first and the last cable stations (the first of them is located at the bottom of the mountain and the last one is located at the top). As the cable moves, the cablecar attached to it move as well.The number of cablecars is divisible by three and they are painted three colors: red, green and blue, in such manner that after each red cablecar goes a green one, after each green cablecar goes a blue one and after each blue cablecar goes a red one. Each cablecar can transport no more than two people, the cablecars arrive with the periodicity of one minute (i. e. every minute) and it takes exactly 30 minutes for a cablecar to get to the top.All students are divided into three groups: r of them like to ascend only in the red cablecars, g of them prefer only the green ones and b of them prefer only the blue ones. A student never gets on a cablecar painted a color that he doesn't like,The first cablecar to arrive (at the moment of time 0) is painted red. Determine the least time it will take all students to ascend to the mountain top.

The first line contains three integers r, g and b (0 ≤ r, g, b ≤ 100). It is guaranteed that r + g + b > 0, it means that the group consists of at least one student.

Print a single number — the minimal time the students need for the whole group to ascend to the top of the mountain.

NoteLet's analyze the first sample.At the moment of time 0 a red cablecar comes and one student from the r group get on it and ascends to the top at the moment of time 30.At the moment of time 1 a green cablecar arrives and two students from the g group get on it; they get to the top at the moment of time 31.At the moment of time 2 comes the blue cablecar and two students from the b group get on it. They ascend to the top at the moment of time 32.At the moment of time 3 a red cablecar arrives but the only student who is left doesn't like red and the cablecar leaves empty.At the moment of time 4 a green cablecar arrives and one student from the g group gets on it. He ascends to top at the moment of time 34.Thus, all the students are on the top, overall the ascension took exactly 34 minutes.

module Main where

import Control.Monad

nCar n = (n+1) `div` 2
timeCar n = nCar n * 3 - 3

main = do
    [a, b, c] <- ( map read . words ) `liftM` getLine

    putStrLn $ show $ 30 + max (timeCar a) (max (1 + timeCar b) (2 + timeCar c))

main = interact $ show . maximum . zipWith (+) [30,31..] . map (\x -> 3 * ((x - 1) `div` 2)) . map read . words

main = interact $ unlines . map (\s -> show . solve $ map read $ words s) . lines

solve :: [Int] -> Int
solve xs = maximum $ zipWith (+) [30,31..] $ map (\x -> 3 * ((x - 1) `div` 2)) xs

main = interact $ unlines . map (\s -> solve $ map read $ words s) . lines

solve :: [Int] -> String
solve [r, g, b] = show $ maximum [30 + 3 * ((r - 1) `div` 2), 31 + 3 * ((g - 1) `div` 2), 32 + 3 * ((b - 1) `div` 2)]

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

solve xs = maximum $ zipWith (+) [30,31..] $ map (\x -> 3 * ((x - 1) `div` 2)) xs

main = do
    a <- (map( (`div`2) . succ  . read :: String -> Int ).words <$> getLine)
    print $ 30 + (maximum $ zipWith (\x y -> x + (y-1) * 3) [0..2] a)

data Students = Red Int | Green Int | Blue Int

timeUp = 30
period = 3

time :: Students -> Int
time (Red   0)  =  0
time (Green 0)  =  0
time (Blue  0)  =  0
time (Red   n)  =  timeUp + (div n 2 + mod n 2 - 1) * period
time (Green n)  =  timeUp + (div n 2 + mod n 2 - 1) * period + 1
time (Blue  n)  =  timeUp + (div n 2 + mod n 2 - 1) * period + 2

main = do
  line <- getLine
  let [r, g, b] = map read $ words line
  let students = [Red r, Green g, Blue b]
  print $ maximum (map time students)

main = interact $ show.maximum.zipWith (+) [0, 1, 2].map (\x -> 3 * (x `div` 2 + x `mod` 2 - 1) + 30).map read.words

main = interact $ show.maximum.zipWith (+) [0, 1, 2].map f.map read.words
  where f x = 3 * (x `div` 2 + x `mod` 2 - 1) + 30

import Control.Applicative
import Control.Monad

data Colour = Red | Green | Blue
  deriving (Eq)
cars = zip [30..] (repeat [Red, Green, Blue])

f xs@[nr, ng, nb] (n,c) | sum xs == 0 = n - 1
                        | c == Red = f [if nr - 2 > 0 then nr - 2 else 0, ng, nb] (n+1, Green)
                        | c == Green = f [nr, if ng - 2 > 0 then ng - 2 else 0, nb] (n+1, Blue)
                        | c == Blue  = f [nr, ng, if nb - 2 > 0 then nb - 2 else 0] (n+1, Red)

main = do
   xs <- map read . words <$> getLine :: IO [Int]
   let ans = f xs (30, Red)
   print ans


Carl is a beginner magician. He has a blue, b violet and c orange magic spheres. In one move he can transform two spheres of the same color into one sphere of any other color. To make a spell that has never been seen before, he needs at least x blue, y violet and z orange spheres. Can he get them (possible, in multiple actions)?

The first line of the input contains three integers a, b and c (0 ≤ a, b, c ≤ 1 000 000) — the number of blue, violet and orange spheres that are in the magician's disposal. The second line of the input contains three integers, x, y and z (0 ≤ x, y, z ≤ 1 000 000) — the number of blue, violet and orange spheres that he needs to get.

If the wizard is able to obtain the required numbers of spheres, print "Yes". Otherwise, print "No".

NoteIn the first sample the wizard has 4 blue and 4 violet spheres. In his first action he can turn two blue spheres into one violet one. After that he will have 2 blue and 5 violet spheres. Then he turns 4 violet spheres into 2 orange spheres and he ends up with 2 blue, 1 violet and 2 orange spheres, which is exactly what he needs.

import Numeric

readStuff :: IO [Int]
readStuff = do
	line <- getLine
	return $ map (read::String -> Int) (words line)

leftover :: Int -> Int -> Int
leftover a x
	| a < x = 0
	| otherwise = div (a-x) 2

need :: Int -> Int -> Int
need a x
	| a > x = 0
	| otherwise = x - a

solve :: Int -> Int -> Int -> Int -> Int -> Int -> String
solve a b c x y z = if r >= n then "Yes" else "No"
	where r = leftover a x + leftover b y + leftover c z
	      n = need a x + need b y + need c z

main :: IO ()
main = do
	[a, b ,c] <- readStuff
	[x, y ,z] <- readStuff
	putStrLn $ solve a b c x y z

import qualified Data.ByteString.Char8 as S

-- Alias things
type ByteString = S.ByteString
pack = S.pack
unpack = S.unpack

-- Reads a list of tokens from a ByteString, split by space or new line.
getTokens :: ByteString -> [ByteString]
getTokens contents = S.splitWith (\c -> c == '\n' || c == ' ') contents

-- Main
main = S.interact handleInput

-- Input
handleInput :: ByteString -> ByteString
handleInput input =
  let tokens = take 6 $ getTokens input
      (a:b:c:x:y:z:_) = map read $ map unpack tokens
      solution = solveIt (a, b, c) (x, y, z)
      output = formatOutput solution
  in output

-- Output
formatOutput :: Bool -> ByteString
formatOutput s
  | s = pack "Yes"
  | otherwise = pack "No"

-- Solution
solveIt :: (Int, Int, Int) -> (Int, Int, Int) -> Bool
solveIt (a, b, c) (x, y, z)
  | canMake >= need = True
  | otherwise = False
  where
    fCanMake = (\have need -> if have > need then floor $ (realToFrac (have - need)) / 2 else 0)
    canMake = (fCanMake a x) + (fCanMake b y) + (fCanMake c z)
    fNeed = (\have need -> if have >= need then 0 else need - have)
    need = (fNeed a x) + (fNeed b y) + (fNeed c z)

import qualified Data.ByteString.Char8 as BS

type ByteString = BS.ByteString
main = BS.interact $ printIt . solveIt . parseIt

-- Input/Output Types
type Input = ((Int, Int, Int), (Int, Int, Int))
type Output = Bool

-- Parse the input
parseIt :: ByteString -> Input
parseIt input =
  let tokens = BS.words input
      (a:b:c:x:y:z:_) = map read $ map BS.unpack tokens
  in ((a, b, c), (x, y, z))

-- Print the solution
printIt :: Output -> ByteString
printIt solution
  | solution = BS.pack "Yes\n"
  | otherwise = BS.pack "No\n"

-- Find the solution
solveIt :: Input -> Output
solveIt ((a, b, c), (x, y, z))
  | canMake >= need = True
  | otherwise = False
  where
    fCanMake = (\have need -> if have > need then floor $ (realToFrac (have - need)) / 2 else 0)
    canMake = (fCanMake a x) + (fCanMake b y) + (fCanMake c z)
    fNeed = (\have need -> if have >= need then 0 else need - have)
    need = (fNeed a x) + (fNeed b y) + (fNeed c z)

import Data.List.Split (splitOn)

main = do
    abc <- getLine
    let abcint = [read x :: Int | x <- splitOn " " abc]
    xyz <- getLine
    let xyzint = [read x :: Int | x <- splitOn " " xyz]
    let availableballs = [if x < 0 then x else div x 2 |
                          i <- zip abcint xyzint, let x = fst i - snd i]
    if sum(availableballs) < 0 then putStrLn "No" else putStrLn "Yes"

import Control.Applicative
import Control.Monad

solve :: Int -> Int -> Int -> Bool
solve x y z = f x + f y + f z + g x + g y + g z >= 0
    where
        f n = max 0 n `div` 2
        g n = min 0 n

main :: IO ()
main = do
    [a,b,c] <- map read . words <$> getLine
    [x,y,z] <- map read . words <$> getLine
    putStrLn $ if solve (a-x) (b-y) (c-z)
        then "Yes"
        else "No"

transformable :: (Integral a, Num a) => [a] -> [a] -> Bool
transformable src dst = (sum $ map step $ zip src dst) >= 0
    where step (s, d) | s >= d = (s-d) `div` 2
            | otherwise = s-d

sh True = "Yes"
sh False = "No"

main = do
    inp <- getContents
    let ls = lines inp
        src = (map read $ words $ head ls) :: [Int]
        dst = (map read $ words $ head $ tail ls) :: [Int]
    putStrLn $ sh $ transformable src dst

solve :: [Int] -> [Int] -> Bool
solve has needs = canmake >= req
  where
    surplus = filter (\x -> x > 0) $ map (\(x, y) -> x - y) $ zip has needs
    req = sum $ filter (\x -> x > 0) $ map (\(x, y) -> y - x) $ zip has needs
    canmake = sum $ map (\x -> if even x then x `div` 2 else (x - 1) `div` 2) surplus

main :: IO ()
main = do
  l1 <- getLine
  l2 <- getLine
  let has = map read $ words l1
      needs = map read $ words l2
  if solve has needs
    then putStrLn "YES"
    else putStrLn "NO"

import Control.Applicative
import Data.List

main= do
	[a,b,c]<- map read.words <$> getLine ::IO [Integer]
	[x,y,z]<- map read.words <$> getLine ::IO [Integer]
	let s = [a-x,b-y,c-z]
	let t1= sum $ map (\z-> div z 2) $ filter (>0) s
	let t2= abs $ sum $ filter (<=0) s
	putStrLn $ if t1>=t2 then "Yes" else "No"

import qualified Data.ByteString.Char8 as S

-- Alias things
type ByteString = S.ByteString
pack = S.pack
unpack = S.unpack

-- Reads a list of tokens from a ByteString, split by space or new line.
getTokens :: ByteString -> [ByteString]
getTokens contents = S.splitWith (\c -> c == '\n' || c == ' ') contents

-- Main
main = S.interact handleInput

-- Input
handleInput :: ByteString -> ByteString
handleInput input =
  let tokens = take 6 $ getTokens input
      (a:b:c:x:y:z:_) = map read $ map unpack tokens
      solution = solveIt (a, b, c) (x, y, z)
      output = formatOutput solution
  in output

-- Output
formatOutput :: Bool -> ByteString
formatOutput s
  | s = pack "Yes"
  | otherwise = pack "No"

-- Solution
solveIt :: (Int, Int, Int) -> (Int, Int, Int) -> Bool
solveIt (a, b, c) (x, y, z) = False

import Control.Applicative
import Control.Monad
import Debug.Trace

solve :: (Int,Int,Int) -> (Int,Int,Int) -> Bool
solve (a,b,c) (x,y,z)
    | a == x && b == y && c == z = trace (show (a,b,c)) $ True
    | a <= x && b <= y && c <= z = trace (show (a,b,c)) $ False
    | a == x + 1 = solve (a-1,b,c) (x,y,z)
    | a > x && b >= y = trace (show (a,b,c)) $ solve (a-2,b,c+1) (x,y,z)
    | a > x && b < y = trace (show (a,b,c)) $ solve (a-2,b+1,c) (x,y,z)
    | b == y + 1 = solve (a,b-1,c) (x,y,z)
    | b > y && c >= z = trace (show (a,b,c)) $ solve (a+1,b-2,c) (x,y,z)
    | b > y && c < z = trace (show (a,b,c)) $ solve (a,b-2,c+1) (x,y,z)
    | c == z + 1 = solve (a,b,c-1) (x,y,z)
    | c > z && b >= y = trace (show (a,b,c)) $ solve (a+1,b,c-2) (x,y,z)
    | otherwise = trace (show (a,b,c)) $ solve (a,b+1,c-2) (x,y,z)

main :: IO ()
main = do
    [a,b,c] <- map read . words <$> getLine
    [x,y,z] <- map read . words <$> getLine
    putStrLn $ if abs (a-x) + abs (b-y) + abs (c-z) == 1
        then "No"
        else if solve (a,b,c) (x,y,z)
            then "Yes"
            else "No"


Little Petya has recently started attending a programming club. Naturally he is facing the problem of choosing a programming language. After long considerations he realized that Java is the best choice. The main argument in favor of choosing Java was that it has a very large integer data type, called BigInteger.But having attended several classes of the club, Petya realized that not all tasks require using the BigInteger type. It turned out that in some tasks it is much easier to use small data types. That's why a question arises: "Which integer type to use if one wants to store a positive integer n?"Petya knows only 5 integer types:1) byte occupies 1 byte and allows you to store numbers from  - 128 to 1272) short occupies 2 bytes and allows you to store numbers from  - 32768 to 327673) int occupies 4 bytes and allows you to store numbers from  - 2147483648 to 21474836474) long occupies 8 bytes and allows you to store numbers from  - 9223372036854775808 to 92233720368547758075) BigInteger can store any integer number, but at that it is not a primitive type, and operations with it are much slower.For all the types given above the boundary values are included in the value range.From this list, Petya wants to choose the smallest type that can store a positive integer n. Since BigInteger works much slower, Peter regards it last. Help him.

The first line contains a positive number n. It consists of no more than 100 digits and doesn't contain any leading zeros. The number n can't be represented as an empty string. Please, do not use %lld specificator to read or write 64-bit integers in C++. It is preffered to use cout (also you may use %I64d).

Print the first type from the list "byte, short, int, long, BigInteger", that can store the natural number n, in accordance with the data given above.

main=readLn>>=putStr.(words"BigInteger long int short byte"!!).length.f
f n=filter((n<).(2^))[7,15,31,63]

main=putStr.(words"byte short int long BigInteger"!!).length.f=<<readLn
f n=takeWhile((<abs(1+n)).(2^))[7,15,31,63]

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import Control.Monad (forM_)

fI = fromIntegral

itype n
    | m <= 2^7     = "byte"
    | m <= 2^15    = "short"
    | m <= 2^31    = "int"
    | m <= 2^63    = "long"
    | otherwise = "BigInteger"
    where m = abs (n + 1)

main = do
    ws <- words `fmap` getContents
    let ns = map read ws
    forM_ [itype n | n <- ns] $
        putStrLn

main=do l<-getLine;putStr.(words"byte short int long BigInteger"!!).length.takeWhile(<abs(1+read l))$map(2^)[7,15,31,63]

main :: IO ()
main = do c <- getLine
          putStrLn (solve c)

solve = str . qq sp . read

str :: Int -> String
str 1 = "byte"
str 2 = "short"
str 3 = "int"
str 4 = "long"
str _ = "BigInteger"

qq :: [Integer] -> Integer -> Int
qq (x : xs) a
  | (a + x `div` 2 >= 0) && (a + x `div` 2 < x) = 1
  | otherwise = 1 + qq xs a

f y = 2 ^ (8 * 2 ^ y)
sp = map f [0..]

main :: IO ()
main = do c <- getLine
          putStrLn (solve c)

solve c = ["byte", "short", "int", "long", "BigInteger"] !! qq (map (\y -> 2 ^ (8 * 2 ^ y)) [0..]) (read c)

qq :: [Integer] -> Integer -> Int
qq (x : xs) a
  | (a + x `div` 2 >= 0) && (a + x `div` 2 < x) = 0
  | otherwise = min 4 (1 + qq xs a)

type Interval = (Integer, Integer)
type TypeNum = (String, Interval)

byte       =  ("byte",       (-128,                 127))
short      =  ("short",      (-32768,               32767))
int        =  ("int",        (-2147483648,          2147483647))
long       =  ("long",       (-9223372036854775808, 9223372036854775807))
bigInteger =  ("BigInteger", (0, 0))

inInterval :: Integer -> TypeNum -> Bool
inInterval n (_, (a, b)) = a <= n && n <= b

getName :: TypeNum -> String
getName (name, _) = name

solve :: Integer -> String
solve n = getName (solve_ n [byte, short, int, long, bigInteger])
  where
    solve_ :: Integer -> [TypeNum] -> TypeNum
    solve_ _ [a] =  a
    solve_ n (a:as)
      | inInterval n a = a
      | otherwise = solve_ n as

main = do
  n <- readLn
  putStrLn (solve n)

module Main where

readI :: String -> Integer
readI = read

guessType x
    | x < 128        = "byte"
    | x < 32768      = "short"
    | x < 2147483648 = "int"
    | x < 9223372036854775808 = "long"
    | otherwise = "BigInteger"

main :: IO ()
main = do
    value <- getLine
    putStrLn $ guessType $ readI value

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Arrow
import Data.Monoid
import Data.List (find)
import Data.Char

import Data.ByteString.Char8 (interact,length,splitWith)
import Prelude hiding        (interact,length)

main = interact $ splitWith isSpace >>> head >>>
  (\ x (e,_) -> ((length x `compare` length e) `mappend` (x `compare` e)) /= GT) >>>
  (`find` [("127","byte"),("32767","short"),("2147483647","int"),("9223372036854775807","long")])
  >>> maybe "BigInteger" snd

module Main where

import Control.Arrow
import Data.List

main = interact $ read >>>
  (<=) >>> (fst >>>) >>>
  (`find` [(127,"byte"),(32767,"short"),(2147483647,"int"),(9223372036854775807,"long")])
  >>> maybe "BigInteger" snd

-- Java is the worst choice
-- Byte, Short, Integer and Long(such OO malarkey!!!) work much slower besides BigInteger

main :: IO ()
main = do
    n <- fmap read getLine :: IO Integer
    if (-128) <= n && n <= 127
        then putStrLn "byte"
        else if (-32768) <= n && n <= 32767
            then putStrLn "short"
            else if (-2147483648) <= n && n <= 2147483647
                then putStrLn "int"
                else if (-9223372036854775808) <= n && n <= 9223372036854775807
                    then putStrLn "long"
                    else putStrLn "BigInteger"

main = interact $ datatype . read

datatype :: Integer -> String
datatype i
    | i < 128 = "byte"
    | i < 32768 = "short"
    | i < 2147483648 = "int"
    | i < 9223372036854775808 = "long"
    | otherwise = "BigInteger"

import Data.List
l = [("byte", 127), ("short", 32767), ("int", 2147483647), ("long", 9223372036854775807)]
main = do
    n <- read `fmap` getLine :: IO Integer
    case find (\(t, m) -> n <= m) l of
        Just (t, _) -> putStrLn t
        Nothing -> putStrLn "BigInteger"

module Main where
import Control.Applicative
import Text.Printf

f :: Integer -> String
f n
    | n < 128      =  "byte"
    | n < 32768    = "short"
    | n < 2147483648 = "int"
    | n < 9223372036854775808 = "long"
    | otherwise               = "BigInteger"

main :: IO ()
main =
    do { txt <- f . (read) . (!!0) .  lines <$> getContents
       ; (printf "%s\n" txt)
       }

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import Control.Monad (forM_)

fI = fromIntegral

itype n
    | k < 8     = "byte"
    | k < 16    = "short"
    | k < 32    = "int"
    | k < 64    = "long"
    | otherwise = "BigInteger"
    where
    k = ceiling . (subtract 1e-5) . logBase 2 $ abs (n + 1)

main = do
    ws <- words `fmap` getContents
    let ns = map read ws
    forM_ [itype n | n <- ns] $
        putStrLn

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import Control.Monad (forM_)

fI = fromIntegral

itype n
    | k < 8     = "byte"
    | k < 16    = "short"
    | k < 32    = "int"
    | k < 64    = "long"
    | otherwise = "BigInteger"
    where
    k = ceiling . logBase 2 $ abs (n + 1)

main = do
    ws <- words `fmap` getContents
    let ns = map read ws
    forM_ [itype n | n <- ns] $
        putStrLn

module Main where

import Control.Arrow
import Data.List

main = interact $ lines >>> tail >>>
  map (words >>> map read) >>>
  transpose >>> find (sum >>> (/=0)) >>> maybe "YES" (const "NO")

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Arrow
import Data.Monoid
import Data.List (find)

import Data.ByteString.Char8 (getLine,length,putStr)
import Prelude hiding        (getLine,length,putStr)

main = (>>=) getLine $
  (\ x (e,_) -> ((length x `compare` length e) `mappend` (x `compare` e)) /= GT) >>>
  (`find` [("127","byte"),("32767","short"),("2147483647","int"),("9223372036854775807","long")])
  >>> maybe "BigInteger" snd >>> putStr

module Main where
import Control.Applicative
import Text.Printf

f :: Integer -> String
f n
    | n < 128      =  "byte"
    | n < 32768    = "short"
    | n < 2147483648 = "int"
    | n < 9223372036854775807 = "long"
    | otherwise               = "BigInteger"

main :: IO ()
main =
    do { txt <- f . (read) . (!!0) .  lines <$> getContents
       ; (printf "%s\n" txt)
       }

module Main where
import Control.Applicative
import Text.Printf

f :: Int -> String
f n
    | n < 128      =  "byte"
    | n < 32768    = "short"
    | n < 2147483648 = "int"
    | n < 9223372036854775807 = "long"
    | otherwise               = "BigInteger"

main :: IO ()
main =
    do { txt <- f . (read) . (!!0) .  lines <$> getContents
       ; (printf "%s\n" txt)
       }


Greg is a beginner bodybuilder. Today the gym coach gave him the training plan. All it had was n integers a1, a2, ..., an. These numbers mean that Greg needs to do exactly n exercises today. Besides, Greg should repeat the i-th in order exercise ai times.Greg now only does three types of exercises: "chest" exercises, "biceps" exercises and "back" exercises. Besides, his training is cyclic, that is, the first exercise he does is a "chest" one, the second one is "biceps", the third one is "back", the fourth one is "chest", the fifth one is "biceps", and so on to the n-th exercise.Now Greg wonders, which muscle will get the most exercise during his training. We know that the exercise Greg repeats the maximum number of times, trains the corresponding muscle the most. Help Greg, determine which muscle will get the most training.

The first line contains integer n (1 ≤ n ≤ 20). The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 25) — the number of times Greg repeats the exercises.

Print word "chest" (without the quotes), if the chest gets the most exercise, "biceps" (without the quotes), if the biceps gets the most exercise and print "back" (without the quotes) if the back gets the most exercise. It is guaranteed that the input is such that the answer to the problem is unambiguous.

NoteIn the first sample Greg does 2 chest, 8 biceps and zero back exercises, so the biceps gets the most exercises.In the second sample Greg does 5 chest, 1 biceps and 10 back exercises, so the back gets the most exercises.In the third sample Greg does 18 chest, 12 biceps and 8 back exercises, so the chest gets the most exercise.

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

get_ans :: Int -> [Int] -> [Int]
get_ans _ [] = (0:0:0:[])
get_ans n (a:b)
	| mod n 3 == 0 = (old !! 0 + a):(old !! 1):(old !! 2):[]
	| mod n 3 == 1 = (old !! 0):(old !! 1 + a):(old !! 2):[]
	| mod n 3 == 2 = (old !! 0):(old !! 1):(old !! 2 + a):[]
		where old = get_ans (n + 1) b

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	let ans = get_ans 0 (map read (words str2))
	if (ans !! 0 > ans !! 1 && ans !! 0 > ans !! 2)
		then putStrLn "chest"
		else if (ans !! 1 > ans !! 2)
			then putStrLn "biceps"
			else putStrLn "back"

import Data.Function
import Data.List

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

solve l = [ "chest", "biceps", "back" ] !! maximumBy (compare `on` f) [0..2]
 where f k = sum $ zipWith (*) l $ replicate k 0 ++ cycle [1,0,0]

{-# 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 <- readLn
  xs <- getInts

  let
    a = sum $ map (xs!!) $ takeWhile (< n) [0,3..]
    b = sum $ map (xs!!) $ takeWhile (< n) [1,4..]
    c = sum $ map (xs!!) $ takeWhile (< n) [2,5..]

  putStrLn $
    if a > b && a > c
       then "chest"
       else if b > a && b > c
         then "biceps"
         else "back"

import Data.List
import Data.Maybe

main = do
	line <- getContents
	let lst = map read $ words line
	let	groups = takeByThree (drop 1 lst)
		total = foldl doSum [0,0,0] groups
		mx = elemIndex (maximum total) total
	putStrLn (idxToStr ((fromMaybe 0 mx) +1))

idxToStr :: Int -> String
idxToStr idx
	| mod idx 3 == 1 = "chest"
	| mod idx 3 == 2 = "biceps"
	|otherwise = "back"

takeByThree :: [Int] -> [[Int]]
takeByThree [] = []
takeByThree xs = take 3 xs : takeByThree (drop 3 xs)

doSum:: [Int] -> [Int] -> [Int]
doSum (a:b:c) [] = (a:b:c)
doSum [a,b,c] [d,e,f] = [a +d, b+e, c+f]
doSum [a,b,c] [d,e] = [a +d, b+e, c]
doSum [a,b,c] [d] = [a +d, b, c]

import Control.Monad (liftM)

solve :: [Int] -> String
solve as
  | a > b && a > c  =  "chest"
  | b > a && b > c  =  "biceps"
  | c > a && c > b  =  "back"
  where
    a  =  sum $ zipWith (*) as $ tail $ tail cycl
    b  =  sum $ zipWith (*) as $ tail cycl
    c  =  sum $ zipWith (*) as cycl
    cycl  =  cycle [0, 0, 1]

main :: IO ()
main  =  do
    getLine
    as  <-  liftM (map read . words) getLine
    putStrLn $ solve as

import Data.List

compareSnd (_, x) (_, y) = compare x y

assocSum :: (Eq a) => [(a, Int)] -> a -> Int
assocSum assoc key = sum $ map snd $ filter givenKey assoc
  where givenKey = (== key) . fst

solve xs = fst $ maximumBy compareSnd finalAssoc
  where keys = ["chest", "biceps", "back"]
        assoc = zip (cycle keys) xs
        finalAssoc = zip keys $ map (assocSum assoc) keys

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

import Data.List (elemIndex, foldl', unfoldr)
import Data.Maybe (fromJust)

main :: IO ()
main = getContents >>= putStrLn . solve . map read . words . (!!1) . lines

solve :: [Int] -> String
solve = (exercise !!) . maximumIndex . foldl' (zipWith (+)) [0, 0, 0] . map (++[0,0,0]) . splitN 3

exercise :: [String]
exercise = [ "chest", "biceps", "back" ]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

maximumIndex :: Ord a => [a] -> Int
maximumIndex xs = fromJust $ elemIndex (maximum xs) xs

import Data.List
main = interact $ solve . map read . tail . words
solve as | chest == m = "chest"
         | biceps == m = "biceps"
         | back == m = "back" where
  parts@[chest,biceps,back] = map sum $ transpose $ chunksOf 3 $ [0,0,0] ++as
  m = maximum parts
chunksOf n = go where
  go [] = []
  go xs = l : go r where (l,r) = splitAt n xs

module Main where

data Muscle = Chest | Biceps | Back

max3 :: Int -> Int -> Int -> String
max3 a b c
  | a > b = if a > c then "chest" else "back"
  | b > c = "biceps"
  | otherwise = "back"

solve :: [Int] -> String
solve = solve' 0 0 0 Chest
      where
      solve' a b c _ [] = max3 a b c
      solve' a b c Chest (x:xs) = solve' (a+x) b c Biceps xs
      solve' a b c Biceps (x:xs) = solve' a (b+x) c Back xs
      solve' a b c Back (x:xs) = solve' a b (c+x) Chest xs

main = do
     getLine
     exercises <- fmap (map read . words) getLine
     putStrLn $ solve exercises

main = getContents >>= putStrLn.solve 0 0 0.tail.map read.words

solve x y z (a:b:c:rest) = solve (x+a) (y+b) (z+c) rest
solve x y z (a:b:rest) = solve (x+a) (y+b) z rest
solve x y z (a:rest) = solve (x+a) y z rest
solve x y z []
  | x==maximum[x,y,z] = "chest"
  | y==maximum[x,y,z] = "biceps"
  | otherwise = "back"

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (n:a:cs) = snd . maximum $ zip (f 0 (map read $ words a)) ["chest","biceps","back"]
  where
    f i [] = [0,0,0]
    f i (a:as)
      | i == 0 = [x+a,y,z]
      | i == 1 = [x,y+a,z]
      | i == 2 = [x,y,z+a]
        where [x,y,z] = f ((i+1) `mod` 3) as

module Main where

data Muscle = Chest | Biceps | Back

max3 :: Int -> Int -> Int -> String
max3 a b c = if a > b
             then if a > c
                  then "chest"
                  else "back"
             else if b > c
                  then "biceps"
                  else "back"

solve :: [Int] -> String
solve ex = solve' 0 0 0 Chest ex
      where
      solve' a b c _ [] = max3 a b c
      solve' a b c Chest (x:xs) = solve' (a+x) b c Biceps xs
      solve' a b c Biceps (x:xs) = solve' a (b+x) c Back xs
      solve' a b c Back (x:xs) = solve' a b (c+x) Chest xs

main = do
     getLine
     exercises <- fmap ((map (read :: String -> Int)) . words) getLine
     putStrLn $ solve exercises

main :: IO()
main = do
        n <- getLine
        l <- getLine
        ap (func (map (read) $ splitOn ' ' l))
        where
            ap 1 = putStrLn "chest"
            ap 2 = putStrLn "biceps"
            ap 3 = putStrLn "back"

splitOn :: Char -> String -> [String]
splitOn _ [] = []
splitOn x (y:xs)
    | x==y = splitOn x xs
splitOn x xs = (takeWhile (f) xs): (splitOn x (dropWhile (f) xs))
    where
        f q = q/=x

func :: [Int] -> Int
func a = y
    where
        (x,y) = maximum (map (f) [1,2,3])
        l = (zip a (cycle [1,2,3]))
        f i = (sum [ x | (x,y) <- l, y==i],i)

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

chunks n []= []
chunks n t = (take n t ): (chunks n (drop n t))

main= do
	getLine
	t<- map read. words <$> getLine::IO [Int]
	let d@[a,b,c]=map sum $ transpose $ chunks 3 (t++[0,0,0])
	let e= maximum d
	putStrLn $ if e==a then "chest"
	                  else if e==b then "biceps" else "back"

import Data.List (transpose, unfoldr, splitAt, maximumBy)
import Data.Ord (comparing)

maxIndex :: Ord a => [a] -> Int
maxIndex = fst . maximumBy (comparing snd) . zip [0..]

uncycle :: Int -> [Int] -> [[Int]]
uncycle n xs = transpose $ unfoldr (\x -> if null x then Nothing else Just (splitAt n x)) xs

exercises :: [String]
exercises = ["chest", "biceps", "back"]

process :: [Int] -> String
process = (!!) exercises . maxIndex . map sum . uncycle (length exercises)

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    putStrLn $ process xs

main = do
  (n:input) <- fmap (map read . words) getContents
  let f [] = (0, 0, 0)
      f [a] = (a, 0, 0)
      f [a, b] = (a, b, 0)
      f (a:b:c:xs) = (a + x, b + y, c + z)
                     where (x, y, z) = f xs
      (a, b, c) = f input
      val = maximum [a, b, c]
      ans (a, b, c) | a == val = "chest"
                    | b == val = "biceps"
                    | c == val = "back"
  putStrLn $ ans (a, b, c)

import Data.List
import Data.Ord

main = do
    (n:a) <- fmap (map read . words) getContents :: IO [Int]
    putStrLn $ f $ snd $ maximumBy (comparing fst) (zip (sum a) [0..]) where
        f k = ["chest", "biceps", "back"] !! k
        sum a
            | length a < 3 = take 3 $ a ++ repeat 0
            | otherwise = zipWith (+) (take 3 a) (sum $ drop 3 a)

{-# 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 <- readLn
  xs <- getInts

  let
    a = map (xs!!) $ takeWhile (< n) [0,3..]
    b = map (xs!!) $ takeWhile (< n) [1,4..]
    c = map (xs!!) $ takeWhile (< n) [2,5..]

  putStrLn $
    if a > b && a > c
       then "chest"
       else if b > a && b > c
         then "biceps"
         else "back"

import Data.List
main = interact $ show . solve . map read . tail . words
solve as | chest == m = "chest"
         | biceps == m = "biceps"
         | back == m = "back" where
  parts@[chest,biceps,back] = map sum $ transpose $ chunksOf 3 $ [0,0,0] ++as
  m = maximum parts
chunksOf n = go where
  go [] = []
  go xs = l : go r where (l,r) = splitAt n xs


You can not just take the file and send it. When Polycarp trying to send a file in the social network "Codehorses", he encountered an unexpected problem. If the name of the file contains three or more "x" (lowercase Latin letters "x") in a row, the system considers that the file content does not correspond to the social network topic. In this case, the file is not sent and an error message is displayed.Determine the minimum number of characters to remove from the file name so after that the name does not contain "xxx" as a substring. Print 0 if the file name does not initially contain a forbidden substring "xxx".You can delete characters in arbitrary positions (not necessarily consecutive). If you delete a character, then the length of a string is reduced by $$$1$$$. For example, if you delete the character in the position $$$2$$$ from the string "exxxii", then the resulting string is "exxii".

The first line contains integer $$$n$$$ $$$(3 \le n \le 100)$$$ — the length of the file name. The second line contains a string of length $$$n$$$ consisting of lowercase Latin letters only — the file name.

Print the minimum number of characters to remove from the file name so after that the name does not contain "xxx" as a substring. If initially the file name dost not contain a forbidden substring "xxx", print 0.

NoteIn the first example Polycarp tried to send a file with name contains number $$$33$$$, written in Roman numerals. But he can not just send the file, because it name contains three letters "x" in a row. To send the file he needs to remove any one of this letters.

import Data.List

main = do
  getLine
  s <- getLine
  print (solve s)

solve :: String -> Int
solve s =
  sum [len-2 | ts <- group s, all(=='x')ts, let len=length ts, len >= 3]

import Data.List

f ::(Int,Char)->Int
f (a,b)
   |b=='x' && a>2=(a-2)
   |otherwise=0

main = do
       e1<-getLine
       e2<-getLine
       let x=group e2
           y=zip (map length (x)) (map head (x))
       print $ sum $ map f y

import Data.List (dropWhile, span)

main = do
  _ <- getLine
  s <- getLine
  print $ solve $ s

solve :: String -> Int
solve "" = 0
solve s = let t = dropWhile (/='x') s
              (xs, ys) = span (=='x') t
          in max 0 (length xs - 2) + solve ys

import Data.List (group)

main = do
  _ <- getLine
  s <- getLine
  print $ solve $ s

solve :: String -> Int
solve = sum . map (\x -> max 0 (x - 2)) . map length . filter ((=='x') . head) . group

--
-- Michael V. Antosha
-- 2019
-- Michael.Antosha@gmail.com
--
-- Haskell practice.
-- Competitive programming.
--
-- Codeforces Round #481 (Div. 3)
--
-- B. File Name
-- http://codeforces.com/contest/978/problem/B
--

import Data.Function((.))
import Data.Int (Int)
import Data.List(head, tail, (++))
import Data.String(String, words)
import Data.Tuple (fst)
import Prelude ((+))
import System.IO (IO, interact)
import Text.Show (show)

main :: IO ()
main = interact pureMain  where

    pureMain = showSingleValue . filterXXX . takeSecondWord

    takeSecondWord = head . tail . words

    showSingleValue = (++ "\n") . show

filterXXX :: String -> Int
filterXXX = fst . f . (,) 0  where
    f (n, []) = (n, [])
    f (n, ('x':'x':'x':xs)) = f (n+1, ('x':'x':xs))
    f (n, (_:xs)) = f (n, xs)

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

minRemove :: String -> Int
minRemove = sum . map (max 0 . flip (-) 2) . map length . filter ((=='x') . head) . group

main :: IO ()
main = do
    _ <- readInt
    s <- getLine
    print $ minRemove s

import Data.List
main = interact $ show . sum . map (max 0 . (subtract 2) . length) . filter ((== 'x') . head) . group

import Data.List

main = do
  _ <- getLine
  file <- getLine
  let xp = filter (\(x:xs) -> x == 'x')  $ groupBy (\x y -> x == y) file in
    print  (sum  (map (\x ->  maximum [0, x-2]) $ map length xp))

module Main where

count ln (-1) i = i
count ln n i = do
    if (ln !! n) == 'x' && (ln !! (n + 1)) == 'x' && (ln !! (n + 2)) == 'x'
    then count ln (n - 1) (i + 1)
    else count ln (n - 1) i

main = do
    n <- getLine
    ln <- getLine
    let a = count ln (read n - 3) 0
    putStrLn $ show a

module Main where

import Data.List

f (res, xs) 'x' = (res, xs+1)
f (res, xs) _ = (res + (max (xs-2) 0), 0)

solve = fst . foldl' f (0, 0) . (++ "!")

main = interact $ show . solve . head . (drop 1) . lines

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

process s = length $ filter (=="xxx") $ map (take 3) $ tails s

main::IO ()
main=do
	getLine
	s<-getLine
	print $ process s

import Data.List
main = interact $ show . process . head . tail . lines
process = sum . map (\x -> 0 `max` (length x - 2)) . filter head . group . map (=='x')

--ghc 7.10

import Data.List(group,isPrefixOf)

removeX' :: String -> Int
removeX' str = sum $ map (\x -> length x - 2) $ filter (isPrefixOf "xxx") $ group str

main = do
    nStr <- getLine
    str <- getLine
    print $ removeX' str

import Data.List
solve (n:as:_) = (sum . filter (> 0) . map (+ (-2)) . map length . filter (elem 'x') . group) as
main = interact $ show . solve  . words

--
-- Michael V. Antosha
-- 2019
-- Michael.Antosha@gmail.com
--
-- Haskell practice.
-- Competitive programming.
--
-- Codeforces Round #481 (Div. 3)
--
-- B. File Name
-- http://codeforces.com/contest/978/problem/B
--

import Data.Function((.))
import Data.Int (Int)
import Data.List(head, tail, (++))
import Data.String(String, words)
import Data.Tuple (fst)
import Prelude ((+))
import System.IO (IO, interact)
import Text.Show (show)

main :: IO ()
main = interact pureMain  where

    pureMain = showSingleValue . filterXXX . takeSecondWord

    takeSecondWord = head . tail . words

    showSingleValue = (++ "\n") . show

filterXXX :: String -> Int
filterXXX = fst . f . (,) 0  where
    f (n, []) = (n, [])
    f (n, ('x':'x':'x':xs)) = f (n+1, ('x':'x':xs))
    f (n, xs) = (n, xs)

import Data.List
main = interact $ show . sum . map ((subtract 2) . length) . filter ((== 'x') . head) . group

import Data.List

main = do
  _ <- getLine
  file <- getLine
  let xp = filter (\(x:xs) -> x == 'x') $ groupBy (\x y -> x == y) file
      cnt = map length xp
  print (sum ( map (\x -> max 0 x - 2) cnt))

import Data.List

main = do
  _ <- getLine
  file <- getLine
  let xp = filter (\(x:xs) -> x == 'x')  $ groupBy (\x y -> x == y) file in
    print  (sum  (map (\x ->  max 0 x-2) $ map length xp))

module Main where

import Data.List

f (res, xs) 'x' = (res, xs+1)
f (res, xs) _ = (res + (max (xs-2) 0), 0)

solve = fst . foldl' f (0, 0)

main = interact $ show . solve . head . (drop 1) . lines


Ralph has a magic field which is divided into n × m blocks. That is to say, there are n rows and m columns on the field. Ralph can put an integer in each block. However, the magic field doesn't always work properly. It works only if the product of integers in each row and each column equals to k, where k is either 1 or -1.Now Ralph wants you to figure out the number of ways to put numbers in each block in such a way that the magic field works properly. Two ways are considered different if and only if there exists at least one block where the numbers in the first way and in the second way are different. You are asked to output the answer modulo 1000000007 = 109 + 7.Note that there is no range of the numbers to put in the blocks, but we can prove that the answer is not infinity.

The only line contains three integers n, m and k (1 ≤ n, m ≤ 1018, k is either 1 or -1).

Print a single number denoting the answer modulo 1000000007.

NoteIn the first example the only way is to put -1 into the only block.In the second example the only way is to put 1 into every block.

-- Codeforces 894B

-- If m + n is odd and k is -1, then ans is 0
-- Otherwise, ans is 2 ^ ((n - 1) * (m - 1))

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [n, m, k] <- (map read . words) <$> getLine :: IO [Int64]
    if odd (m + n) && k == -1
        then print 0
        else print $ fastPowMod (fastPowMod 2 (n - 1) 1000000007) (m - 1) 1000000007

-- | Return (a^b)%m
fastPowMod :: Int64 -> Int64 -> Int64 -> Int64
fastPowMod = go 1 where
    go r _ 0 _ = r
    go r a b m = go r' a' b' m
        where b' = b `div` 2
              r' = if b `mod` 2 == 1
                      then r * a `mod` m
                      else r
              a' = a * a `mod` m

-- Codeforces 894B

-- If m + n is odd and k is -1, then ans is 0
-- Otherwise, ans is 2 ^ ((n - 1) * (m - 1))

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [n, m, k] <- (map read . words) <$> getLine :: IO [Int64]
    if odd (m + n) && k == -1
        then print (-1)
        else print $ fastPowMod (fastPowMod 2 (n - 1) 1000000007) (m - 1) 1000000007

-- | Return (a^b)%m
fastPowMod :: Int64 -> Int64 -> Int64 -> Int64
fastPowMod = go 1 where
    go r _ 0 _ = r
    go r a b m = go r' a' b' m
        where b' = b `div` 2
              r' = if b `mod` 2 == 1
                      then r * a `mod` m
                      else r
              a' = a * a `mod` m

-- Codeforces 894B

-- If m + n is odd and k is -1, then ans is 0
-- Otherwise, ans is 2 ^ ((n - 1) * (m - 1))

{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [n, m, k] <- (map read . words) <$> getLine :: IO [Int64]
    print [n, m, k]
    if odd (m + n) && k == -1
        then print (-1)
        else print $ fastPowMod (fastPowMod 2 (n - 1) 1000000007) (m - 1) 1000000007

-- | Return (a^b)%m
fastPowMod :: Int64 -> Int64 -> Int64 -> Int64
fastPowMod = go 1 where
    go r _ 0 _ = r
    go r a b m = go r' a' b' m
        where b' = b `div` 2
              r' = if b `mod` 2 == 1
                      then r * a `mod` m
                      else r
              a' = a * a `mod` m

-- Codeforces 894B

-- If m + n is odd and k is -1, then ans is 0
-- Otherwise, ans is 2 ^ ((n - 1) * (m - 1))

{-# OPTIONS_GHC -O3 #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [n, m, k] <- (map read . words) <$> getLine :: IO [Int64]
    if odd (m + n) && k == -1
        then print (-1)
        else print $ fastPowMod 2 ((n - 1) * (m - 1)) 1000000007

-- | Return (a^b)%m
fastPowMod :: Int64 -> Int64 -> Int64 -> Int64
fastPowMod = go 1 where
    go r _ 0 _ = r
    go r a b m = go r' a' b' m
        where b' = b `div` 2
              r' = if b `mod` 2 == 1
                      then r * a `mod` m
                      else r
              a' = a * a `mod` m


Today in the scientific lyceum of the Kingdom of Kremland, there was a biology lesson. The topic of the lesson was the genomes. Let's call the genome the string "ACTG".Maxim was very boring to sit in class, so the teacher came up with a task for him: on a given string $$$s$$$ consisting of uppercase letters and length of at least $$$4$$$, you need to find the minimum number of operations that you need to apply, so that the genome appears in it as a substring. For one operation, you can replace any letter in the string $$$s$$$ with the next or previous in the alphabet. For example, for the letter "D" the previous one will be "C", and the next — "E". In this problem, we assume that for the letter "A", the previous one will be the letter "Z", and the next one will be "B", and for the letter "Z", the previous one is the letter "Y", and the next one is the letter "A".Help Maxim solve the problem that the teacher gave him.A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.

The first line contains a single integer $$$n$$$ ($$$4 \leq n \leq 50$$$) — the length of the string $$$s$$$. The second line contains the string $$$s$$$, consisting of exactly $$$n$$$ uppercase letters of the Latin alphabet.

Output the minimum number of operations that need to be applied to the string $$$s$$$ so that the genome appears as a substring in it.

NoteIn the first example, you should replace the letter "Z" with "A" for one operation, the letter "H" — with the letter "G" for one operation. You will get the string "ACTG", in which the genome is present as a substring.In the second example, we replace the letter "A" with "C" for two operations, the letter "D" — with the letter "A" for three operations. You will get the string "ZACTG", in which there is a genome.

import Data.Char
main :: IO ()
main = do
	n <- getLine
	s <- getLine
	putStrLn $ show $ solve s
	return ()

diff :: Char -> Char -> Int
diff a b = let h = abs ((ord a) - (ord b))
			in min h (26 - h)

solve :: String -> Int
solve s
	|length s >=4 = min (helper s) (solve $ tail s)
	|otherwise = 10000

helper :: String -> Int
helper s
	|length s >=4 = s!!0 `diff` 'A' + s!!1 `diff` 'C' + s!!2 `diff` 'T' + s!!3 `diff` 'G'
	|otherwise = 1000

import Data.List
import Data.Char

overlappingChunksOf4 :: [a] -> [[a]]
overlappingChunksOf4 [a,b,c,d] = [[a,b,c,d]]
overlappingChunksOf4 (a:b:c:d:e) = [a,b,c,d] : overlappingChunksOf4 (b:c:d:e)

minMoves :: Char -> Char -> Int
minMoves a b = min c (26 - c)
    where c = abs (ord a - ord b)

solve :: String -> Int
solve = minimum . map sum . map (map (uncurry minMoves)) . map (zip "ACTG") . overlappingChunksOf4

-- ACTG

main :: IO ()
main = do
    q <- getLine
    s <- getLine
    print $ solve s

import Data.List
import Data.Ord
import Data.Char

chardist a b = let d = abs $ ord a - ord b in min d (26-d)

wordDist = sum . zipWith chardist "ACTG"

main = do
    _ <- getLine
    text <- getLine
    let substrs = takeWhile (\s -> length s == 4) $ map (\n -> take 4 $ drop n text) [0..]
    print $ minimum $ map wordDist substrs


Petya studies positional notations. He has already learned to add and subtract numbers in the systems of notations with different radices and has moved on to a more complicated action — multiplication. To multiply large numbers one has to learn the multiplication table. Unfortunately, in the second grade students learn only the multiplication table of decimals (and some students even learn it in the first grade). Help Petya make a multiplication table for numbers in the system of notations with the radix k.

The first line contains a single integer k (2 ≤ k ≤ 10) — the radix of the system.

Output the multiplication table for the system of notations with the radix k. The table must contain k - 1 rows and k - 1 columns. The element on the crossing of the i-th row and the j-th column is equal to the product of i and j in the system of notations with the radix k. Each line may have any number of spaces between the numbers (the extra spaces in the samples are put for clarity).

--main = interact $ (\sk -> (\k -> unlines $ map unwords $ map (\i -> map (\x -> x*i) [1..k]) [1..k]) $ (read sk :: Int))

main = interact solve

solve sk = (\k -> unlines $ map unwords $ map (\i -> map (convert k) $ map ((*) i) [1..k-1]) [1..k-1]) (read sk :: Int)

convert _ 0 = ""
convert r i = (convert r (i `div` r)) ++ (show (i `mod` r))

import Prelude hiding (print)

print :: Int -> IO ()
print k  =  mapM_ (putStrLn . getLine) [1..k-1]
  where
    getLine i  =  concatMap (\j -> show' (mul i j)) [1..k-1]
    show' k
      | length s == 1  =  "  " ++ s
      | otherwise  =  " " ++ s
      where
        s  =  show k
    mul i j  =  10 * div (i*j) k + mod (i*j) k

main :: IO ()
main  =  readLn >>= print

import Data.Char
import Data.List
shown d n = reverse(unfoldr iter n)
  where iter 0 = Nothing
        iter k = Just (intToDigit (mod k d), div k d)

main = do
  n <- fmap read getLine
  let table = [[i*j | j <- [1..n-1]] | i <- [1..n-1]]
  putStrLn . unlines . map(unwords . map(shown n)) $ table

main :: IO()
main = interact work

work :: String -> String
work input = unlines . map (unwords . map (showBase n)) . solve $ n
    where n = read input :: Int

showBase :: Int -> Int -> String
showBase b n
    | n == 0    = ""
    | otherwise = showBase b (n `div` b) ++ show (n `mod` b)

solve :: Int -> [[Int]]
solve n = [[i * j | j <- numbers] | i <- numbers]
    where numbers = [1..n - 1]

import Numeric
import Data.Char
import Control.Applicative

main = interact $ f . read where
    f k = g 1 (k - 1) $ toBase k <$> ((*) <$> [1..k-1] <*> [1..k-1]) where
        toBase b a = showIntAtBase b intToDigit a ""
        g _ _ [] = []
        g k' k (x:xs)
            | k' == k   = x ++ "\n" ++ (g 1 k xs)
            | otherwise = x ++ " " ++ (g (k' + 1) k xs)


The Little Elephant very much loves sums on intervals.This time he has a pair of integers l and r (l ≤ r). The Little Elephant has to find the number of such integers x (l ≤ x ≤ r), that the first digit of integer x equals the last one (in decimal notation). For example, such numbers as 101, 477474 or 9 will be included in the answer and 47, 253 or 1020 will not.Help him and count the number of described numbers x for a given pair l and r.

The single line contains a pair of integers l and r (1 ≤ l ≤ r ≤ 1018) — the boundaries of the interval. 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.

On a single line print a single integer — the answer to the problem.

NoteIn the first sample the answer includes integers 2, 3, 4, 5, 6, 7, 8, 9, 11, 22, 33, 44.

main :: IO ()
main = getLine >>= return . map read . words >>= print . solve

solve :: [Integer] -> Integer
solve [a, b] = solve' a b

solve' :: Integer -> Integer -> Integer
solve' a b
	| a > b = 0
	| a `mod` 10 /= 0 = testOne a + solve' (a + 1) b
	| b `mod` 10 /= 0 = testOne b + solve' a (b - 1)
	| otherwise = b `div` 10 - a `div` 10

testOne :: Integer -> Integer
testOne n = if leading n == n `mod` 10 then 1 else 0
	where leading n = if n < 10 then n else leading $ n `div` 10

readInteger :: String -> Integer
readInteger [] = 0
readInteger cs = read cs

main=getLine>>=print.solve.words

solve [ls,rs]
  | m==l = calc rs - calc ls + 1
  | otherwise = calc rs - calc ls
   where
     m = readInteger[head ls]
     l = readInteger[last ls]
calc :: String -> Integer
calc cs
   | len == 1 = readInteger cs
   | m<=l = (m-1)*10^(len-2) + (mid+1) + x
   | otherwise = (m-1)*10^(len-2) + mid + x
   where
     len = length cs
     x = sum $ take (len-1) $ 9:iterate (10*) 9
     m = readInteger[head cs]
     l = readInteger[last cs]
     mid = readInteger $ tail $ init cs

import Control.Applicative

readInput :: IO (Integer, Integer)
readInput = do
  [l,r] <- map read . words <$> getLine
  return (l,r)

firstDigit :: Integer -> Integer
firstDigit x | x <= 9 = x
             | otherwise = firstDigit (x `div` 10)

count :: Integer -> Integer
count x | x <= 9                    = x
        | lastDigit == 0            = x `div` 10 - 1 + 9
        | lastDigit >= firstDigit x = 1 + count (x - lastDigit)
        | otherwise                 = count (x - lastDigit)
      where lastDigit = x `mod` 10

solve :: (Integer, Integer) -> Integer
solve (l,r) = count r - count (l - 1)

main :: IO ()
main = readInput >>= (print . solve)

module Main where

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

f :: Integer -> Integer -> Integer
f l r = g r - g (l-1)

g x
    | x < 10 = x
    | True = g (10^(keta x-1)-1) + k x
keta x
    | x < 10 = 1
    | True = succ$ keta (x`div`10)
k x
    | x < 10 = x
    | True = (x`div`10)-(10^(keta x-2)) + l x
l x
    | x < 10 = 0
    | (x`div`(10^(keta x-1))) <= x `mod` 10 = 1
    | True = 0
{-
    5���̐�
    1???1
    �` 9???9

-}

main = do
    (l, r) <- (\[x,y]->(x,y)). map read. words <$> getLine
    print$ f l r

readInteger :: String -> Integer
readInteger [] = 0
readInteger cs = read cs

main=getLine>>=print.solve.words

solve [ls,rs]
  | m==l = calc rs - calc ls + 1
  | otherwise = calc rs - calc ls
   where
     m = readInteger[head ls]
     l = readInteger[last ls]
calc :: String -> Integer
calc cs
   | len == 1 = readInteger cs
   | m<=l = (m-1)*10^(len-2) + (mid+1) + x
   | otherwise = (m-1)*10^(len-2) + x
   where
     len = length cs
     x = sum $ take (len-1) $ 9:iterate (10*) 9
     m = readInteger[head cs]
     l = readInteger[last cs]
     mid = readInteger $ tail $ init cs


Polycarpus is an amateur businessman. Recently he was surprised to find out that the market for paper scissors is completely free! Without further ado, Polycarpus decided to start producing and selling such scissors.Polycaprus calculated that the optimal celling price for such scissors would be p bourles. However, he read somewhere that customers are attracted by prices that say something like "Special Offer! Super price 999 bourles!". So Polycarpus decided to lower the price a little if it leads to the desired effect.Polycarpus agrees to lower the price by no more than d bourles so that the number of nines at the end of the resulting price is maximum. If there are several ways to do it, he chooses the maximum possible price.Note, Polycarpus counts only the trailing nines in a price.

The first line contains two integers p and d (1 ≤ p ≤ 1018; 0 ≤ d < p) — the initial price of scissors and the maximum possible price reduction. 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.

Print the required price — the maximum price that ends with the largest number of nines and that is less than p by no more than d. The required number shouldn't have leading zeroes.

main = do
  [p, d] <- fmap (map read . words) getLine
  print $ (p-) $ last $ filter (<=d) $ map (\i -> (p+1) `mod` (10^i)) [0 .. 20]

import Monad (liftM)

solve :: Integer -> Integer -> Integer
solve d p  =  d - solve' p d
  where
    solve' p  =  head . dropWhile (> p) . (++ [0]) . map read . takeWhile (not . null) . iterate tail . show . (+1)

main :: IO ()
main  =  do
    [d, p]  <-  liftM (map read . words) getLine
    print $ solve d p

import Data.List

main=getLine>>=print.solve.map read.words

solve :: [Integer] -> Integer
solve [p,d] = case dropWhile(<p-d).map (pred.read.take (length $ show $ p+1).(++repeat '0')).inits $ show $ p+1 of
                [] -> p
                (x:_) -> x

main = do
  [p, d] <- fmap (map read . words) getLine
  print $ (p-) $ last $ takeWhile (<=d) $ (0:) $ map (\i -> succ $ mod p $ 10^i) [0 ..]

main = do
  [p, d] <- fmap (map read . words) getLine
  print $ (p-) $ last $ takeWhile (<=d) $ (0:) $ map (\i -> succ $ mod p $ 10^i) [1 ..]

import Data.List

main=getLine>>=print.solve.map read.words

solve :: [Integer] -> Integer
solve [p,d] = pred.head.dropWhile(p-d>).map (read.take (length h).(++zeros)).inits $ h
   where
     h = show p
     zeros = repeat '0'

import Data.List
import Data.Ord

main=getLine>>=print.solve.map read.words

solve :: [Integer] -> Integer
solve [p,d] = case dropWhile(p-d>).map (pred.read.take (length h).(++zeros)).inits $ h of
                [] -> p-1
                xs -> maximumBy (comparing f) xs
   where
     h = show p
     zeros = repeat '0'
     f n = length.takeWhile ('9'==).reverse $ show n

import Data.List

main=getLine>>=print.solve.map read.words

solve :: [Integer] -> Integer
solve [p,d] = case dropWhile(p-d>).map (pred.read.take (length h).(++zeros)).inits $ h of
                [] -> p-1
                (x:_) -> x
   where
     h = show p
     zeros = repeat '0'