Happy new year! The year 2020 is also known as Year Gyeongja (경자년, gyeongja-nyeon) in Korea. Where did the name come from? Let's briefly look at the Gapja system, which is traditionally used in Korea to name the years.There are two sequences of $$$n$$$ strings $$$s_1, s_2, s_3, \ldots, s_{n}$$$ and $$$m$$$ strings $$$t_1, t_2, t_3, \ldots, t_{m}$$$. These strings contain only lowercase letters. There might be duplicates among these strings.Let's call a concatenation of strings $$$x$$$ and $$$y$$$ as the string that is obtained by writing down strings $$$x$$$ and $$$y$$$ one right after another without changing the order. For example, the concatenation of the strings "code" and "forces" is the string "codeforces".The year 1 has a name which is the concatenation of the two strings $$$s_1$$$ and $$$t_1$$$. When the year increases by one, we concatenate the next two strings in order from each of the respective sequences. If the string that is currently being used is at the end of its sequence, we go back to the first string in that sequence.For example, if $$$n = 3, m = 4, s = $$${"a", "b", "c"}, $$$t =$$$ {"d", "e", "f", "g"}, the following table denotes the resulting year names. Note that the names of the years may repeat.  You are given two sequences of strings of size $$$n$$$ and $$$m$$$ and also $$$q$$$ queries. For each query, you will be given the current year. Could you find the name corresponding to the given year, according to the Gapja system?

The first line contains two integers $$$n, m$$$ ($$$1 \le n, m \le 20$$$). The next line contains $$$n$$$ strings $$$s_1, s_2, \ldots, s_{n}$$$. Each string contains only lowercase letters, and they are separated by spaces. The length of each string is at least $$$1$$$ and at most $$$10$$$. The next line contains $$$m$$$ strings $$$t_1, t_2, \ldots, t_{m}$$$. Each string contains only lowercase letters, and they are separated by spaces. The length of each string is at least $$$1$$$ and at most $$$10$$$. Among the given $$$n + m$$$ strings may be duplicates (that is, they are not necessarily all different). The next line contains a single integer $$$q$$$ ($$$1 \le q \le 2\,020$$$). In the next $$$q$$$ lines, an integer $$$y$$$ ($$$1 \le y \le 10^9$$$) is given, denoting the year we want to know the name for.

Print $$$q$$$ lines. For each line, print the name of the year as per the rule described above.

10 12
sin im gye gap eul byeong jeong mu gi gyeong
yu sul hae ja chuk in myo jin sa o mi sin
14
1
2
3
4
10
11
12
13
73
2016
2017
2018
2019
2020

sinyu
imsul
gyehae
gapja
gyeongo
sinmi
imsin
gyeyu
gyeyu
byeongsin
jeongyu
musul
gihae
gyeongja

NoteThe first example denotes the actual names used in the Gapja system. These strings usually are either a number or the name of some animal.

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

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

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

main = do
    input1 <- getLine
    let n = read (wordsWhen(==' ') input1 !! 0) :: Int
    let m = read (wordsWhen(==' ') input1 !! 1) :: Int
    input2 <- getLine
    let s = wordsWhen(==' ') input2
    input3 <- getLine
    let t = wordsWhen(==' ') input3
    input4 <- getLine
    let q = read input4 :: Integer
    repeatNTimes q (do
        input5 <- getLine
        let y = read input5 :: Int
        putStrLn (concat [(s !! index y n), (t !! index y m)])
        )

module Main where

import Control.Monad

getYearname n m nstr mstr year = (nstr !! yn) ++ (mstr !! ym)
  where
    yn = (year - 1) `mod` n
    ym = (year - 1) `mod` m

main =
  (map (read :: String -> Int) . words) <$> getLine >>= \[n, m] ->
  words <$> getLine >>= \nstr ->
  words <$> getLine >>= \mstr ->
  (read :: String -> Int) <$> getLine >>= \q ->
  replicateM q ((read :: String -> Int) <$> getLine) >>= \years ->
  let
    yearnames = map (getYearname n m nstr mstr) years
  in mapM_ putStrLn yearnames

readInt :: IO Int
readInt = do
  line <- getLine
  return $ (map read $ words line) !! 0

readIntList :: IO [Int]
readIntList = do
  line <- getLine
  return $ map read $ words line

readStrList :: IO [String]
readStrList = do
  line <- getLine
  return $ words line

repReadInt :: Int -> IO [Int]
repReadInt 0 = return []
repReadInt q = do
  x <- readInt
  xs <- repReadInt (q - 1)
  return (x:xs)

printStrList :: [String] -> IO()
printStrList [] = return ()
printStrList (x:xs) = do
  putStrLn x
  printStrList xs

main = do
  [n, m] <- readIntList
  s <- readStrList
  t <- readStrList
  [q] <- readIntList
  query <- repReadInt q
  printStrList $ map (\x -> (s !! (mod x n)) ++ (t !! (mod x m)))
                $ map (\x -> x - 1) query

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

process a b c d = do
			e<- read <$> getLine ::IO Int
			replicateM_ e process1
	where process1 = do
				f<-read <$> getLine ::IO Int
				putStr $ c!!(mod (f-1) a)
				putStrLn $ d!!(mod (f-1) b)

main= do
		[a,b]<- map read <$>words <$>  getLine ::IO [Int]
		c<- words <$> getLine
		d<- words <$> getLine
		process a b c d

--ghc 7.10

yearName :: Int -> Int -> [String] -> [String] -> Int -> String
yearName n m ss ts year = ss !! (year' `mod` n) ++ ts !! (year' `mod` m)
    where year' = year-1

yearNames :: Int -> Int -> [String] -> [String] -> [Int] -> [String]
yearNames n m ss ts = map (yearName n m ss ts)

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    ssStr <- getLine
    let ss = words ssStr
    tsStr <- getLine
    let ts = words tsStr
    qStr <- getLine
    contents <- getContents
    let years = map read . words $ contents
    sequence . map putStrLn . yearNames n m ss ts $ years

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! ((i - 1) `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (putStrLn . getYearName) qs

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

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

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

main = do
    input1 <- getLine
    let n = read (wordsWhen(==' ') input1 !! 0) :: Int
    let m = read (wordsWhen(==' ') input1 !! 1) :: Int
    input2 <- getLine
    let s = wordsWhen(==' ') input2
    input3 <- getLine
    let t = wordsWhen(==' ') input3
    input4 <- getLine
    let q = read input4 :: Integer
    repeatNTimes q (do
        input5 <- getLine
        let y = read input5 :: Int
        print (concat [(s !! index y n), (t !! index y m)])
        )

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! (i `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (print . getYearName) qs

module Main where

main = do
  [n, m] <- map read <$> words <$> getLine
  fSeq <- words <$> getLine
  sSeq <- words <$> getLine
  qCount <- readLn
  qs <- map read <$> (sequence $ replicate qCount getLine)
  let modIndex xs i m = xs !! ((i - 1) `mod` m)
  let getYearName x = modIndex fSeq x n  ++ modIndex sSeq x m
  mapM_ (print . getYearName) qs


Andrewid the Android is a galaxy-famous detective. Now he is busy with a top secret case, the details of which are not subject to disclosure.However, he needs help conducting one of the investigative experiment. There are n pegs put on a plane, they are numbered from 1 to n, the coordinates of the i-th of them are (xi, 0). Then, we tie to the bottom of one of the pegs a weight on a tight rope of length l (thus, its coordinates will be equal to (xi,  - l), where i is the number of the used peg). Then the weight is pushed to the right, so that it starts to rotate counterclockwise. At the same time, if the weight during rotation touches some of the other pegs, it then begins to rotate around that peg. Suppose that each peg itself is very thin and does not affect the rope length while weight is rotating around it.  More formally, if at some moment the segment of the rope contains one or more pegs in addition to the peg around which the weight is rotating, the weight will then rotate around the farthermost one of them on a shorter segment of a rope. In particular, if the segment of the rope touches some peg by its endpoint, it is considered that the weight starts to rotate around that peg on a segment of the rope of length 0.At some moment the weight will begin to rotate around some peg, without affecting the rest of the pegs. Andrewid interested in determining the number of this peg.Andrewid prepared m queries containing initial conditions for pushing the weight, help him to determine for each of them, around what peg the weight will eventually rotate.

The first line contains integers n and m (1 ≤ n, m ≤ 2·105) — the number of pegs and queries. The next line contains n integers x1, x2, ..., xn ( - 109 ≤ xi ≤ 109) — the coordinates of the pegs. It is guaranteed that the coordinates of all the pegs are distinct integers. Next m lines contain the descriptions of the queries of pushing the weight, each consists of two integers ai (1 ≤ ai ≤ n) and li (1 ≤ li ≤ 109) — the number of the starting peg and the length of the rope.

Print m lines, the i-th line should contain the number of the peg around which the weight will eventually rotate after the i-th push.

NotePicture to the first sample test: Picture to the second sample test:Note that in the last query weight starts to rotate around the peg 1 attached to a rope segment of length 0.

import Data.Map (Map, lookupLE, lookupGE)
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Array (Array, listArray, (!))
import qualified Data.ByteString.Char8 as C8

solve :: Int -> Int -> [Int] -> [[Int]] -> [Int]
solve n m a q = inner maxBound <$> query
    where
    peg = M.fromList $ zip a [1..] :: Map Int Int

    query = (\[i, l] -> (arr ! i, i, l)) <$> q :: [(Int, Int, Int)]
        where arr = listArray (1, n) a :: Array Int Int

    inner :: Int -> (Int, Int, Int) -> Int
    inner _ (_, i, 0) = i
    inner y (x, i, r)
        | x < y && i /= i1 = inner x (x1, i1, r1)
        | i /= i0 = inner x (x0, i0, r0)
        | i /= i1 = inner x (x1, i1, r1)
        | otherwise = i
        where
        (x0, i0) = fromJust $ (x - r) `lookupGE` peg :: (Int, Int) -- left peg
        (x1, i1) = fromJust $ (x + r) `lookupLE` peg :: (Int, Int) -- right peg

        r0 = loop (x0 == y) (x0 - x + r) (x - x0) :: Int
        r1 = loop (x1 == y) (x + r - x1) (x1 - x) :: Int

    loop :: Bool -> Int -> Int -> Int
    loop False r _ = r
    loop True r d = r `mod` (2 * d)

parse :: ByteString -> [Int]
parse line = fst . fromJust . C8.readInt <$> C8.words line

main = parse <$> B.getLine >>= \[n, m] -> parse <$> B.getLine >>= \peg ->
    fmap parse <$> replicateM m B.getLine >>= \query ->
    mapM_ print $ solve n m peg query


Emuskald is addicted to Codeforces, and keeps refreshing the main page not to miss any changes in the "recent actions" list. He likes to read thread conversations where each thread consists of multiple messages.Recent actions shows a list of n different threads ordered by the time of the latest message in the thread. When a new message is posted in a thread that thread jumps on the top of the list. No two messages of different threads are ever posted at the same time.Emuskald has just finished reading all his opened threads and refreshes the main page for some more messages to feed his addiction. He notices that no new threads have appeared in the list and at the i-th place in the list there is a thread that was at the ai-th place before the refresh. He doesn't want to waste any time reading old messages so he wants to open only threads with new messages.Help Emuskald find out the number of threads that surely have new messages. A thread x surely has a new message if there is no such sequence of thread updates (posting messages) that both conditions hold:   thread x is not updated (it has no new messages);  the list order 1, 2, ..., n changes to a1, a2, ..., an.

The first line of input contains an integer n, the number of threads (1 ≤ n ≤ 105). The next line contains a list of n space-separated integers a1, a2, ..., an where ai (1 ≤ ai ≤ n) is the old position of the i-th thread in the new list. It is guaranteed that all of the ai are distinct.

Output a single integer — the number of threads that surely contain a new message.

NoteIn the first test case, threads 2 and 5 are placed before the thread 1, so these threads must contain new messages. Threads 1, 3 and 4 may contain no new messages, if only threads 2 and 5 have new messages.In the second test case, there may be no new messages at all, since the thread order hasn't changed.In the third test case, only thread 1 can contain no new messages.

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

main = do
	n <- readLn
	as <- reverse . map read . words <$> getLine
	print $ n - solve as n

solve [] _ = 0
solve (a:as) prev
	| prev < a = 0
	| otherwise = 1 + solve as a

-- Longest Decreasing Prefix
ldp :: [Int] -> Int
ldp (a:(b:c))
    | a > b     = 1 + ldp (b:c)
    | otherwise = 1
ldp x = length x

main :: IO()
main = do
    str1 <- getLine
    str2 <- getLine
    let n = read str1 :: Int
    let a = map read (words str2) :: [Int]
    (putStrLn . show) (n - ldp (reverse a))

import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import qualified Data.Set as S
import Data.Maybe
import Control.Monad

readInt :: B.ByteString -> Int
readInt = fromMaybe 0 . fmap fst . B.readInt

main :: IO ()
main = do
    n <- B.getLine >>= return .readInt
    l <- (B.getLine >>= return .map readInt . B.words)
    print $ solve n l

solve :: Int ->[Int] -> Int
solve n = (n-) . length . L.takeWhile judge . L.drop 1 . L.scanl update (0,S.empty) . L.reverse
    where
        update (0,_) x = (x,S.empty)
        update (y,s) x = (x,S.insert y s)
        judge (x,s) |S.null s  = True
                    |otherwise = x < S.findMin s

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

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> Int
solve xs  =  last (0 : (solve' xs 1))
  where
    solve' [x] _  =  []
    solve' (x:xs) n
      | x < head xs  =  solve' xs (n + 1)
      | otherwise  =  n : solve' xs (n + 1)

main :: IO ()
main  =  getLine >> reads >>= print . solve

main = do
    getLine
    a <- map read `fmap` words `fmap` getLine :: IO [Int]
    let a' = reverse a
    print $ length a - 1 - (length $ takeWhile (uncurry (>)) $ a' `zip` tail a')

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

main :: IO ()
main = do
	_ <- getLine
	aRR <- getLine
	let
		arr = reverse. map (\x -> read x :: Int). words $ aRR
		len = length arr
		solve :: Int -> [Int] -> Int
		solve _ [] = 0
		solve mn (x:xs)
		 | x > mn = length xs + 1
		 | otherwise = solve (min mn x) xs
	print $ solve (head arr) arr

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

solve :: Int -> [Int] -> Int
solve _ [] = 0
solve mn (x:xs)
 | x > mn = length xs + 1
 | otherwise = solve (min mn x) xs

main :: IO ()
main = getContents >>= print. (\arr -> solve (head arr) arr). reverse. map read. tail. words

main :: IO ()
main = do
    coStr <- getLine
    let n = read coStr
    coStr2 <- getLine
    let a = map read $ words coStr2
    putStrLn $ show $ n - (old a 0)

--solve
old :: [Int] -> Int -> Int
old [] p = p
old [x] p = p+1
old (x:y:ys) p = if x < y then old (y:ys) (p+1) else old (y:ys) 0

old1 [] p = p
old1 [a] p = a:p
old1 (x:y:ys) p = if x < y then old1 (y:ys) (x:p) else old1 (y:ys) []

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

main = do
	getLine
	as <- map read . words <$> getLine
	print $ solve as

solve :: [Int] -> Int
solve (1:as) = 0
solve (a:as) = 1 + solve as

mins :: Ord a => [a] -> [a]
mins [x] = [x]
mins (x:xs) = let (y:ys) = mins xs in (min x y):y:ys

main = do
    getLine
    a <- map read `fmap` words `fmap` getLine :: IO [Int]
    print $ sum $ map (\(a, b) -> if a > b then 1 else 0) $
        zip a $ mins a

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

solve :: Int -> [Int] -> Int
solve _ [] = 0
solve mn (x:xs)
 | x > mn = length xs + 1
 | otherwise = solve (min mn x) xs

main :: IO ()
main = getContents >>= print. (\arr -> solve (head arr) arr). map read. tail. words

main :: IO ()
main = do
    coStr <- getLine
    let n = read coStr
    coStr2 <- getLine
    let a = map read $ words coStr2
    putStrLn $ show $ n - (old a)

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


Scrooge McDuck keeps his most treasured savings in a home safe with a combination lock. Each time he wants to put there the treasures that he's earned fair and square, he has to open the lock.  The combination lock is represented by n rotating disks with digits from 0 to 9 written on them. Scrooge McDuck has to turn some disks so that the combination of digits on the disks forms a secret combination. In one move, he can rotate one disk one digit forwards or backwards. In particular, in one move he can go from digit 0 to digit 9 and vice versa. What minimum number of actions does he need for that?

The first line contains a single integer n (1 ≤ n ≤ 1000) — the number of disks on the combination lock. The second line contains a string of n digits — the original state of the disks. The third line contains a string of n digits — Scrooge McDuck's combination that opens the lock.

Print a single integer — the minimum number of moves Scrooge McDuck needs to open the lock.

NoteIn the sample he needs 13 moves:  1 disk:   2 disk:   3 disk:   4 disk:   5 disk:

module Main (main)
    where

import Data.Char (digitToInt)
import Control.Monad (replicateM)

readInts :: String -> [Int]
readInts = map digitToInt

main :: IO ()
main = print . solve . map readInts =<< (getLine >> replicateM 2 getLine)
    where solve [xs,ys] = sum $ zipWith moves xs ys
          moves a b = min (abs $ a - b) (9 - max a b + min a b + 1)

f_ a b =
    let c1 = min a b ; c2 = max a b in min (abs (c1-c2)) (abs (c1 + (10-c2)))

f str str2 = sum $ zipWith (f_) (map (read . (:[])) str) (map (read . (:[])) str2)

main = do {
    getLine ;
    str1 <- getLine ;
    str2 <- getLine ;
    putStrLn (show $ f str1 str2)
}

conv ppp lst
  | (null ppp) = lst
  | otherwise = conv (tail ppp) (lst ++ [((read [head ppp])::Int)])

lock aa bb sum
  | (null aa) = sum
  | otherwise = lock (tail aa) (tail bb) (sum + (minimum [(abs (one-two)), ((10-one) + two),
                                                         (one + (10-two))]))
                where one = (head aa)
                      two = (head bb)

main = do
  ff <- getLine
  gg <- getLine
  hh <- getLine

  let ans = lock (conv gg []) (conv hh []) 0

  -- let cc = conv gg []
  -- putStrLn (show cc)

  putStrLn (show ans)

import Control.Applicative

toNumbers = map toInt

toInt :: Char -> Int
toInt x = read [x]

distance (a, b) =
  if a <= b
  then min (9+a-b+1) (b-a)
  else distance (b, a)

totalmoves xs ys = sum $ map distance (zip xs ys)

main = do
  n <- getLine
  a <- toNumbers <$> getLine
  b <- toNumbers <$> getLine
  let result = totalmoves a b
  print result

import Data.Char
import Data.Foldable as F
import Data.Monoid as M

readInt :: IO Int
readInt = do
    i <- getLine
    return $ read i

readIntString :: IO [Int]
readIntString = do
    s <- getLine
    return $ map (digitToInt) s

minMoves :: [Int] -> [Int] -> Int
minMoves s1 s2 = M.getSum $ F.foldMap (\(mn, mx) -> M.Sum $ min (mx - mn) (mn - mx + 10)) (map minMax (zip s1 s2) )
    where minMax = \(x,y) -> (min x y, max x y)

main :: IO ()
main = do
    n <- readInt
    s1 <- readIntString
    s2 <- readIntString
    putStrLn $ show $ minMoves s1 s2

import Data.Char

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

  let
    f a b = min (abs (a'-b')) (10 - abs (a' - b'))
      where
        a' = ord a
        b' = ord b

  print $ sum $ zipWith f s t

import Data.Char (digitToInt)
main = do
  w <- getLine
  w0 <- getLine
  let a = [digitToInt n|n <- w0]
  w1 <- getLine
  let b = [digitToInt n|n <- w1]
  print $ sum $ map f (zip a b)
      where f x = min t (10-t) where t = abs((snd x) - (fst x))

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
main= readsolveprint
readsolveprint::IO()
readsolveprint =  solve.tail =<< forM [1..3] (\i -> getLine)
solve [xs,ys] = print $ sum $ zipWith (\ a b -> let c = abs $ digitToInt a - digitToInt b in minimum [c,10-c]) xs ys

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

moves :: Char -> Char -> Int
moves a b = min d (10 - d)
    where d = abs $ digitToInt a - digitToInt b

solve :: String -> String -> Int
solve s t = sum $ zipWith moves s t

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

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

process q1 q2 = sum $ zipWith (\z1 z2 -> min (abs (z1 - z2)) (10-(abs (z1-z2))) ) sq1 sq2
   where sq1 =map digitToInt q1
         sq2 = map digitToInt q2

main=do
    n<-     read  <$> getLine::IO Integer
    [q1,q2]<-     lines <$> getContents
    print $ process q1 q2

import Control.Applicative ((<$>), (<*>))
import Data.Char (digitToInt)

main :: IO ()
main = getLine >> solve <$> (map digitToInt <$> getLine) <*> (map digitToInt <$> getLine) >>= print

solve :: [Int] -> [Int] -> Int
solve xs ys = sum $ zipWith (\x y -> 5 - abs (abs (x - y) - 5)) xs ys

import Control.Monad
main = do
  getLine
  print.sum =<< liftM2 (zipWith diff) getLine getLine
diff a b = abs ( (fromEnum a - fromEnum b + 5) `mod` 10 - 5 )

import Control.Monad
import System.IO

online = True
file = "in.txt"

main = do
    handle <- if online then return stdin else openFile file ReadMode
    let gl = hGetLine handle
    gl
    a <- gl
    b <- gl
    putStrLn $ show $ solve a b

solve :: [Char] -> [Char] -> Int
solve a b = sum $ zipWith delta a b

delta :: Char -> Char -> Int
delta x y
    | a > b = d b a
    | otherwise = d a b
    where
    a = read [x]
    b = read [y]

d a b = min (b-a) (a+10-b)

getLines :: IO String -> Int -> IO [String]
getIntList :: IO String -> IO [Int]
getList :: IO String -> IO [String]
toIntTuple :: String -> (Int, Int)

getIntList gl = gl >>= return.(map read).words
getList gl = gl >>= return.words
getLines gl n = replicateM n gl
toTuple x = (words x !! 0, words x !! 1)
toIntTuple x = (read $ words x !! 0, read $ words x !! 1)

import Data.Char

minMoves :: [Int] -> [Int] -> Int
minMoves xs ys = sum $ zipWith unitMinMoves xs ys
  where
  unitMinMoves x y = if i < j then i else j
    where
    i = abs $ x - y
    j = 10 - i

main :: IO ()
main = do
  _ <- fmap (read :: String -> Int) getLine
  origin <- fmap (map digitToInt) getLine
  answer <- fmap (map digitToInt) getLine
  print $ minMoves origin answer

import Data.Char

minMoves :: [Int] -> [Int] -> Int
minMoves xs ys = sum $ zipWith unitMinMoves xs ys
  where
  unitMinMoves x y = if i < j then i else j
    where
    i = abs $ x - y
    j = 10 - i

main :: IO ()
main = do
  n <- fmap (read :: String -> Int) getLine
  origin <- fmap (map digitToInt) getLine
  answer <- fmap (map digitToInt) getLine
  print $ minMoves origin answer

import Data.Char

main :: IO ()

main = do
    _ <- getLine
    s1 <- getLine
    s2 <- getLine
    putStrLn $ show $ sum $ zipWith (\x y ->
        let
            c1 = ord(x) - ord('0')
            c2 = ord(y) - ord('0')
            m1 = min c1 c2
            m2 = max c1 c2
        in min (m2 - m1) (m1 + 10 - m2)) s1 s2

module Main where

alphNumber :: Char -> Int
alphNumber x = (fromEnum x - fromEnum '0')

main = do
    n <- getLine
    strF <- getLine
    strS <- getLine
    print $ sum
          $ map (\(x, y) -> min
                (mod ((alphNumber y) - (alphNumber x)) 10)
                (mod ((alphNumber x) - (alphNumber y)) 10) )
          $ zip strF strS
    return ()

import Control.Applicative
import Data.Char

process (x,y) = min (mod (xx-yy) 10) (mod (yy-xx) 10)
	where 	xx = ord x
		yy = ord y

main= do
	getLine
	[a,b]<-sequence [getLine,getLine]
	print $ sum $ map process $ zip a b

import Data.Char

distance :: [Int] -> [Int] -> Int
distance xs ys = sum $ zipWith d xs ys

d :: Int -> Int -> Int
d a b = min ((b - a) `mod` 10) ((a - b) `mod` 10)

solve :: String -> String
solve s = show $ distance xs ys
    where _:xs:ys:_ = fmap (fmap digitToInt) . lines $ s

main :: IO ()
main = interact $ solve

import Data.Char

solve :: String -> String -> Int
solve [] [] = 0
solve (x:xs) (y:ys) = m + solve xs ys where
    a = min (digitToInt x) (digitToInt y)
    b = max (digitToInt x) (digitToInt y)
    m = min (b - a) (10 + a - b)

main :: IO ()
main = do
    input <- getContents
    let [xs, ys] = tail $ lines input
    print $ solve xs ys

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

process q1 q2 = sum $ zipWith (\z1 z2 -> min (abs (z1 - z2)) (abs (10-z1+z2))) sq1 sq2
   where sq1 =map digitToInt q1
         sq2 = map digitToInt q2

main=do
    n<-     read  <$> getLine::IO Integer
    [q1,q2]<-     lines <$> getContents
    print $ process q1 q2


It has been noted that if some ants are put in the junctions of the graphene integer lattice then they will act in the following fashion: every minute at each junction (x, y) containing at least four ants a group of four ants will be formed, and these four ants will scatter to the neighbouring junctions (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) — one ant in each direction. No other ant movements will happen. Ants never interfere with each other.Scientists have put a colony of n ants into the junction (0, 0) and now they wish to know how many ants will there be at some given junctions, when the movement of the ants stops.

First input line contains integers n (0 ≤ n ≤ 30000) and t (1 ≤ t ≤ 50000), where n is the number of ants in the colony and t is the number of queries. Each of the next t lines contains coordinates of a query junction: integers xi, yi ( - 109 ≤ xi, yi ≤ 109). Queries may coincide. It is guaranteed that there will be a certain moment of time when no possible movements can happen (in other words, the process will eventually end).

Print t integers, one per line — the number of ants at the corresponding junctions when the movement of the ants stops.

NoteIn the first sample the colony consists of the one ant, so nothing happens at all.In the second sample the colony consists of 6 ants. At the first minute 4 ants scatter from (0, 0) to the neighbouring junctions. After that the process stops.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.Ix

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

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
{-# INLINE rep #-}

main :: IO ()
main = do
  [n,t] <- map read.words <$> getLine
  xys <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve n xys

solve :: Int -> [Int] -> [Int]
solve n xys = go $ map abs xys
   where
     !res = simulate n
     go (x:y:rest)
       | x<limx && y<limy = unsafeAt res (x*limy+y) : go rest
       | otherwise = 0 : go rest
     go _ = []

limx :: Int
limx=65
limy :: Int
limy=65

simulate :: Int -> UArray (Int,Int) Int
simulate n = runSTUArray $ do
  a <- newArray ((0,0),(limx-1,limy-1)) 0 :: ST s (STUArray s (Int,Int) Int)
  unsafeWrite a 0 n
  replicateM_ 25623 $ do
    rep limx $ \x-> do
      rep limy $ \y-> do
        axy <- unsafeRead a $ x*limy+y
        when (axy>=4) $ do
          unsafeModify a (x*limy+y) (subtract 4)
          forM_ [(x-1,y),(x,y-1),(x+1,y),(x,y+1)] $ \ (nx,ny)-> do
            when (0<=nx && nx<limx && 0<=ny && ny<limy) $ do
              unsafeModify a (nx*limy+ny) (1+)
              when((nx==0&&x==1)||(ny==0&&y==1)) $ do
                unsafeModify a (nx*limy+ny) (1+)
  return a

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Array.Base
import Data.Array.IO
import qualified Data.List as L

main :: IO ()
main = do
  [n, t] <- map read . words <$> getLine
  m <- newArray (0, 4900) 0
  unsafeWrite m 0 n
  sim m
  mapM_ ((print =<<) . solve m . map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

sim :: IOUArray Int Int -> IO (IOUArray Int Int)
sim arr = do
  notChanged <- foldM f True [0..4900]
  if notChanged then return arr else sim arr
  where
  f notChanged xy = do
    n <- unsafeRead arr xy
    if n < 4 then do
      return notChanged
    else do
      let (q, r) = n `quotRem` 4
      let (x, y) = xy `quotRem` b
      sequence_ [unsafeWrite arr i . (+ d) =<< unsafeRead arr i | (i, d) <-
        (if x == 0 then [] else if x == 1 then [(xy - b, 2 * q)] else [(xy - b, q)]) ++
        (if y == x then [] else if y == x + 1 then if x == 0 then [(0, 4 * q), (b + 1, 2 * q)] else [(xy - 1, 2 * q), (xy + b, 2 * q)] else [(xy - 1, q), (xy + b, q)]) ++
        [(xy + 1, q)]]
      unsafeWrite arr xy r
      return False

solve :: IOUArray Int Int -> [Int] -> IO Int
solve m xy
  | y >= b = return 0
  | otherwise = unsafeRead m (x * b + y)
  where
  [x, y] = L.sort $ map abs xy

b :: Int
b = 70

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Array.Base
import Data.Array.IO
import Data.List (sort)

main :: IO ()
main = do
  [n, t] <- liftM (map read . words) getLine
  m <- newArray (0, 4900) 0
  unsafeWrite m 0 n
  sim m
  mapM_ ((print =<<) . solve m . map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

sim :: IOUArray Int Int -> IO (IOUArray Int Int)
sim arr = do
  notChanged <- foldM f True [0..4900]
  if notChanged then return arr else sim arr
  where
  f notChanged xy = do
    n <- unsafeRead arr xy
    if n < 4 then do
      return notChanged
    else do
      let (q, r) = n `quotRem` 4
      let (x, y) = xy `quotRem` b
      sequence_ [unsafeWrite arr i . (+ d) =<< unsafeRead arr i | (i, d) <-
        (if x == 0 then [] else if x == 1 then [(xy - b, 2 * q)] else [(xy - b, q)]) ++
        (if y == x then [] else if y == x + 1 then if x == 0 then [(0, 4 * q), (b + 1, 2 * q)] else [(xy - 1, 2 * q), (xy + b, 2 * q)] else [(xy - 1, q), (xy + b, q)]) ++
        [(xy + 1, q)]]
      unsafeWrite arr xy r
      return False

solve :: IOUArray Int Int -> [Int] -> IO Int
solve m xy
  | y >= b = return 0
  | otherwise = unsafeRead m (x * b + y)
  where
  [x, y] = sort $ map abs xy

b :: Int
b = 70

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import qualified Data.IntMap.Strict as M

main :: IO ()
main = do
  [n, t] <- map read . words <$> getLine
  let m = sim $ M.singleton 0 (M.singleton 0 n)
  mapM_ (print . solve m . map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

sim :: M.IntMap (M.IntMap Int) -> M.IntMap (M.IntMap Int)
sim base
  | all (< 4) $ concatMap (M.elems) $ M.elems base = base
  | otherwise = sim $ M.foldrWithKey' f M.empty base
  where
  f x m base = M.foldrWithKey' (g x) base m
  g :: Int -> Int -> Int -> M.IntMap (M.IntMap Int) -> M.IntMap (M.IntMap Int)
  g x y n base = M.unionsWith M.union $ base :
      [M.singleton xx $ M.singleton yy (n `div` 4) | n >= 4, [xx, yy] <- [[x-1, y], [x, y-1], [x, y+1], [x+1, y]]] ++
      [M.singleton x $ M.singleton y (n `mod` 4) | n `mod` 4 > 0]

solve :: M.IntMap (M.IntMap Int) -> [Int] -> Int
solve m [x, y]
  | x `M.member` m && y `M.member` (m M.! x) = m M.! x M.! y
  | otherwise = 0


Polycarp lives on the coordinate axis $$$Ox$$$ and travels from the point $$$x=a$$$ to $$$x=b$$$. It moves uniformly rectilinearly at a speed of one unit of distance per minute.On the axis $$$Ox$$$ at the point $$$x=c$$$ the base station of the mobile operator is placed. It is known that the radius of its coverage is $$$r$$$. Thus, if Polycarp is at a distance less than or equal to $$$r$$$ from the point $$$x=c$$$, then he is in the network coverage area, otherwise — no. The base station can be located both on the route of Polycarp and outside it.Print the time in minutes during which Polycarp will not be in the coverage area of the network, with a rectilinear uniform movement from $$$x=a$$$ to $$$x=b$$$. His speed — one unit of distance per minute.

The first line contains a positive integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. In the following lines are written $$$t$$$ test cases. The description of each test case is one line, which contains four integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$r$$$ ($$$-10^8 \le a,b,c \le 10^8$$$, $$$0 \le r \le 10^8$$$) — the coordinates of the starting and ending points of the path, the base station, and its coverage radius, respectively. Any of the numbers $$$a$$$, $$$b$$$ and $$$c$$$ can be equal (either any pair or all three numbers). The base station can be located both on the route of Polycarp and outside it.

Print $$$t$$$ numbers — answers to given test cases in the order they are written in the test. Each answer is an integer — the number of minutes during which Polycarp will be unavailable during his movement.

NoteThe following picture illustrates the first test case.     Polycarp goes from $$$1$$$ to $$$10$$$. The yellow area shows the coverage area of the station with a radius of coverage of $$$1$$$, which is located at the point of $$$7$$$. The green area shows a part of the path when Polycarp is out of coverage area.

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Int]
getIntList = fmap (map read) getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b, c, r] <- getIntList
        print $ f a b c r

d :: Int -> Int -> Int
d x y = abs (x - y)

inf :: Int
inf = 1000 ^ 3

f :: Int -> Int -> Int -> Int -> Int
f a b c r =
    let {
        ins x = and [c - r <= x, x <= c + r]
    } in
    minimum [
        d a b,
        if and [ins a, ins b] then 0 else inf,
        if ins a then minimum [d b (c - r), d b (c + r)] else inf,
        if ins b then minimum [d a (c - r), d a (c + r)] else inf,
        d a (c - r) + d b (c + r),
        d a (c + r) + d b (c - r)
    ]

import Control.Monad

solve :: Int -> Int -> Int -> Int -> Int
solve a' b' c r = s1 + s2
  where
    (a,b) = (min a' b',max a' b')
    c1 = c - r
    c2 = c + r
    s1 = max 0 $ (min b c1) - a
    s2 = max 0 $ b - (max a c2)

routine :: IO ()
routine = do
  [a,b,c,r] <- (map read.words) <$> getLine
  print $ solve a b c r

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

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

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

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

    --main cycle
    repeatNTimes q (do
        input2 <- getLine
        let input2spl = wordsWhen(==' ') input2
        let a = read (input2spl !! 0) :: Int
        let b = read (input2spl !! 1) :: Int
        let c = read (input2spl !! 2) :: Int
        let r = read (input2spl !! 3) :: Int

        let minAB = min a b
        let maxAB = max a b
        let left = c - r
        let right = c + r
        let st = max left minAB
        let ed = min right maxAB
        print (maxAB - minAB - (max 0 (ed - st)))
        )

module Main where
import Control.Monad

isin :: (Ord a) => a -> (a, a) -> Bool
isin x (l, r) = x >= l && x <= r

calc :: Int -> Int -> Int -> Int -> Int
calc a b c r | a > b                    = calc b a c r
             | v1 && v2 = 0
             | v1 && not v2 = b - c - r
             | not v1 && v2 = c - r - a
             | not v1 && not v2 && not v3 = b - a
             | otherwise = b - a - 2*r
    where conv = (c - r, c + r)
          v1   = isin a conv
          v2   = isin b conv
          v3   = isin c (a, b)

main = do
    n <- fmap (\x -> read x :: Int) getLine
    replicateM_ n $ do
        [a, b, c, r] <- (map read.words) `fmap` getLine
        putStrLn . show $! calc a b c r

hasNoSignal :: Int -> Int -> Int -> Bool
hasNoSignal c r x = x < (c-r) || x > (c+r-1)

solve :: Int -> Int -> Int -> Int -> Int
solve a b c r
  | b-1 < c-r = b-a
  | c+r-1 < a = b-a
  | c-r <=a && (b-1) <= c+r-1 = 0
  | a <= (c-r) && (c+r) <= b = c-r-a+b-c-r -- ok
  | c-r <= b-1 && b-1 <= c+r-1 = c-r-a
  | c-r <= a && a <= c+r = b-c-r -- ok

parse :: String -> String
parse input
  | a <= b = show $ solve a b c r
  | otherwise = show $ solve b a c r
  where [a, b, c, r] = map (\x -> read x :: Int) $ words input

main :: IO ()
main = interact (unlines . map parse . tail . lines)

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Int]
getIntList = fmap (map read) getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b, c, r] <- getIntList
        print $ f a b c r

d :: Int -> Int -> Int
d x y = abs (x - y)

inf :: Int
inf = 1000 ^ 4

f :: Int -> Int -> Int -> Int -> Int
f a b c r =
    let {
        ins x = and [c - r <= x, x <= c + r]
    } in
    minimum [
        d a b,
        if and [ins a, ins b] then 0 else inf,
        if ins a then minimum [d b (c - r), d b (c + r)] else inf,
        if ins b then minimum [d a (c - r), d a (c + r)] else inf,
        d a (c - r) + d b (c + r),
        d a (c + r) + d b (c - r)
    ]


You are playing a very popular computer game. The next level consists of $$$n$$$ consecutive locations, numbered from $$$1$$$ to $$$n$$$, each of them containing either land or water. It is known that the first and last locations contain land, and for completing the level you have to move from the first location to the last. Also, if you become inside a location with water, you will die, so you can only move between locations with land.You can jump between adjacent locations for free, as well as no more than once jump from any location with land $$$i$$$ to any location with land $$$i + x$$$, spending $$$x$$$ coins ($$$x \geq 0$$$).Your task is to spend the minimum possible number of coins to move from the first location to the last one.Note that this is always possible since both the first and last locations are the land locations.

There are several test cases in the input data. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. This is followed by the test cases description. The first line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the number of locations. The second line of the test case contains a sequence of integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 1$$$), where $$$a_i = 1$$$ means that the $$$i$$$-th location is the location with land, and $$$a_i = 0$$$ means that the $$$i$$$-th location is the location with water. It is guaranteed that $$$a_1 = 1$$$ and $$$a_n = 1$$$.

For each test case print a single integer — the answer to the problem.

NoteIn the first test case, it is enough to make one free jump from the first location to the second one, which is also the last one, so the answer is $$$0$$$.In the second test case, the only way to move from the first location to the last one is to jump between them, which will cost $$$4$$$ coins.In the third test case, you can jump from the first location to the third for $$$2$$$ coins, and then jump to the fourth location for free, so the answer is $$$2$$$. It can be shown that this is the optimal way.

(>>>) :: (a -> b) -> (b -> c) -> (a -> c)
(>>>) = flip (.)

main :: IO ()
main = interact $
  lines >>> drop 1 >>> chunksOf 2
  >>> map (last >>> words >>> map read >>> solve >>> show)
  >>> unlines

solve :: [Int] -> Int
solve = dropWhile (== 1) >>> reverse >>> dropWhile (== 1) >>> length >>> inc
  where
    inc 0 = 0
    inc x = x + 1

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

(>>>) :: (a -> b) -> (b -> c) -> (a -> c)
(>>>) = flip (.)

main :: IO ()
main = interact $
  lines >>> drop 1 >>> chunksOf 2
  >>> map (last >>> words >>> map read >>> solve >>> show)
  >>> unlines

solve :: [Int] -> Int
solve = dropWhile (== 1) >>> reverse >>> dropWhile (== 1) >>> length >>> (1 +)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts


Berland has n cities, some of them are connected by bidirectional roads. For each road we know whether it is asphalted or not.The King of Berland Valera II wants to asphalt all roads of Berland, for that he gathered a group of workers. Every day Valera chooses exactly one city and orders the crew to asphalt all roads that come from the city. The valiant crew fulfilled the King's order in a day, then workers went home.Unfortunately, not everything is as great as Valera II would like. The main part of the group were gastarbeiters — illegal immigrants who are enthusiastic but not exactly good at understanding orders in Berlandian. Therefore, having received orders to asphalt the roads coming from some of the city, the group asphalted all non-asphalted roads coming from the city, and vice versa, took the asphalt from the roads that had it.Upon learning of this progress, Valera II was very upset, but since it was too late to change anything, he asked you to make a program that determines whether you can in some way asphalt Berlandian roads in at most n days. Help the king.

The first line contains two space-separated integers n, m  — the number of cities and roads in Berland, correspondingly. Next m lines contain the descriptions of roads in Berland: the i-th line contains three space-separated integers ai, bi, ci (1 ≤ ai, bi ≤ n; ai ≠ bi; 0 ≤ ci ≤ 1). The first two integers (ai, bi) are indexes of the cities that are connected by the i-th road, the third integer (ci) equals 1, if the road was initially asphalted, and 0 otherwise.  Consider the cities in Berland indexed from 1 to n, and the roads indexed from 1 to m. It is guaranteed that between two Berlandian cities there is not more than one road.

In the first line print a single integer x (0 ≤ x ≤ n) — the number of days needed to asphalt all roads. In the second line print x space-separated integers — the indexes of the cities to send the workers to. Print the cities in the order, in which Valera send the workers to asphalt roads. If there are multiple solutions, print any of them.  If there's no way to asphalt all roads, print "Impossible" (without the quotes).

import qualified Data.List as L
import qualified Data.Set  as S
import qualified Data.Map  as M
import qualified Data.Array as A
import Control.Monad
import Data.Char
import Data.Maybe

solve :: Int -> Int -> [(Int,Int,Int)] -> [Int]
solve n m g = search M.empty (S.fromList [1..n]) graph g
    where
        g' = do (a,b,c) <- g
                [(a,(b,c)),(b,(a,c))]
        graph = A.accumArray (flip (:)) [] (1,n) g'

search :: M.Map Int Int -> S.Set Int -> A.Array Int [(Int,Int)] ->[(Int,Int,Int)] -> [Int]
search fixedMap unfixedSet graph edges
    | S.null unfixedSet = [v | (v,t) <- M.assocs fixedMap, t==1]
    | otherwise = if isValid m1 edges then
                        search m1 s1 graph edges
                  else if isValid m2 edges then
                        search m2 s2 graph edges
                  else
                        []
        where s = S.findMin unfixedSet
              (m1,s1) = fill fixedMap unfixedSet [(s,1)] [] graph
              (m2,s2) = fill fixedMap unfixedSet [(s,0)] [] graph

isValid :: M.Map Int Int -> [(Int,Int,Int)]-> Bool
isValid fixedMap edges= and [ c `mod` 2 == 1| (a,b,t) <- edges,
                                              let m = do x <- M.lookup a fixedMap
                                                         y <- M.lookup b fixedMap
                                                         return (x+y+t),
                                              isJust m,
                                              let c = fromJust m]

fill fixedMap unfixedSet [] [] graph = (fixedMap,unfixedSet)
fill fixedMap unfixedSet [] que graph = fill fixedMap unfixedSet que [] graph
fill fixedMap unfixedSet ((v,b):xs) nque graph
  | M.member v fixedMap = fill fixedMap unfixedSet xs nque graph
  | otherwise           =
      let fixedMap'   = M.insert v b fixedMap
          unfixedSet' = S.delete v unfixedSet
          vlist       = graph A.! v
          nque'       = L.foldl' (\e (x,c) ->  if b == c then ((x,1):e) else ((x,0):e)) nque vlist
      in
        fill fixedMap' unfixedSet' xs nque' graph

main :: IO ()
main = do [n,m] <- (getLine >>= return . map readInt . words)
          graph <- sequence (replicate m (getLine >>= (\[a,b,c] -> return (a,b,c)) . map readInt . words))
          let l = solve n m graph
          when (null l) (putStrLn "Impossible")
          when (not (null l)) ((putStrLn . show . length $ l) >> (putStrLn . unwords . map show $ l))

readInt :: String -> Int
readInt ('-':xs) = -readInt xs
readInt xs       = L.foldl' (\ e c -> digitToInt c + e * 10) 0 xs


You are given a matrix consisting of $$$n$$$ rows and $$$m$$$ columns. Each cell of this matrix contains $$$0$$$ or $$$1$$$.Let's call a square of size $$$2 \times 2$$$ without one corner cell an L-shape figure. In one operation you can take one L-shape figure, with at least one cell containing $$$1$$$ and replace all numbers in it with zeroes.Find the maximum number of operations that you can do with the given matrix.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 500$$$) — the number of test cases. Then follow the descriptions of each test case. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$2 \leq n, m \leq 500$$$) — the size of the matrix. Each of the following $$$n$$$ lines contains a binary string of length $$$m$$$ — the description of the matrix. It is guaranteed that the sum of $$$n$$$ and the sum of $$$m$$$ over all test cases does not exceed $$$1000$$$.

For each test case output the maximum number of operations you can do with the given matrix.

NoteIn the first testcase one of the optimal sequences of operations is the following (bold font shows l-shape figure on which operation was performed):   Matrix before any operation was performed:  101111011110  Matrix after $$$1$$$ operation was performed:  100101011110  Matrix after $$$2$$$ operations were performed:  100100011110  Matrix after $$$3$$$ operations were performed:  100100010110  Matrix after $$$4$$$ operations were performed:  100000010110  Matrix after $$$5$$$ operations were performed:  100000010100  Matrix after $$$6$$$ operations were performed:  100000000100  Matrix after $$$7$$$ operations were performed:  000000000100  Matrix after $$$8$$$ operations were performed:  000000000000 In the third testcase from the sample we can not perform any operation because the matrix doesn't contain any ones.In the fourth testcase it does not matter which L-shape figure we pick in our first operation. We will always be left with single one. So we will perform $$$2$$$ operations.

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import System.IO                    (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map
import Data.Map.Strict       (Map)

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n, m] <- ri
        matr   <- replicateM n getLine
        return (n,m,matr)
    mapM_ (putStrLn.show.solve) tcs

solve (n,m,matr) = cntOnes - minPenalty
  where
    mmap = Map.fromList . zip (inds (n,m)) . concat $ matr

    sqs = map (getSq mmap) . inds $ (n-1, m-1)

    minPenalty = minimum . map penalty $ sqs

    cntOnes = cnt1 . concat $ matr

inds :: (Int,Int) -> [(Int,Int)]
inds (n,m) = [(r,c) | r <- [1..n], c <- [1..m]]

getSq :: Map (Int,Int) Char -> (Int,Int) -> [Char]
getSq m (r,c) = [m!x, m!y, m!z, m!t]
  where
    (!) = (Map.!)
    x = (r  , c  )     :: (Int,Int)
    y = (r  , c+1)
    z = (r+1, c  )
    t = (r+1, c+1)

cnt1 = length . filter (=='1')

penalty = f . cnt1
  where
    f 0 = 0 :: Int
    f 1 = 0
    f 2 = 0
    f 3 = 1
    f 4 = 2
    f _ = error "impossible number of cells in a square"


Limak is a little polar bear. He likes nice strings — strings of length n, consisting of lowercase English letters only.The distance between two letters is defined as the difference between their positions in the alphabet. For example, , and .Also, the distance between two nice strings is defined as the sum of distances of corresponding letters. For example, , and .Limak gives you a nice string s and an integer k. He challenges you to find any nice string s' that . Find any s' satisfying the given conditions, or print "-1" if it's impossible to do so.As input/output can reach huge size it is recommended to use fast input/output methods: for example, prefer to use gets/scanf/printf instead of getline/cin/cout in C++, prefer to use BufferedReader/PrintWriter instead of Scanner/System.out in Java.

The first line contains two integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ 106). The second line contains a string s of length n, consisting of lowercase English letters.

If there is no string satisfying the given conditions then print "-1" (without the quotes). Otherwise, print any nice string s' that .

{-# OPTIONS_GHC -O1 #-}

import Data.Char (ord, chr)

main = do
  [n, k] <- fmap (map read . words) getLine
  s <- getLine

  let
    d c1 c2 = abs $ ord c1 - ord c2
    m = sum $ map (\c -> max (d 'a' c) (d 'z' c)) s

    f [] 0 = []
    f (c:s) m
      | d1 > d2 && m >= d1 = 'a':(f s (m - d1))
      | d2 > d1 && m >= d2 = 'z':(f s (m - d2))
      | m < d1 = (chr (ord c - m)):(f s 0)
      | m < d2 = (chr (ord c + m)):(f s 0)
      where
        d1 = d 'a' c
        d2 = d 'z' c

  -- let check s t = sum $ zipWith d s t
  -- print $ check s (f s k)

  if k > m
     then print $ -1
     else putStrLn $ f s k

import Control.Monad
import Data.Maybe
import Data.Char (ord, chr)

main = do
    [_,k] <- liftM (map read . words) (getLine) :: IO [Int]
    s <- getLine
    putStrLn  . fromMaybe "-1" $ solve s k

solve :: String -> Int -> Maybe String
solve s 0 = Just s
solve [] k = Nothing
solve (x:xs) k
    | mx >= k       = Just ((withDist k x):xs)
    | otherwise     = case rest of
        Just r  -> Just (mc:r)
        Nothing -> Nothing
    where
        rest = solve xs (k - mx)
        mc = if (ord x > ord 'm') then 'a' else 'z'
        mx = abs (ord mc - ord x)

withDist k c
    | (ord c <= ord 'm') = chr (ord c + k)
    | otherwise          = chr (ord c - k)

import Data.Char

main = interact $ sol . words

sol [_, k', s]
    | (read k') > totSlot = "-1"
    | otherwise = sub (read k') s
    where
    totSlot = sum . map maxDis $ s
    sub 0 str = str
    sub k (x:xs)
        | maxDis x < k = toMaxDis x : (sub (k - maxDis x) xs)
        | otherwise = toDis k x : (sub 0 xs)
    maxDis ch = max (cur-a) (z-cur)
        where
        a = ord 'a'
        z = ord 'z'
        cur = ord ch
    toMaxDis ch
        | dist 'a' ch > dist 'z' ch = 'a'
        | otherwise = 'z'
        where
        dist c1 c2 = abs $ ord c1 - ord c2
    toDis k ch
        | r1 <= z && r1 >= a = chr r1
        | otherwise = chr r2
        where
        a = ord 'a'
        z = ord 'z'
        r1 = ord ch + k
        r2 = ord ch - k

{-
instructions go here...
-}

module Main where
import Data.Char(ord,chr)

solve :: String -> Int -> (String,Int)
solve "" remaining     = ("", remaining)
solve css 0            = (css, 0) -- optimization
solve (c:cs) remaining = (c':cs', remaining')
  where (c', diff) = bestDiff c remaining
        (cs', remaining') = solve cs (remaining - diff)

bestDiff :: Char -> Int -> (Char,Int)
bestDiff char distToCover = (char', abs diff)
  where char' = chr (ord char + diff)
        diff = (min distToCover maxDiff) * (if goToA then (-1) else 1)
        maxDiff = max (dist char 'a') (dist char 'z')
        goToA = (dist char 'a') >= (dist char 'z')

dist :: Char -> Char -> Int
dist c1 c2 = abs $ (ord c1) - (ord c2)

main :: IO ()
main = do
  line1 <- getLine
  let [_,k] = map read (words line1) :: [Int]
  str <- getLine
  let (str', remaining) = solve str k
  if remaining > 0
    then putStrLn $ show (-1)
    else putStrLn str'

import Control.Monad
import Data.Maybe
import Data.Char (ord, chr)

main = do
    [_,k] <- liftM (map read . words) (getLine) :: IO [Int]
    s <- getLine
    putStrLn  . fromMaybe "-1" $ solve s k

solve :: String -> Int -> Maybe String
solve s 0 = Just ""
solve [] k = Nothing
solve (x:xs) k
    | mx >= k       = Just ((withDist k x):xs)
    | otherwise     = case rest of
        Just r  -> Just (mc:r)
        Nothing -> Nothing
    where
        rest = solve xs (k - mx)
        mc = if (ord x > ord 'm') then 'a' else 'z'
        mx = abs (ord mc - ord x)

withDist k c
    | (ord c <= ord 'm') = chr (ord c + k)
    | otherwise          = chr (ord c - k)

{-
instructions go here...
-}

module Main where
import Data.Char(ord,chr)

solve :: String -> Int -> (String,Int)
solve "" k     = ("", k)
solve (x:xs) k = (x':xs', remaining)
  where (x', diff) = bestDiff x k
        (xs', remaining) = solve xs (k - diff)

bestDiff :: Char -> Int -> (Char,Int)
bestDiff char dstToCover = (char',diff)
  where char' = chr (ord char + diff)
        diff = (min dstToCover maxDiff) * (if goToA then (-1) else 1)
        maxDiff = max (dist char 'a') (dist char 'z')
        goToA = (dist char 'a') >= (dist char 'z')

dist :: Char -> Char -> Int
dist c1 c2 = abs $ (ord c1) - (ord c2)

main :: IO ()
main = do
  line1 <- getLine
  let [_,k] = map read (words line1) :: [Int]
  str <- getLine
  let (str',remaining) = solve str k
  if remaining > 0
    then putStrLn $ show (-1)
    else putStrLn str'

{-
instructions go here...
-}

module Main where
import Data.Char(ord,chr)

solve :: String -> Integer -> (String,Integer)
solve "" remaining     = ("", remaining)
solve css 0            = (css, 0) -- optimization
solve (c:cs) remaining = (c':cs', remaining')
  where (c', diff) = bestDiff c remaining
        (cs', remaining') = solve cs (remaining - diff)

bestDiff :: Char -> Integer -> (Char,Integer)
bestDiff char distToCover = (char',diff)
  where char' = chr (ord char + fromInteger diff)
        diff = (min distToCover maxDiff) * (if goToA then (-1) else 1)
        maxDiff = max (dist char 'a') (dist char 'z')
        goToA = (dist char 'a') >= (dist char 'z')

dist :: Char -> Char -> Integer
dist c1 c2 = fromIntegral $ abs $ (ord c1) - (ord c2)

main :: IO ()
main = do
  line1 <- getLine
  let [_,k] = map read (words line1) :: [Integer]
  str <- getLine
  let (str', remaining) = solve str k
  if remaining > 0
    then putStrLn $ show (-1)
    else putStrLn str'

{-
instructions go here...
-}

module Main where
import Data.Char(ord,chr)

solve :: String -> Int -> (String,Int)
solve "" remaining     = ("", remaining)
solve css 0            = (css, 0) -- optimization
solve (c:cs) remaining = (c':cs', remaining')
  where (c', diff) = bestDiff c remaining
        (cs', remaining') = solve cs (remaining - diff)

bestDiff :: Char -> Int -> (Char,Int)
bestDiff char distToCover = (char', abs diff)
  where char' = chr (ord char + diff)
        diff = (min distToCover maxDiff) * (if goToA then (-1) else 1)
        maxDiff = max (dist char 'a') (dist char 'z')
        goToA = (dist char 'a') >= (dist char 'z')

dist :: Char -> Char -> Int
dist c1 c2 = abs $ (ord c1) - (ord c2)

main :: IO ()
main = do
  line1 <- getLine
  let [_,k] = map read (words line1) :: [Int]
  str <- getLine
  let (str', remaining) = solve str k
  if remaining > 0
    then putStrLn $ show (-1) ++ " " ++ str' ++ " " ++ show remaining
    else putStrLn str'


Igor has fallen in love with Tanya. Now Igor wants to show his feelings and write a number on the fence opposite to Tanya's house. Igor thinks that the larger the number is, the more chance to win Tanya's heart he has. Unfortunately, Igor could only get v liters of paint. He did the math and concluded that digit d requires ad liters of paint. Besides, Igor heard that Tanya doesn't like zeroes. That's why Igor won't use them in his number.Help Igor find the maximum number he can write on the fence.

The first line contains a positive integer v (0 ≤ v ≤ 106). The second line contains nine positive integers a1, a2, ..., a9 (1 ≤ ai ≤ 105).

Print the maximum number Igor can write on the fence. If he has too little paint for any digit (so, he cannot write anything), print -1.

import Data.List
import Data.Function

main :: IO ()
main = interact $ solve . map read . words

solve :: [Int] -> String
solve (v : as)
  | k > 0 = show =<< replace (v `mod` n) ([1..k] >> [i])
  | otherwise = "-1"
  where
  k = v `div` n
  bs@((n, i) : _) = f $ map last $ groupBy ((==) `on` fst) $ sort $ zip as [1..]
  replace _ [] = []
  replace d (x : xs) = j : replace (n + d - m) xs
    where
    (m, j) = last $ takeWhile ((<= (n + d)) . fst) bs

f :: [(Int, Int)] -> [(Int, Int)]
f ((n, i) : (m, j) : xs)
  | i < j = (n, i) : f ((m, j) : xs)
  | otherwise = f ((n, i) : xs)
f xs = xs

import Control.Monad (liftM)
import Data.Array.Unboxed ((!), elems)
import Data.Array.ST
import Data.Char (ord, intToDigit)
import Data.List (minimumBy)
import Prelude hiding (reads)

reads :: IO [Int]
reads  =  liftM (map read . words) getLine
  where
    read ('-' : s)  =  (-1) * read s
    read s  =  read' 0 s
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + ord c - ord '0'

solve :: Int -> [Int] -> String
solve v as
  | all (== 0) (elems array)  =  "-1"
  | otherwise  =  concatMap (\d -> replicate (array ! d) (intToDigit d)) [9,8..1]
  where
    array  =  runSTUArray $ do
        array  <-  newArray (1,9) 0
        --let k  =  maxDigitWithMinimumPaint
        let ak  =  as !! (k-1)
        writeArray array k (v `div` ak)
        update array (v `mod` ak) 9
        return array
    update array p i
      | i == k  =  return ()
      | otherwise  =  do
          let ai  =  as !! (i-1)
          let ak  =  as !! (k-1)
          arrayK  <-  readArray array k
          let updateI  =  min arrayK (p `div` (ai - ak))
          let updateK  =  arrayK - updateI
          writeArray array k updateK
          writeArray array i updateI
          update array (p - updateI * (ai - ak)) (i-1)
    k  =  fst $ minimumBy compareSnd $ reverse $ zip [1..] as
    compareSnd a b  =  compare (snd a) (snd b)

main :: IO ()
main  =  do
    v  <-  readLn
    as  <-  reads
    putStrLn $ solve v as

module Main where
import System.IO
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [Int] -> String
solve v as = if digits > 0 then solve' (v-digits*cost) as' filler digits else "-1"
	where digits = maximum $ map (v `div`) as
	      minCost = minimum as
	      fillerIndex = fromJust . findIndex (== minCost) $ as
	      filler = 9 - fillerIndex
	      cost = as!!fillerIndex
	      as' = map (\x -> x - cost) as

solve' :: Int -> [Int] -> Int -> Int -> String
solve' _ _ _ 0 = ""
solve' 0 _ f n = replicate n $ (intToDigit f)
solve' v as f n = case best of
		Nothing -> solve' 0 as f n
		Just i -> (intToDigit $ 9 - i):solve' (v - (as!!i)) as f (n-1)
	where best = findIndex (<= v) as

main :: IO ()
main = do
	ls  <- B.getLine
	ls' <- B.getLine
	let v = readInt ls
	    as = map readInt . C.words $ ls'
	putStrLn $ solve v (reverse as)

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

#!/usr/bin/env runghc
import Data.List
import Data.Maybe
main = do
  c <- getContents
  putStr . unlines . solve . lines $ c

solve::[String]->[String]
solve [] = []
solve (c1:c2:cs) = s :solve cs
  where
    v = read c1
    a = reverse . map read . words $ c2
    m = minimum a
    p = (9-) . fromJust . findIndex (==m) $ a
    s =
      if v<m then "-1"
      else f (v`mod`m) (replicate (v`div`m) (head . show $ p))
    f r [] = []
    f r (n:ns) = head (show (9-i)): f (r-(a!!i)+m) ns
      where
        i = fromJust . findIndex (<=r+m) $ a

module Main where

import Control.Applicative
import Data.List

main = do
    s <- read <$> getLine
    ps <- map read <$> words <$> getLine
    putStrLn $ solve s ps

solve :: Int -> [Int] -> String
solve s ps = if s < p
             then "-1"
             else (concat $ map show l) ++ (replicate (n - length l) $ head $ show (-i) )
    where (i,p) = minimumBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $  zip [-1,-2 ..  -9] ps
          n = s `div` p
          s' = s - n*p
          l = f s' $ zip [9,8 .. 1] $ reverse $ map (\x -> x - p) ps --(sortBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $ zip [-1,-2 .. -9] $ map (\x -> x - p) ps )
          f 0 _ = []
          f _ [] = []
          f s ((i',p):xs) | p == 0 = f s xs
                          | s >= p && i'>(-i) = i' : f (s-p) ((i',p):xs)
                          | otherwise = f s xs

module Main where

--import Data.List (foldr1)
import Data.Maybe

rush :: Int -> [Int] -> Maybe [(Int,Int)]
rush v cost = if ndigits == 0 then Nothing else Just $ reverse $ (p,prin) : converted
  where (p,cp) = foldr1 (\(a,ca) (b,cb) -> if ca < cb then (a,ca) else (b,cb)) (zip [1..9] cost)
        (ndigits,res) = v `divMod` cp
        convertList = map (\(a,ca) -> (a, ca - cp)) $ filter ((> p) . fst) (zip [1..9] cost)
        converted = snd $ foldr (\(a,ca) (r,l) -> let (count, r') = r `divMod` ca in (r', (a,count):l)) (res,[]) convertList
        prin = foldr (\(_,count) c -> c - count) ndigits converted

pshow :: Maybe [(Int,Int)] -> String
pshow ml
  | isNothing ml  = "-1"
  | otherwise = concat $ do
    let l = fromJust ml
    (a, c) <- l
    return $ concat $  replicate c (show a)

main :: IO ()
main = do
  (v:cs) <- fmap ( map read . words) getContents
  putStrLn $ pshow $ rush v cs

import Data.List
import Data.Char
import Data.Maybe
import Control.Applicative
import Debug.Trace

toDigit n = chr (48 + n)

debug x = trace (show x) x
(|>) x f = f x; infixl 1 |>
(||>) x f = x >>= (return.f); infixl 1 ||>
ref = (!!)

solve :: Int -> [Int] -> String
solve v xs =
  if v < m then "-1" else solve' v (v `div` m)
  where
    m = minimum xs
    ls = reverse $ zip xs [1..9]

    solve' _ 0 = ""
    solve' v k =
      (toDigit i) : (solve' (v-u) (k-1))
      where
        (u, i) = findMax (v - (k-1)*m) ls

    findMax _ [] = undefined
    findMax v ((x,i):xs) = if v >= x then (x,i) else findMax v xs

main = do
  ls <- getContents ||> lines
  n  <- head ls |> readIO :: IO Int
  xs <- (ref ls 1) |> words |> map read |> return :: IO [Int]
  putStrLn (solve n xs)

-- vim: set ft=haskell:

module Main where
import System.IO
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [Int] -> String
solve v as = if digits > 0 then solve' (v-digits*cost) as' filler digits else "-1"
	where digits = maximum $ map (v `div`) as
	      fillerIndex = fromJust . findIndex (\x -> v `div` x == digits) $ as
	      filler = 9 - fillerIndex
	      cost = as!!fillerIndex
	      as' = map (\x -> x - cost) as

solve' :: Int -> [Int] -> Int -> Int -> String
solve' _ _ _ 0 = ""
solve' 0 _ f n = replicate n $ (intToDigit f)
solve' v as f n = case best of
		Nothing -> solve' 0 as f n
		Just i -> (intToDigit $ 9 - i):solve' (v - (as!!i)) as f (n-1)
	where best = findIndex (<= v) as

main :: IO ()
main = do
	ls  <- B.getLine
	ls' <- B.getLine
	let v = readInt ls
	    as = map readInt . C.words $ ls'
	putStrLn $ solve v (reverse as)

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

module Main where
import System.IO
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [Int] -> String
solve 0 _ = "-1"
solve v as = solve' (v-digits*(as!!fillerIndex)) as filler digits
	where digits = maximum $ map (v `div`) as
	      fillerIndex = fromJust . findIndex (\x -> v `div` x == digits) $ as
	      filler = 9 - fillerIndex

solve' :: Int -> [Int] -> Int -> Int -> String
solve' 0 _ f n = replicate n $ (intToDigit f)
solve' v as f n = case best of
		Nothing -> solve' 0 as f n
		Just i -> (intToDigit $ 9 - i):solve' (v - (as!!i)) as f (n-1)
	where best = findIndex (<= v) as

main :: IO ()
main = do
	ls  <- B.getLine
	ls' <- B.getLine
	let v = readInt ls
	    as = map readInt . C.words $ ls'
	putStrLn $ solve v (reverse as)

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

module Main where
import System.IO
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [Int] -> String
solve 0 _ = "-1"
solve v as = solve' (v-digits*cost) as' filler digits
	where digits = maximum $ map (v `div`) as
	      fillerIndex = fromJust . findIndex (\x -> v `div` x == digits) $ as
	      filler = 9 - fillerIndex
	      cost = as!!fillerIndex
	      as' = map (\x -> x - cost) as

solve' :: Int -> [Int] -> Int -> Int -> String
solve' _ _ _ 0 = ""
solve' 0 _ f n = replicate n $ (intToDigit f)
solve' v as f n = case best of
		Nothing -> solve' 0 as f n
		Just i -> (intToDigit $ 9 - i):solve' (v - (as!!i)) as f (n-1)
	where best = findIndex (<= v) as

main :: IO ()
main = do
	ls  <- B.getLine
	ls' <- B.getLine
	let v = readInt ls
	    as = map readInt . C.words $ ls'
	putStrLn $ solve v (reverse as)

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

#!/usr/bin/env runghc
import Data.List
import Data.Maybe
main = do
  c <- getContents
  putStr . unlines . solve . lines $ c

solve::[String]->[String]
solve [] = []
solve (c1:c2:cs) = r :solve cs
  where
    v = read c1
    a = reverse . map read . words $ c2
    m = minimum a
    p = (9-) . fromJust . findIndex (==m) $ a
    r =
      if v<m then "-1"
      else (show . (9-) . fromJust . findIndex (<=(v`mod`m)+m) $ a) ++ (replicate ((v`div`m)-1) (head . show $ p))

module Main where

import Control.Applicative
import Data.List

main = do
    s <- read <$> getLine
    ps <- map read <$> words <$> getLine
    putStrLn $ solve s ps

solve :: Int -> [Int] -> String
solve s ps = if s < p
             then "-1"
             else (concat $ map show l) ++ (replicate (n - length l) $ head $ show (-i) )
    where (i,p) = minimumBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $  zip [-1,-2 ..  -9] ps
          n = s `div` p
          s' = s - n*p
          l = f s' (sortBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $ zip [-1,-2 .. -9] $ map (\x -> x - p) ps )
          f 0 _ = []
          f _ [] = []
          f s ((i,p):xs) | p == 0 = f s xs
                         | s >= p = -i : f (s-p) xs
                         | otherwise = []

module Main where

import Control.Applicative
import Data.List

main = do
    s <- read <$> getLine
    ps <- map read <$> words <$> getLine
    putStrLn $ solve s ps

solve :: Int -> [Int] -> String
solve s ps = if s < p
             then "-1"
             else (concat $ map show l) ++ (replicate (n - length l) $ head $ show (-i) )
    where (i,p) = minimumBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $  zip [-1,-2 ..  -9] ps
          n = s `div` p
          s' = s - n*p
          l = f s' $ zip [9,8 .. 1] $ reverse $ map (\x -> x - p) ps --(sortBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $ zip [-1,-2 .. -9] $ map (\x -> x - p) ps )
          f 0 _ = []
          f _ [] = []
          f s ((i,p):xs) | p == 0 = f s xs
                         | s >= p = i : f (s-p) xs
                         | otherwise = f s xs

module Main where

import Control.Applicative
import Data.List

main = do
    s <- read <$> getLine
    ps <- map read <$> words <$> getLine
    putStrLn $ solve s ps

solve :: Int -> [Int] -> String
solve s ps = if s < p
             then "-1"
             else (concat $ map show l) ++ (replicate (n - length l) $ head $ show (-i) )
    where (i,p) = minimumBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $  zip [-1,-2 ..  -9] ps
          n = s `div` p
          s' = s - n*p
          l = f s' $ zip [9,8 .. 1] $ reverse $ map (\x -> x - p) ps --(sortBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $ zip [-1,-2 .. -9] $ map (\x -> x - p) ps )
          f 0 _ = []
          f _ [] = []
          f s ((i,p):xs) | p == 0 = f s xs
                         | s >= p = i : f (s-p) ((i,p):xs)
                         | otherwise = f s xs

module Main where

import Control.Applicative
import Data.List

main = do
    s <- read <$> getLine
    ps <- map read <$> words <$> getLine
    putStrLn $ solve s ps

solve :: Int -> [Int] -> String
solve s ps = if p > s
             then "-1"
             else replicate (s `div` p) $ head $ show (-i)
    where (i,p) = minimumBy (\(i1,p1) (i2,p2) -> if p1 == p2 then compare i1 i2 else compare p1 p2) $  zip [-1,-2 ..  -9] ps

import Data.List
import Data.Char
import Data.Maybe
import Control.Applicative
import Debug.Trace
debug x = trace (show x) x
(|>) x f = f x; infixl 1 |>
(||>) x f = x >>= (return.f); infixl 1 ||>
ref = (!!)

toDigit :: Int -> Char
toDigit n = chr (48 + n)

go v xs =
  if v < m then "-1" else ((toDigit $ findMax ((v`mod`m)+m)) : (take ((v`div`m) -1) mis))
  where
    (m, mi) = minRight xs
    findMax v = findMax' v (reverse xs) 9
    findMax' _ [a] _ = 1
    findMax' v (x:xs) i = if (v>=x) then i else (findMax' v xs (i-1))
    minRight ls =
      foldl (\(x, id) (y, jd) -> if x>=y then (y,jd) else (x,id))
            (1000002, -1) (zip ls [1..])
    mis = (toDigit mi) : mis

main = do
  ls <- getContents ||> lines
  v  <- head ls |> readIO :: IO Int
  xs <- (ref ls 1) |> words |> map read |> return  :: IO [Int]
  putStrLn (go v xs)

-- vim: set ft=haskell:


You are given a string $$$s$$$ consisting of $$$n$$$ lowercase Latin letters.You have to remove at most one (i.e. zero or one) character of this string in such a way that the string you obtain will be lexicographically smallest among all strings that can be obtained using this operation.String $$$s = s_1 s_2 \dots s_n$$$ is lexicographically smaller than string $$$t = t_1 t_2 \dots t_m$$$ if $$$n < m$$$ and $$$s_1 = t_1, s_2 = t_2, \dots, s_n = t_n$$$ or there exists a number $$$p$$$ such that $$$p \le min(n, m)$$$ and $$$s_1 = t_1, s_2 = t_2, \dots, s_{p-1} = t_{p-1}$$$ and $$$s_p < t_p$$$.For example, "aaa" is smaller than "aaaa", "abb" is smaller than "abc", "pqr" is smaller than "z".

The first line of the input contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the length of $$$s$$$. The second line of the input contains exactly $$$n$$$ lowercase Latin letters — the string $$$s$$$.

Print one string — the smallest possible lexicographically string that can be obtained by removing at most one character from the string $$$s$$$.

NoteIn the first example you can remove any character of $$$s$$$ to obtain the string "aa".In the second example "abca" < "abcd" < "abcda" < "abda" < "acda" < "bcda".

findChar :: String -> Int
findChar str = length $ fst $ span snd pair
    where pair = zipWith f str (drop 1 str)
          f c1 c2 = (c1, c1 <= c2)

main :: IO ()
main = do
    n <- getLine
    str <- getLine
    let i = findChar str
    putStrLn $ (take i str) ++ (drop (i+1) str)


Dima got into number sequences. Now he's got sequence a1, a2, ..., an, consisting of n positive integers. Also, Dima has got a function f(x), which can be defined with the following recurrence:  f(0) = 0;  f(2·x) = f(x);  f(2·x + 1) = f(x) + 1. Dima wonders, how many pairs of indexes (i, j) (1 ≤ i < j ≤ n) are there, such that f(ai) = f(aj). Help him, count the number of such pairs.

The first line contains integer n (1 ≤ n ≤ 105). The second line contains n positive integers a1, a2, ..., an (1 ≤ ai ≤ 109). The numbers in the lines are separated by single spaces.

In a single line print the answer to the problem. Please, don't use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams or the %I64d specifier.

NoteIn the first sample any pair (i, j) will do, so the answer is 3.In the second sample only pair (1, 2) will do.

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

main :: IO ()
main = do
    n <- getLine >>= return . read
    l <- B.getLine >>= return . map readInt . B.words
    print $ solve n l
    where
        readInt = fst . fromMaybe (0,undefined) . B.readInt

solve :: Int -> [Int] -> Int64
solve n = foldl' (+) 0 . map count . group . sort . map f
    where
        f = ftail 0
        ftail s 0 = s
        ftail s n = ftail (s + mod n 2) (div n 2)
        count l = x * (x-1) `div` 2
            where x =  fromIntegral $ length l

import Control.Monad (liftM)
import Data.List (group, sort)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> Integer
solve  =  foldl f 0 . map (toInteger . length) . group . sort . map bits
  where
    f s n  =  s + div (n * (n - 1)) 2
    bits 0  =  0
    bits m  =  mod m 2 + bits (div m 2)

main :: IO ()
main  =  getLine >> reads >>= print . solve

{-# OPTIONS_GHC -O2 #-}
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.List
readInt bs = case B.readInt bs of Just (n,_) -> n
main=B.getContents>>=print.sum.map(f.length).group.sort.map(popCount.readInt).tail.B.words

f :: Int -> Integer
f 1 = 0
f x = fromIntegral x * (fromIntegral x - 1) `quot` 2

#!/usr/bin/env runghc
import Data.List

main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (n:a:cs) = show . cpair (-1) 0 0 . sort . map f . map read $ words a
  where
    f 0 = 0
    f x = f (x `div` 2) + if x `mod` 2 == 0 then 0 else 1
    cpair p n s (x:xs) = if p==x then cpair p (n+1) s xs else cpair x 1 (s+c2 n) xs
    cpair p n s [] = c2 n + s
    c2 n = n*(n-1) `div` 2

module Main where

import Data.List

c :: Integer -> Integer
c 1 = 0
c n = n * (n - 1) `div` 2

f :: Integer -> Integer
f = f' 0
    where
      f' acc 0 = acc
      f' acc x
        | x `mod` 2 == 0
          = f' acc (x `div` 2)
        | otherwise
          = f' (acc + 1) (x `div` 2)

solve :: [Integer] -> Integer
solve = sum . map (c.(genericLength :: [Integer] -> Integer)) . group . sort

main = getLine >> getLine >>= (print . solve . map (f.read) . words)

import Control.Monad (liftM)
import Data.List (group)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> Integer
solve  =  foldl f 0 . map (toInteger . length) . group . map bits
  where
    f s n  =  s + div (n * (n - 1)) 2
    bits 0  =  0
    bits m  =  mod m 2 + bits (div m 2)

main :: IO ()
main  =  getLine >> reads >>= print . solve

module Main where

import Data.List

c :: Int -> Integer
c 1 = 0
c n = toInteger $ n * (n - 1) `div` 2

f :: Integer -> Integer
f = f' 0
    where
      f' acc 0 = acc
      f' acc x
        | x `mod` 2 == 0
          = f' acc (x `div` 2)
        | otherwise
          = f' (acc + 1) (x `div` 2)

solve :: [Integer] -> Integer
solve = sum . map (c.length) . group . sort

main = getLine >> getLine >>= (print . solve . map (f.read) . words)


A kindergarten teacher Natalia Pavlovna has invented a new ball game. This game not only develops the children's physique, but also teaches them how to count. The game goes as follows. Kids stand in circle. Let's agree to think of the children as numbered with numbers from 1 to n clockwise and the child number 1 is holding the ball. First the first child throws the ball to the next one clockwise, i.e. to the child number 2. Then the child number 2 throws the ball to the next but one child, i.e. to the child number 4, then the fourth child throws the ball to the child that stands two children away from him, i.e. to the child number 7, then the ball is thrown to the child who stands 3 children away from the child number 7, then the ball is thrown to the child who stands 4 children away from the last one, and so on. It should be mentioned that when a ball is thrown it may pass the beginning of the circle. For example, if n = 5, then after the third throw the child number 2 has the ball again. Overall, n - 1 throws are made, and the game ends.The problem is that not all the children get the ball during the game. If a child doesn't get the ball, he gets very upset and cries until Natalia Pavlovna gives him a candy. That's why Natalia Pavlovna asks you to help her to identify the numbers of the children who will get the ball after each throw.

The first line contains integer n (2 ≤ n ≤ 100) which indicates the number of kids in the circle.

In the single line print n - 1 numbers which are the numbers of children who will get the ball after each throw. Separate the numbers by spaces.

main = do getLine >>= putStrLn . unwords . (\n -> map (show . succ . (`mod` n)) $ scanl1 (+) [1 .. n - 1]) . read

game i t n =
    if t == n then (show i)
    else (show i) ++ " " ++ (game ((mod (i + t - 1) n) + 1) (t + 1) n)

main :: IO ()
main = do
  n <- getLine >>= return . read
  putStr (game 2 2 n)

-- QH9

nstep n a cp ch | (a == (n-1)) = [ch]
                | otherwise = ch:(nstep n (a+1) (cp+1) newch)
     where chcp = ch + cp
           newch = if (chcp <= n) then chcp else mod chcp n

pr [] = []
pr (x:xs) = show x ++ (' ':(pr xs))

main = do
		n <- readLn :: IO Int
		putStrLn $ pr $ nstep n 1 2 2

main=interact$unwords.map show.s.read
s n=[(i*(i+1)`div`2)`mod`n+1|i<-[1..n-1]]

main = do
    n <- readLn
    let ans = solve n 2 2
    putStr (unwords (map show ans))
solve :: Int -> Int -> Int -> [Int]
solve n a b
    | n == b - 1 = []
    | otherwise = a : solve n ((a + b - 1) `mod` n + 1) (b + 1)

import Data.List

f i cs n | i == n = pp $ tail $ reverse $ map (\x -> if x == 0 then n else x ) cs
f i all@(c:cs) n = f (i+1) (((c+i)`mod`n):all) n
pp = concat . intersperse " " . map show

main = do
     r  <- readLn :: IO Int
     putStrLn $ f 1 [1]r

next :: Int -> (Int, Int) -> (Int, Int)
next modulator (currentKinder, numStep) = (mod (currentKinder + numStep - 1) modulator + 1, numStep + 1)

solve :: Int -> [Int]
solve n = map fst (take n (iterate (next n) (1,1)))

myPrint :: [Int] -> String
myPrint [] = ""
myPrint [x] = show x
myPrint (x:xs) = (show x ++ " ") ++ (myPrint xs)

main = do
    n <- readLn::(IO Int)
    putStrLn (myPrint (tail (solve n)))

import Data.List

f::Int->Int->Int->[String]
f n a p
   |n==a=[]
   |otherwise=(show (((p+a) `mod` n)+1)):f n (a+1) ((p+a) `mod` n)

main =do
      e<-getLine
      let n=read e::Int
      putStrLn $ unwords $ f n 1 0

import Control.Applicative ((<$>))

main :: IO ()
main = putStrLn <$> unwords <$> map show =<< solve <$> readLn

solve :: Integer -> [Integer]
solve n = [ (i * (i + 1) `div` 2) `mod` n + 1 | i <- [1..n-1] ]

import Data.List
main = do
  n <- readLn
  putStrLn . unwords . map show . snd $ mapAccumL f (cycle [1..n]) [1..n-1]
f l n = (l',head l') where l' = drop n l

main = do
   input <- getContents
   let kids = (read $ head $ lines input)::Int
   putStrLn $ foldr (\x y -> x ++ " " ++ y) "" (map show $ ballGame kids)

ballGame n = ballGame' 1 0 []
    where
        ballGame' kid step acc
            | step == n-1 = acc
            | otherwise   = ballGame' val (step+1) (acc ++ [val])
            where
                sum = (kid + step + 1) `mod` n
                val = if sum == 0 then n else sum

get n = drop 1 . take n . map (\x -> fst x + 1) $ iterate next (0, 1)
    where next (a, k) = ((a+k) `mod` n, k + 1)

main = do
    n <- readLn
    putStrLn . unwords $ map show (get n)

main = interact solve
solve input = output where
  n = read input :: Int
  output = unwords $ map show $ answer 1 1 n
answer x y z = if y==z then [] else w : (answer w (y+1) z)  where
  w = mod (x+y-1) z + 1

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

main = do
		n<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show $ tail  $ map (\z-> (mod (z-1) n)+1)  $take n $ scanl  (+) 1 [1..]

main = do getLine >>= putStrLn . unwords . (\n -> map (show . succ . (`mod` n)) $ scanl1 (+) [1 .. n]) . read

game i t n =
    if t == n then (show i)
    else (show i) ++ " " ++ (game (mod (i + t) n) (t + 1) n)

main :: IO ()
main = do
  n <- getLine >>= return . read
  putStr (game 2 2 n)

-- QH9

nstep n a cp ch | (a == (n-1)) = [ch]
                | otherwise = ch:(nstep n (a+1) (cp+1) newch)
     where chcp = ch + cp
           newch = if (chcp <= n) then chcp else mod chcp n

main = do
		n <- readLn :: IO Int
		print $ nstep n 1 2 2

import Data.List

f i cs n | i == n = pp $ tail $ reverse $ cs
f i all@(c:cs) n = f (i+1) (((c+i)`mod`n):all) n
pp = concat . intersperse " " . map show

main = do
     r  <- readLn :: IO Int
     putStrLn $ f 1 [1]r

next :: Int -> (Int, Int) -> (Int, Int)
next modulator (currentKinder, numStep) = (mod (currentKinder + numStep) modulator, numStep + 1)

solve :: Int -> [Int]
solve n = map fst (take n (iterate (next n) (1,1)))

myPrint :: [Int] -> String
myPrint [] = ""
myPrint [x] = show x
myPrint (x:xs) = (show x ++ " ") ++ (myPrint xs)

main = do
    n <- readLn::(IO Int)
    putStrLn (myPrint (tail (solve n)))

main = do
   input <- getContents
   let kids = (read $ head $ lines input)::Int
   putStrLn $ foldr (\x y -> x ++ " " ++ y) "" (map show $ ballGame kids)

ballGame :: Int -> [Int]
ballGame 0 = []
ballGame n  =  ball n n

ball :: Int -> Int -> [Int]
ball n m
	|n/=1 = ball(n-1) m ++[calc (n-1) m]
	|n==1 = []

calc :: Int -> Int -> Int
calc n m
	|n==1 = 2
	|otherwise = ((calc (n-1) m )+n)`mod`(m)

main = do
   input <- getContents
   let kids = (read $ head $ lines input)::Int
   putStrLn $ foldr (\x y -> x ++ " " ++ y) "" (map show $ ballGame kids)

jogar::Int->Int->Int->Int->[Int]
jogar 0 _ _ _ = []
jogar iteracao n crianca lancamento = proximo:jogar (iteracao-1) n (proximo) (lancamento+1)
  where proximo = mod (crianca+lancamento+1) n

--faz o que a questão pede.
ballGame::Int->[Int]
ballGame n = jogar (n-1) n 1 0

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

main = do
		n<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show $ tail  $ map (\z-> mod z n) $take n $ scanl  (+) 1 [1..]


A teacher decides to give toffees to his students. He asks n students to stand in a queue. Since the teacher is very partial, he follows the following rule to distribute toffees.He looks at the first two students and gives more toffees to the student having higher marks than the other one. If they have the same marks they get the same number of toffees. The same procedure is followed for each pair of adjacent students starting from the first one to the last one.It is given that each student receives at least one toffee. You have to find the number of toffees given to each student by the teacher such that the total number of toffees is minimum.

The first line of input contains the number of students n (2 ≤ n ≤ 1000). The second line gives (n - 1) characters consisting of "L", "R" and "=". For each pair of adjacent students "L" means that the left student has higher marks, "R" means that the right student has higher marks and "=" means that both have equal marks.

Output consists of n integers separated by a space representing the number of toffees each student receives in the queue starting from the first one to the last one.

import Data.List
main=interact$intercalate " ".map show.f 1.last.lines
f a[]=[a]
f a('L':s)=max a(h+1):h:r where h:r=f 1 s
f a('=':s)=h:h:r where h:r=f a s
f a('R':s)=a:f(a+1) s

module Main where

import Data.List

main = do
    n <- getLine >>= return . read
    s <- getLine >>= return . (take (n-1))
    putStrLn $ solve n s

solve n s = init $ concatMap (\x -> show x ++ " ") $ map (\(x,y) -> max x y) $
    zip (lefts 1 s [1]) (rights 1 (reverse s) [1])
    where
        lefts _ []    acc = reverse acc
        lefts x (c:s) acc = case c of
            '=' -> lefts x s (x:acc)
            'L' -> lefts 1 s (1:acc)
            'R' -> lefts (x+1) s ((x+1):acc)

        rights _ []    acc = acc
        rights x (c:s) acc = case c of
            '=' -> rights x s (x:acc)
            'L' -> rights (x+1) s ((x+1):acc)
            'R' -> rights 1 s (1:acc)

module Main where

import Data.List

main = do
    n <- getLine >>= return . read
    s <- getLine >>= return . (take (n-1))
    putStrLn $ solve n s

solve n s = init $ concatMap (\x -> show x ++ " ") $ normalize $ mapper 0 s [0] where
    mapper _ []    acc = reverse acc
    mapper x (c:s) acc = case c of
        '=' -> mapper x s (x:acc)
        'L' -> mapper (x-1) s ((x-1):acc)
        'R' -> mapper (x+1) s ((x+1):acc)
    normalize xs = map (subtract mn) xs where
        mn = minimum xs - 1