import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (m * x * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (mod (m * x) n * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (n + cy - steps ! cx) `rem` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `rem` n, (y + dy) `mod` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (n + cy - steps ! cx) `rem` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `rem` n, (y + dy) `rem` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import Data.Array
import Data.List
import Data.Ord
import Numeric (readDec)

fastRead str = case readDec str of [(x, "")] -> x
solve :: [Int] -> Int
solve (n:m:dx:dy:vec) = head . maximumBy (comparing length) . group . sort $ cells vec
    where cells [] = []
          cells (cx:cy:s) = (cy - steps ! cx) `mod` n : cells s
          steps = array (0, n-1) (take n $ iterate g (0, 0))
            where g (x, y) = ((x + dx) `mod` n, (y + dy) `mod` n)
main = putStrLn . ("0 " ++) . show . solve . map fastRead . words =<< getContents

import Data.List
import Data.Int
main = interact $ unwords . f . map (read :: String -> Int64) . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . fromIntegral . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (mod (m * x) n * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s

import qualified Data.Map as M
import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = M.fromList $ map (\x -> (mod (x * (n - dx)) n, x)) [0..n-1]
  i x y = mod (y + dy * M.findWithDefault 0 x m) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h :: [Int] -> [Int]
  h [] = []
  h (x:y:s) = i x y:h s

import Data.List
main = interact $ unwords . f . map read . words
f (n:_:dx:dy:s) = g s . snd . maximum . map (\(x:s) -> (length s, x)) . group . sort $ h s where
  m = flip mod n . head . findIndices (==n-1) $ iterate (flip mod n . (+dx)) 0
  i x y = mod (m * x * dy + y) n
  g (x:y:s) t
    | i x y == t = [show x, show y]
    | otherwise = g s t
  h [] = []
  h (x:y:s) = i x y:h s


{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P

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

import Data.Array.Unboxed
import Data.Array.IO.Safe

stableBucketSortOn :: forall t. (t -> Int) -> (Int, Int) -> [t] -> [t]
stableBucketSortOn fun bnds li = let
  buckets :: Array Int ([t] -> [t])
  buckets = accumArray (\f v -> f . (v :)) id bnds [(fun v, v) | v <- li]
  in  foldr ($) [] $ elems buckets

dedup :: Int -> [(Int, Int)] -> Array Int (Int, Int)
dedup n li = let
  ili = stableBucketSortOn snd (1, n) li
  sli = group $ stableBucketSortOn fst (1, n) ili
  in  listArray (1, length sli) $ map head sli

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch fun li ri = if  li == ri
  then  li
  else  let
  mi = li + div (ri - li) 2
  in  if  fun mi
  then  binSearch fun li mi
  else  binSearch fun (mi + 1) ri

getIx :: Ord t => t -> Array Int t -> Int
getIx v arr = let
  (li, ri) = bounds arr
  in  binSearch (\ix -> v <= arr ! ix) li (ri + 1)

data Query
  = Ins Int Int Char
  | Rem Int Int
  | Ask Int

ui :: P.ByteString -> Int
ui = P.foldl' (\acc c -> 10 * acc + fromEnum c - fromEnum '0') 0

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, m] <- readInts
  queries <- replicateM m $ do
    ask <- readLine
    pure $ case  P.words ask  of
      [_, u, v, c] -> Ins (ui u) (ui v) (P.head c)
      [_, u, v] -> Rem (ui u) (ui v)
      [_, k] -> Ask (ui k)
      _ -> error "invalid input"
  let
    usedPairs = dedup n [(min u v, max u v) | Ins u v _ <- queries]
    getArr = lift $ newArray (bounds usedPairs) '\0' :: SIO (IOUArray Int Char)
  ayes <- getArr
  nays <- getArr
  let
    step :: (Int, Int) -> Query -> SIO (Int, Int)
    step (!eq, !ok) (Ins u v c) = let
      (fwd, rev, ix) = if  u < v
        then  (ayes, nays, getIx (u, v) usedPairs)
        else  (nays, ayes, getIx (v, u) usedPairs)
      in  lift $ do
      writeArray fwd ix c
      cr <- readArray rev ix
      pure (eq + if  c == cr  then  1  else  0,
            ok + if  cr /= '\0' then  1  else  0)
    step (!eq, !ok) (Rem u v) = let
      (fwd, rev, ix) = if  u < v
        then  (ayes, nays, getIx (u, v) usedPairs)
        else  (nays, ayes, getIx (v, u) usedPairs)
      in  lift $ do
      c <- readArray fwd ix
      cr <- readArray rev ix
      writeArray fwd ix '\0'
      pure (eq - if  c == cr  then  1  else  0,
            ok - if  cr /= '\0' then  1  else  0)
    step v@(!eq, !ok) (Ask k) = (v <$) $ lift $ P.putStrLn $ P.pack
      $ if  eq > 0 || odd k && ok > 0
        then  "YES"
        else  "NO"
  foldM_ step (0, 0) queries

type SIO = StateT P.ByteString IO

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

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

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M

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

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

type State = (M.Map (Int, Int) Char, Int, Int)

addArc :: (Int, Int) -> Char -> State -> State
addArc (u, v) ch (mp, c1, c2)
  | isNothing rev = (mp', c1, c2)
  | fromJust rev == ch = (mp', c1 + 1, c2)
  | otherwise = (mp', c1, c2 + 1)
  where
  rev = M.lookup (v, u) mp
  mp' = M.insert (u, v) ch mp

delArc :: (Int, Int) -> State -> State
delArc (u, v) (mp, c1, c2)
  | isNothing rev = (mp', c1, c2)
  | fromJust rev == ch = (mp', c1 - 1, c2)
  | otherwise = (mp', c1, c2 - 1)
  where
  Just ch = M.lookup (u, v) mp
  rev = M.lookup (v, u) mp
  mp' = M.delete (u, v) mp

check :: State -> Int -> Bool
check (_, c1, c2) k
  | even k = c1 > 0
  | otherwise = c2 > 0 || c1 > 0

main :: IO ()
main = do
  [_, m] <- getInts
  ws <- replicateM m (fmap C.words C.getLine)
  let
    acc (st, rs) (s : ss) =
      case C.unpack s of
        "+" -> (addArc (u, v) ch st, rs)
        "-" -> (delArc (u, v) st, rs)
        "?" -> (st, check st (parseInt (head ss)) : rs)
      where
      (s1 : r1) = ss
      u = parseInt s1
      (s2 : r2) = r1
      v = parseInt s2
      (s3 : _) = r2
      ch = head $ C.unpack s3
    (_, results) = foldl' acc ((M.empty, 0, 0), []) ws
  mapM_ (\ok -> C.putStrLn $ C.pack $ if ok then "YES" else "NO") $ reverse results


import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ unlines.solve.tail.concat. map (map read.words).take 2. lines
solve :: [Integer]-> [String]
solve (x1:x2:[])=   map (unwords.(map show)) [[0], [x2]]
solve (x:y:xs) = map (unwords.(map show))  [[maximum [sum ff - sum (y:xs),0]],ff] where
  ff=scanl f y xs
  f b a = maximum [x-b,a]

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

solve :: [Int] -> (Int, [Int])
solve (n:k:a) = solve' (head a) (tail a) 0 [head a]
                where solve' :: Int -> [Int] -> Int -> [Int] -> (Int, [Int])
                      solve' last [] cost path = (cost, reverse path)
                      solve' last (a:x) cost path = let extra = max 0 (k - a - last)
                                                        walk = a + extra
                                                    in solve' walk x (cost + extra) (walk : path)

conv lst uu
  | (null lst) = reverse uu
  | otherwise = conv (tail lst) (((read (head lst))::Int) : uu)

pp = putStrLn

dostuff lst kk uu sum
  | (null lst) = ( (reverse uu), sum )
  | (diff > 0) = dostuff (tail lst) kk ((diff + (head lst)) : uu) (diff + sum)
  | otherwise = dostuff (tail lst) kk ((head lst) : uu) (sum)
  where diff = (kk - ((head uu) + (head lst)))

makestr lst uu
  | (null lst) = (reverse uu)
  | otherwise = makestr (tail lst) (" " ++ (reverse (show (head lst))) ++ uu)

main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      k = (read (last (words ff)))::Int

  gg <- getLine
  let hh = conv (words gg) []

      ans = dostuff (tail hh) k [(head hh)] 0
--      anstwo = dostuff (tail (reverse hh)) k [(head (reverse hh))] 0

  pp (show (snd ans))
  pp (makestr (fst ans) [])
  -- pp "-------------------------------"

  -- pp (show (snd anstwo))
  -- pp (makestr (fst anstwo) [])

import Control.Monad
import Data.List

walk _ acc [] = reverse acc
walk k (a:as) (b:bs) =
  walk k ((if a+b<k then k-a else b):a:as) bs

main = do
 [n,k] <- liftM (map (\x -> read x ::Integer) . words) getLine
 bs <- liftM (map (\x -> read x ::Integer) . words) getLine
 let c = walk k [head bs] $ tail bs
 print $ sum c - sum bs
 putStrLn $ concat $ intersperse " " $ map show  c

import Data.Functor

solve :: Int -> Int -> [Int] -> [Int]
solve _ _ []    = []
solve k l [a]   = [max a (k - l)]
solve k l (h:t) = let h' = max h (k - l) in h' : solve k h' t

main :: IO()
main = do
    [_, r] <- map read . words <$> getLine
    a      <- map read . words <$> getLine
    let b = solve r r a
    print $ sum b - sum a
    putStrLn . unwords . map show $ b

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let (_:bs) = scanl process k as
      process yesterday today | today + yesterday < k = k - yesterday
                              | otherwise             = today
  print $ sum $ zipWith (-) bs as
  putStrLn $ unwords $ map show bs

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let (_,bs) = mapAccumL process k as
      process yesterday today
        | avg < k = (today + k - avg,today + k - avg)
        | otherwise = (today,today)
        where avg = today + yesterday
  print $ sum $ zipWith (-) bs as
  putStrLn $ unwords $ map show bs

calc k a
  | length a == 0 = []
  | length a == 1 = a
  | length a > 1 && k-(a!!0)-(a!!1) > 0 = [a!!0] ++ calc k ([k-(a!!0)]++(drop 2 a))
  | otherwise = [a!!0] ++ calc k (drop 1 a)

f(_:k:a) = [[foldl (+) 0 [bi - ai | (ai, bi) <- zip a b]], b] where b = calc k a

main=interact$unlines.map(unwords.map show).f.map read.words

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

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

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

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

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

  solve :: Int -> Int -> [Int] -> [Int] -> [Int]
  solve _ _ acc [] = acc
  solve k y acc (x:xs) =
    let z = max 0 (k - (y + x))
        in solve k (x + z) ((x + z):acc) xs

  diff :: [Int] -> [Int] -> Int
  diff [] [] = 0
  diff (x:xs) (y:ys) = (y - x) + (diff xs ys)

  main :: IO()
  main = do
    [n, k] <- getLine >>= return . (map readInt) . words
    -- let xs = [2, 0, 1]
    xs <- getLine >>= return . (map readInt) . words
    let result = reverse $ solve k k [] xs
        d = diff xs result
    print d
    putStrLn $ intercalate " " $ map show result

main=interact$unlines.map(unwords.map show).f.map read.words
f(_:k:s)=[[sum$zipWith(-)(k#s)s],k#s]
k#(x:y:s)|x+y<k=x:k#((k-x):s)|0<1=x:k#(y:s)
k#s=s

import Control.Monad.Trans.State.Lazy( runStateT, modify)
import Control.Monad( forM_)
main = do
    let interpretLine = return.map (read::String->Int).words =<< getLine
    [n,k] <- interpretLine
    as <- interpretLine
    let entry [] = return 0
	entry [w] = modify (w:) >> return 0
	entry (w1:w2:ws)
	  | w1+w2 >= k	= do
		modify (w1:)
		entry $ w2:ws
	  | otherwise	= do
		let diff = k-w1-w2
		modify (w1:)
		v <- entry $ (w2+diff):ws
		return $ diff+v
    (additional, bs) <- runStateT (entry as) []
    print additional
    forM_  (reverse bs) $ \w -> putStr (show w) >> putStr " "

import Data.List

need k xs = 0 : (go xs)
  where go [_] = []
        go (y:ys:yss)
          | extra > 0 = extra : go ((extra + ys):yss)
          | otherwise = 0 : go (ys:yss)
          where extra = k - y - ys

amount :: [Int] -> Int
amount = sum

final = zipWith (+)

main = do
    [_, k] <- fmap (map read . words) getLine :: IO [Int]
    xs <- fmap (map read . words) getLine :: IO [Int]
    let s = need k xs
    print $ amount s
    putStrLn . concat . intersperse " " . map show . final s $ xs

import Data.List
import qualified Data.ByteString.Char8 as C

plan :: [Int] -> Int -> Int -> [Int]
plan [] _ _ = []
plan (x:xs) k need = max need x : plan xs k (k - max need x)

readInt s = let Just (i, _) = C.readInt s in i

main = do
    (n:k:_) <- fmap (map readInt . C.words) C.getLine
    ar <- fmap (map readInt . C.words) C.getLine
    let result = plan ar k 0
    print $ sum $ zipWith subtract ar result
    putStr $ unwords $ map show result

module Main where

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

solve :: [Int] -> Int -> Int -> [Int]
solve [] _ _ = []
solve (a:as) k p = [c] ++ (solve as k c)
    where c = max a (k - p)

main = do
    [n, k] <- liftM (map read . words) getLine
    a <- liftM (map read . words) getLine
    let b = solve a k k
    printf "%d\n" ((sum b) - (sum a))
    forM_ [0..(length b) - 1] $ do \i -> printf "%d " (b !! i)

doit :: [Int] -> Int -> Int -> [Int]
doit [] _ _ = []
doit (x:xs) k last = let ne = last + x
                     in if ne < k then (k - last) : doit xs k (k - last) else x : doit xs k x

main = do
	[n, k] <- getLine >>= return . map read . words
	a <- getLine >>= return . map read . words
	let ans = doit a k k
	print $ sum ans - sum a
	putStrLn $ unwords $ map show ans

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

minIndex :: [Int] -> Int
minIndex cost = snd . minimum $ zip cost [0..]

solve :: [Int] -> (Int, [Int])
solve (k:a) = let path = [[] | i <- [0..k]]
                  cost = [0  | i <- [0..k]]
              in solve' path cost a
              where
                solve' :: [[Int]] -> [Int] -> [Int] -> (Int, [Int])
                solve' path cost [] = let index = minIndex cost
                                      in (cost !! index, reverse $ path !!index)
                solve' path cost (a:ax) = let (next_path, next_cost) = unzip $ map (trans a k path cost) [0..k]
                                          in solve' next_path next_cost ax

trans :: Int -> Int -> [[Int]] -> [Int] -> Int -> ([Int], Int)
trans a k path cost i = let costs = map trans' $ zip [0..] cost
                            index = minIndex costs
                        in (i : path !! index, costs !! index)
                        where trans' :: (Int, Int) -> Int
                              trans' (j, cost) | i < a || i < k - j = cost + 1000
                                               | otherwise = cost + i - a

import Data.List

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

output :: (Int, [Int]) -> IO()
output (cost, a) = do
    print cost
    putStrLn $ unwords $ map show a

solve :: [Int] -> (Int, [Int])
solve (n:k:a) | n == 1 = let extra = max 0 (k - (head a))
                         in (extra, [extra + head a])
              | otherwise = solve' 0 (head a) (tail a) 0 [head a]
                            where solve' :: Int -> Int -> [Int] -> Int -> [Int] -> (Int, [Int])
                                  solve' a b [] cost path = let extra = max 0 (k - a - b)
                                                            in (cost + extra, reverse (extra + head path : tail path))
                                  solve' a b (c:x) cost path = let extra = max 0 (k - a - b - c)
                                                                   walk = c + extra
                                                               in solve' b walk x (cost + extra) (walk : path)

conv lst uu
  | (null lst) = reverse uu
  | otherwise = conv (tail lst) (((read (head lst))::Int) : uu)

pp = putStrLn

dostuff lst kk uu sum
  | (null lst) = ( (reverse uu), sum )
  | (diff > 0) = dostuff (tail lst) kk ((diff + (head lst)) : uu) (diff + sum)
  | otherwise = dostuff (tail lst) kk ((head lst) : uu) (sum)
  where diff = (kk - ((head uu) + (head lst)))

makestr lst uu
  | (null lst) = (reverse uu)
  | otherwise = makestr (tail lst) (" " ++ (show (head lst)) ++ uu)

main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      k = (read (last (words ff)))::Int

  gg <- getLine
  let hh = conv (words gg) []

      ans = dostuff (tail hh) k [(head hh)] 0

  pp (show (snd ans))
  pp (makestr (fst ans) [])

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ unlines.solve.tail.concat. map (map read.words).take 2. lines
solve :: [Integer]-> [String]
solve (x1:x2:[])=   map (unwords.(map show)) [[maximum [x1-x2,0]], [maximum [x1,x2]]]
solve (x:y:xs) = map (unwords.(map show))  [[maximum [sum ff - sum (y:xs),0]],ff] where
  ff=scanl f y xs
  f b a = maximum [x-b,a]

doit :: [Int] -> Int -> Int -> [Int]
doit [] _ _ = []
doit (x:xs) k last = let ne = last + x
                     in if ne < k then (k - last) : doit xs k (k - last) else x : doit xs k x

main = do
	[n, k] <- getLine >>= return . map read . words
	a <- getLine >>= return . map read . words
	let ans = doit a k k
	print $ sum ans
	putStrLn $ unwords $ map show ans


import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import Data.Char
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

mapInd :: (a -> Int -> b) -> [a] -> [b]
mapInd f l = zipWith f l [0..]

launchNext k (hd:perm) i =
    if hd == i then (1, hd:perm)
               else do
                let aux screen count (j':j:tl)
                     | j == i    = (screen, j:j':tl)
                     | otherwise = do
                         let (s',cnt') = if count == k then (screen+1, 1)
                                                       else (screen, count+1)
                         let (c,tl') = aux s' cnt' (j:tl)
                         (c, j':tl')
                aux 1 2 (hd:perm)

swapIdx index perm ix jx = do
    io <- readArray perm ix
    jo <- readArray perm jx
    writeArray index io jx
    writeArray index jo ix
    writeArray perm ix jo
    writeArray perm jx io

execOrder index perm k o = do
    x <- readArray index o
    if x == 1
      then return (1 :: Integer)
      else do
        swapIdx index perm (x-1) x
        return $ fromIntegral $ (x-1) `div` k + 1

executeOrders :: [Int] -> [Int] -> Int -> Int -> Integer
executeOrders perm order n k = runST (do
    index <- (newArray (0, n) (-1) :: ST s (STUArray s Int Int))
    zipWithM_ (\x i -> writeArray index x i) perm [1..]
    perm_m <- newListArray (0,n) $ (-1):perm :: ST s (STUArray s Int Int)

    -- let aux :: Integer -> [Int] -> m Integer
    let aux v [] = return v
        aux v (o:tl) = do
          v' <- execOrder index perm_m k o
          aux (v+v') tl
    aux 0 order)

main = main_mut

main_orig = do
    [n,m,k] <- map read <$> words <$> getLine
    perm <- map read <$> words <$> getLine  :: IO [Int]
    order <- map read <$> words <$> getLine :: IO [Int]

    let aux (c, perm) o = do
          let (c', perm') = launchNext k perm o
          -- traceShow (c', perm') $ do
          (c+c', perm')

    let (c,_) = foldl aux (0, perm) order
    putStrLn $ show c

main_mut = do
    [n,m,k] <- map read <$> words <$> getLine
    perm <- map read <$> words <$> getLine  :: IO [Int]
    order <- map read <$> words <$> getLine :: IO [Int]

    let v = executeOrders perm order n k
    putStrLn $ show v

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

getGestures :: Int -> Int -> Int
getGestures pos perScreen = pos `div` perScreen + 1

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

type IntMap = Data.Map.Map Int Int

getMaps :: [Int] -> (IntMap, IntMap)
getMaps array = foldl' (\ (p2v, v2p) (v, p) ->
                        (Data.Map.insert p v p2v, Data.Map.insert v p v2p))
                 (Data.Map.empty, Data.Map.empty) (zip array [0..])

solve :: [Int] -> IntMap -> IntMap -> Int64 -> Int -> Int64
solve [] _ _ acc _ = acc
solve (x:xs) posToVal valToPos acc perScreen =
    let acc' = acc + fromIntegral (getGestures (valToPos Data.Map.! x) perScreen)
        (posToVal', valToPos') = moveForward posToVal valToPos x
    in solve xs posToVal' valToPos' acc' perScreen
    where
        moveForward p2v v2p v =
            let curPos = v2p Data.Map.! v
                prevPos = curPos - 1
                curVal = v
                prevVal = fromMaybe (-1) (Data.Map.lookup prevPos p2v)
            in
                if prevPos == -1 then
                    (p2v, v2p)
                else
                    let p2v' = Data.Map.insert curPos prevVal p2v
                        p2v'' = Data.Map.insert prevPos curVal p2v'
                        v2p' = Data.Map.insert curVal prevPos v2p
                        v2p'' = Data.Map.insert prevVal curPos v2p'
                    in (p2v'', v2p'')

main = do
    [n, m, k] <- getIntList
    a <- getIntList
    b <- getIntList
    let (posToVal, valToPos) = getMaps $ map (\x -> x - 1) a
    let res = solve (map (\x -> x - 1) b) posToVal valToPos 0 k
    print res

import System.IO
import Control.Applicative
import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List
import Data.Char
import qualified Data.Set as Set

-- traceDebug = trace
traceDebug _ x = x

mapInd :: (a -> Int -> b) -> [a] -> [b]
mapInd f l = zipWith f l [0..]

launchNext k (hd:perm) i =
    if hd == i then (1, hd:perm)
               else do
                let aux screen count (j':j:tl)
                     | j == i    = (screen, j:j':tl)
                     | otherwise = do
                         let (s',cnt') = if count == k then (screen+1, 1)
                                                       else (screen, count+1)
                         let (c,tl') = aux s' cnt' (j:tl)
                         (c, j':tl')
                aux 1 2 (hd:perm)

swapIdx index perm ix jx = do
    io <- readArray perm ix
    jo <- readArray perm jx
    writeArray index io jx
    writeArray index jo ix
    writeArray perm ix jo
    writeArray perm jx io

execOrder index perm k o = do
    x <- readArray index o
    if x == 1
      then return 1
      else do
        swapIdx index perm (x-1) x
        return $ (x-1) `div` k + 1

executeOrders :: [Int] -> [Int] -> Int -> Int -> Int
executeOrders perm order n k = runST (do
    index <- (newArray (0, n) (-1) :: ST s (STUArray s Int Int))
    zipWithM_ (\x i -> writeArray index x i) perm [1..]
    perm_m <- newListArray (0,n) $ (-1):perm :: ST s (STUArray s Int Int)

    let aux v [] = return v
        aux v (o:tl) = do
          v' <- execOrder index perm_m k o
          aux (v+v') tl
    aux 0 order)

main = main_mut

main_orig = do
    [n,m,k] <- map read <$> words <$> getLine
    perm <- map read <$> words <$> getLine  :: IO [Int]
    order <- map read <$> words <$> getLine :: IO [Int]

    let aux (c, perm) o = do
          let (c', perm') = launchNext k perm o
          -- traceShow (c', perm') $ do
          (c+c', perm')

    let (c,_) = foldl aux (0, perm) order
    putStrLn $ show c

main_mut = do
    [n,m,k] <- map read <$> words <$> getLine
    perm <- map read <$> words <$> getLine  :: IO [Int]
    order <- map read <$> words <$> getLine :: IO [Int]

    let v = executeOrders perm order n k
    putStrLn $ show v


import Data.List
import Data.Ord
main=readFile"input.txt">>=writeFile"output.txt".parseOutput 'A'.solve.parseInput.words

parseInput (n:x:a:b:c:rest) = (map read [n,x,a,b,c],toPairs rest)
toPairs :: [String] -> [(String,Int)]
toPairs (name:rating:rest) = (name,read rating):toPairs rest
toPairs _ = []
parseOutput c (t1:t2:t3:t4:rest) = unlines ["Group "++c:":",t1,t2,t3,t4] ++ parseOutput (succ c) rest
parseOutput _ _ = []

solve ([n,x0,a,b,c],teams) = loop basket1 basket2 basket3 basket4 randoms
   where
     m = n`div`4
     randoms = tail $ iterate (\x->(x*a+b)`mod`c) x0
     sortedTeams = map fst $ sortBy(flip (comparing snd)) teams
     (basket1,rest1) = splitAt m sortedTeams
     (basket2,rest2) = splitAt m rest1
     (basket3,basket4) = splitAt m rest2

del i xs = case splitAt i xs of (xs,y:ys) -> (y,xs++ys)

loop [] [] [] [] _ = []
loop basket1 basket2 basket3 basket4 (r1:r2:r3:r4:rs) = t1:t2:t3:t4:loop nb1 nb2 nb3 nb4 rs
   where
     (t1,nb1) = del (r1`mod`length basket1) basket1
     (t2,nb2) = del (r2`mod`length basket2) basket2
     (t3,nb3) = del (r3`mod`length basket3) basket3
     (t4,nb4) = del (r4`mod`length basket4) basket4

import Data.List (delete, sortBy, unfoldr)
import Monad (liftM)

type Command  =  (String, Int)
type Random  =  (Int, Int, Int, Int)

countBasket  =  4 :: Int

sortBySnd :: Ord b => [(a, b)] -> [(a, b)]
sortBySnd  =  sortBy (\a b -> compare (snd b) (snd a))

parse :: String -> Command
parse line  =  case words line of
    [s1, s2]  ->  (s1, read s2)

randoms :: Random -> [Int]
randoms  =  unfoldr (Just . next)
  where
    next (x, a, b, c)  =  (y, (y, a, b, c))
      where
        y  =  (a * x + b) `mod` c

solve :: Int -> Random -> [Command] -> [[Command]]
solve n random cs  =  map sortBySnd (solve' (randoms random) bs)
  where
    m  =  n `div` countBasket
    cs'  =  sortBySnd cs
    bs  =  [[cs' !! (i * m + j) | j <- [0..m-1]] | i <- [0..countBasket-1]]

    solve' :: [Int] -> [[Command]] -> [[Command]]
    solve' rs bs
      | null $ head bs  =  []
      | otherwise  =  cs : solve' (drop countBasket rs) (zipWith delete cs bs)
      where
        cs  =  map (\(r, b) -> b !! (r `mod` (length b))) (zip rs bs)

format :: [[Command]] -> [String]
format  =  concatMap (\(c, cs) -> ("Group " ++ [c] ++ ":") : (map fst cs)) . zip ['A' ..]

main :: IO ()
main  =  do
    ls  <-  liftM lines $ readFile "input.txt"
    let n  =  read . (!! 0) $ ls
    let [x, a, b, c]  =  map read . words . (!! 1) $ ls
    let commands  =  take n $ map parse $ drop 2 ls
    writeFile "output.txt" $ unlines $ format $ solve n (x, a, b, c) commands


import Control.Arrow ((>>>))

solve arr = solveh arr 0 (last arr == 'B')

-- finally, got it :D
solveh [] sum ok = ok
solveh (x : xs) sum ok = solveh xs s (s >= 0 && ok)
  where
    s = if x == 'A' then sum + 1 else sum - 1

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "YES" else "NO")
            >>> unlines

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: String -> Bool
solve str = L.last str /= 'A' && L.all (>= 0) accum_char_values
    where
        accum_char_values = L.scanl (+) 0 char_values
        char_values = L.map char_value str

        char_value :: Char -> Int
        char_value 'A' = 1
        char_value 'B' = -1
        char_value _ = 0

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        s <- B8.getLine <&> L.head . B8.words
        let answer = solve $ B8.unpack s
        putsYesNo answer

import Control.Arrow ((>>>))

solve arr = solveh arr 0 0 && last arr == 'B'

solveh [] a b = a >= b
solveh (x : xs) a b = if x == 'A' then solveh xs (a + 1) b else solveh xs a (b + 1)

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "YES" else "NO")
            >>> unlines

import Control.Arrow ((>>>))

solve arr = solveh arr 0 || last arr == 'A'

solveh [] sum = sum < 0
solveh (x : xs) sum = if x == 'A' then solveh xs (sum + 1) else solveh xs (sum - 1)

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "NO" else "YES")
            >>> unlines

import Control.Arrow ((>>>))

solve arr = solveh arr 0 && last arr == 'B'

solveh [] sum = sum >= 0
solveh (x : xs) sum = if x == 'A' then solveh xs (sum + 1) else solveh xs (sum - 1)

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "YES" else "NO")
            >>> unlines

import Control.Arrow ((>>>))

solve arr = solveh arr 0 0 && last arr == 'B'

solveh [] a b = a > b
solveh (x : xs) a b = if x == 'A' then solveh xs (a + 1) b else solveh xs a (b + 1)

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "YES" else "NO")
            >>> unlines

import Control.Arrow ((>>>))

solve arr = head arr == 'A' && solveh arr && last arr == 'B'

solveh [] = True
solveh [b] = b == 'B'
solveh [a, b] = a == 'A' && b == 'B'
solveh (a : b : cs) = (a == 'A' && b == 'A' && solveh (b : cs)) || (a == 'A' && b == 'B' && solveh (b : cs)) || (a == 'B' && b == 'A' && solveh (b : cs))

main :: IO ()
main =
    interact $
        lines
            >>> drop 1
            >>> map solve
            >>> map (\p -> if p then "YES" else "NO")
            >>> unlines


--B. Vova and Trophies
citesc_nr :: String -> Int
citesc_nr s = read s

sumgold :: [Char] -> Int -> Int
sumgold xx onlyfans
    | onlyfans < length xx = aux xx 0 0 0
    | otherwise = onlyfans
    where aux [] after before rez = rez
        --after inseamna cate G am de aici incolo
        --before = cate G am pana la imediat precedentul S
        --nu merge "dinamica" decat daca am macar un S
          aux ('G':sir) after before rez = aux sir (after+1) before (max rez (min onlyfans (after+1+before+1) ) )
          aux ('S':sir) after before rez = aux sir 0 after rez

main = do
    x <- getLine
    let n = (citesc_nr x)
    sir <- getLine
    let onlyfans = length $ filter (=='G') sir
    print $ sumgold sir onlyfans

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

toint s = (read s) :: Integer

go [] a b r = r
go ('G':s) a b r =
  go s (a+1) b (max r (a+2+b))
go ('S':s) a b r =
  go s 0 a r

solve::String -> String
solve ss =
  let _:s:__ = words ss in
  let r1 = go s 0 0 0 in
  let r = min r1 (length $ filter (=='G') s) in
  show(r)++"\n"

main = do
  interact $ solve

--B. Vova and Trophies
citesc_nr :: String -> Int
citesc_nr s = read s

sumgold :: [Char] -> Int -> Int
sumgold xx onlyfans
    | onlyfans < length xx = aux xx 0 0 0
    | otherwise = onlyfans
    where aux [] after before rez = rez
        --after inseamna cate G am de aici incolo
        --before = cate G am pana la imediat precedentul S
        --nu merge "dinamica" decat daca am macar un S
          aux ('G':sir) after before rez = aux sir (after+1) before (max rez (after+1+before+1) )
          aux ('S':sir) after before rez = aux sir 0 after rez

main = do
    x <- getLine
    let n = (citesc_nr x)
    sir <- getLine
    let onlyfans = length $ filter (=='G') sir
    print $ sumgold sir onlyfans


{-# OPTIONS -ffi -O2 #-}

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe (fromJust)
import Data.List (foldl')

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
readDouble = unsafeReadDouble

f (a,b) p = (a+p*(1+2*b),p*(1+b))

main = BS.getLine >> fmap (fst.foldl' f (0.0, 0.0).map readDouble.BS.words) BS.getLine >>= print

{-# OPTIONS -ffi #-}
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe (fromJust)

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
readDouble = unsafeReadDouble . SB.concat . LB.toChunks

f [] = (0,0,0)
f (s:ss) = ((a + 2*b + 1) * s, (b + 1) * s, q + a * (1-s))
    where (a,b,q) = f ss
solve l = a + q
    where (a,_,q) = f s
          s = map (readDouble . LB.pack) $ words l
main = do
    l1 <- getLine
    l2 <- getLine
    putStrLn (show (solve l2))

{-# OPTIONS -ffi #-}
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe (fromJust)
import Data.List (foldl')

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
readDouble = unsafeReadDouble

f (a,b) p = (a+p*(1+2*b),p*(1+b))

main = BS.getLine >> fmap (fst.foldl' f (0.0, 0.0).map readDouble.BS.words) BS.getLine >>= print


import Data.Array.Unboxed
import Data.Ix (index)
main = do
    n <- read `fmap` getLine
    l <- (map read . words) `fmap` getLine :: IO [Int]
    if all (==1) l then putStrLn "YES" else do
        let arr = listArray (0, n-1) l :: UArray Int Int
            nnn = filter (\i -> mod n i == 0) [2..div n 3]
            f nj = let n1 = n `div` nj in any (\j ->
                    all (\i -> arr ! (index ((1,1), (n1, nj)) (i, j)) == 1)
                        [1..n1]) [1..nj]
	putStrLn (if any f nnn then "YES" else "NO")

module Main where

--import Debug.Trace

import Control.Monad
import Control.DeepSeq
import Data.Function
import Data.List
import Data.Array.IArray
import Data.Char

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

primes :: [Int]
primes = 2 : sieve [3..] [ [p*p, p*p+p..] | p <- primes ] where
    sieve (x:xs) t@((q:cs):r)
        | x < q = x : sieve xs t
        | otherwise = sieve (xs `minusOrd` cs) r

-- The lists should be ordered
minusOrd (x:xs) (y:ys) = case compare x y of
    LT -> x : minusOrd  xs  (y:ys)
    EQ ->     minusOrd  xs     ys
    GT ->     minusOrd (x:xs)  ys
minusOrd  xs     _     = xs
unionOrd (x:xs) (y:ys) = case compare x y of
    LT -> x : unionOrd  xs  (y:ys)
    EQ -> x : unionOrd  xs     ys
    GT -> y : unionOrd (x:xs)  ys
unionOrd  xs     []    = xs
unionOrd  []     ys    = ys

---- Answer Code Section ----

type MoodArray = Array Int Bool

non2Factors n = filter (/= 2) factors where
    doublePrimes = map (* 2) primes
    factors = filter (\p -> n `mod` p == 0) (takeWhile (<= n) primes ++ takeWhile (<= n) doublePrimes)

tryFit :: MoodArray -> Int -> Int -> Int -> Bool
tryFit moods l d k = and polygon where
    indices = [k, k+d .. l]
    polygon = map (\i -> moods ! i) indices

process :: MoodArray -> Int -> Bool
process moods l = or cases where
    regularNs = non2Factors l
    cases = [ tryFit moods l d k | n <- regularNs, let d = l `div` n, k <- [1..d] ]

int2Bool = \x -> if x == 1 then True else False

main = do
    n <- getInt
    moods <- (listArray (1, n) <$> map int2Bool <$> getInts) :: IO MoodArray
    putStrLn $ if process moods n then "YES" else "NO"

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Array
import Data.Array.IO
import Data.Foldable (for_)
import Data.IORef

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors
getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"
isPorygon = filter ((>2) . length)
select ks x = (\ x -> map (!!x) ks)

{--
-- printf "%s\n". yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  .
main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
          printf "%s\n". yesOrNo . any(==True). map (all (== 1)) . map (concatMap (\ x -> map (!!x) ks)) . isPorygon . concatMap (\x-> map (\a->(takeWhile (< n')) . iterate (+ x) $ a)[0..x]) . getInc $ n'
          }
--}
--f :: (MArray (Integer,Integer) e m) => Integer -> [e] -> [[[m e]]]
--f:: Integer -> [Integer] -> IO (IOArray (Int,Int) Integer)
--f :: (IOArray  Integer m0, IOArray  Integer []) => Integer -> [Integer] -> IO (IOArray (Int,Int) Integer)

{-
f n ks = arr 1 --mapM arr ds
    where
      ds     = divisors n
      arr  x = do { ar <- ar
                   ; map  (\ y -> (map (\ t -> ar `readArray` t) $ (range ((1,y),(m,y))))) $ [1..x]
                  }
               where m = (n `div` x)
                     ar :: IOArray ((Int,Int) Integer)
                     ar = newListArray ((1,1),(m , x)) $ ks
-}

f n ks = concatMap arr ds
    where
      ds     = divisors n
      arr  x =  (filter ((>2) . length)) . (filter (all (==1))) . map  (\ y ->  (map (ar!)  $ (range ((1,y),(m,y))))) $ [1..x]
          where m = (n `div` x)
                ar = listArray ((1,1),(m , x)) $ ks

main = do {(n:ks:_) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
            printf "%s\n" .  yesOrNo . any (not .null) $ ((f n') $ ks)
            --(mapM_ (mapM_ (fmap print)))  ( (f n') $ ks)
          }

--map (kuku !) (range ((3,3),(5,5)))

kuku = newListArray ((1,1),(9,9)) [i*j| i <- [1..9], j <- [1..9]] :: IO (IOArray (Int,Int) Integer)

import List
import Array

nextSimple :: Int -> Int
nextSimple n = head (filter (\x -> 2 == length (filter (\y -> 0 == mod x y) [1..x])) [(n+1)..])

factorization :: Int -> [(Int, Int)]
factorization n = reverse (factorization_ n 2 [])
  where
    factorization_ :: Int -> Int -> [(Int, Int)] -> [(Int, Int)]
    factorization_ 1 _ result = result
    factorization_ n simple result
      |  n             <  1      =  error "factorization: Arg must be positive number."
      |  mod n simple  == 0
      && length result == 0      =  factorization_ (div n simple) simple [(simple, 1)]
      |  mod n simple  == 0
      && divisor       == simple =  factorization_ (div n simple) simple ((simple, power + 1) : (tail result))
      |  mod n simple  == 0      =  factorization_ (div n simple) simple ((simple, 1) : result)
      |  simple^2      >  n      =  (n, 1) : result
      |  otherwise               =  factorization_ n (nextSimple simple) result
        where
          divisor = fst (head result)
          power = snd (head result)

simpleDivisors :: Int -> [Int]
simpleDivisors n = map fst (factorization n)

removeFirstTwo :: [Int] -> [Int]
removeFirstTwo (2:xs) = xs
removeFirstTwo xs     = xs

goodDivisors :: Int -> [Int]
goodDivisors n = sort (del4 ++ others)
  where
    del4 = if mod n 4 == 0 then [4] else []
    others = removeFirstTwo (simpleDivisors n)

getElements :: Array Int e -> Int -> Int -> [e]
getElements array start step = map (\ix -> (!) array ix) [start, start + step .. last]
  where
    last = snd (bounds array)

readInts :: IO [Int]
readInts = do
  line <- getLine
  return (map read (words line))

getSize :: Array Int e -> Int
getSize array = snd (bounds array) + 1

goodPolygon :: Array Int Bool -> Int -> Bool
goodPolygon array polygon = or (map (\x -> and (getElements array x m)) [0..m - 1])
  where
    n = getSize array
    m = div n polygon

solve :: Array Int Bool -> Bool
solve array = or (map (goodPolygon array) (goodDivisors n))
  where
    n = getSize array

printAns :: Bool -> IO ()
printAns True  = putStrLn "YES"
printAns False = putStrLn "NO"

main :: IO ()
main = do
    n <- readLn::(IO Int)
    xs <- readInts
    printAns (solve (listArray (0, n - 1) (map (>0) xs)))

module Main where

--import Debug.Trace

import Control.Monad
import Control.DeepSeq
import Data.Function
import Data.List
import Data.Array.IArray
import Data.Char

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

type MoodArray = Array Int Bool

primes :: [Int]
primes = filterPrime [2..]
    where filterPrime (p:xs) = p : filterPrime [x | x <- xs, x `mod` p /= 0]

factors n = filter (\p -> n `mod` p == 0) $ takeWhile (<= n) primes

tryFit :: MoodArray -> Int -> Int -> Int -> Bool
tryFit moods l d k = and polygon where
    indices = [k, k+d .. l]
    polygon = map (\i -> moods ! i) indices

process :: MoodArray -> Int -> Bool
process moods l = or cases where
    regularNs = filter (2 /=) (factors l)
    cases = [ tryFit moods l d k | n <- regularNs, l `mod` n == 0, let d = l `div` n, k <- [1..d] ]

int2Bool = \x -> if x == 1 then True else False

main = do
    n <- getInt
    moods <- (listArray (1, n) <$> map int2Bool <$> getInts) :: IO MoodArray
    putStrLn $ if process moods n then "YES" else "NO"

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors

getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"

main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
            printf "%s\n". yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  . map (\ x -> (takeWhile (< n')) . iterate (+ x) $ 0) . getInc $ n'
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors
getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"

-- printf "%s\n". yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  .
main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
          printf "%s\n" . yesOrNo . any(==True). map (all (== 1)) . map (concatMap (\ x -> map (!!x) ks)) . filter ((>2) . length) . concatMap (\ x -> map (\a->(takeWhile (< n')) . iterate (+ x) $ a)[0..n']) . getInc $ n'
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors

getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"

main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
            printf "%s\n" . yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  . map (\ x -> (takeWhile (< n')) . iterate (+ x) $ 0) . getInc $ n'
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Array

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors
getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"
isPorygon = filter ((>2) . length)
select ks x = (\ x -> map (!!x) ks)

{--
-- printf "%s\n". yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  .
main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
          printf "%s\n". yesOrNo . any(==True). map (all (== 1)) . map (concatMap (\ x -> map (!!x) ks)) . isPorygon . concatMap (\x-> map (\a->(takeWhile (< n')) . iterate (+ x) $ a)[0..x]) . getInc $ n'
          }
--}
f n ks = map arr ds
    where
      ds     = divisors n
      arr  x = let a = listArray ((1,1),(m , x)) $ ks in
               map (a!) $ (range ((1,1),(m,1)))
               where m = (n `div` x)

main = do {(n:ks:_) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
            printf "%s\n". yesOrNo . any(==True) . map (all $ (== 1)) . filter((>2) .length) . f n' $ ks
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

polygon = filter (> 2) . divisors
getInc x = (map (x `div`)) . polygon $ x
yesOrNo :: Bool -> String
yesOrNo x = if x then "YES" else "NO"

-- printf "%s\n". yesOrNo . any(==True). map (all (== 1))  .  map (concatMap (\ x -> map (!!x) ks))  .
main :: IO ()
main = do { (n:ks) <- map (map read) . map split . lines <$> getContents
          ; let n' =  head $ n in
           printf "%s\n". yesOrNo . any(==True). map (all (== 1))  . map (concatMap (\ x -> map (!!x) ks)) . concatMap (\ x -> map (\a->(takeWhile (< n')) . iterate (+ x) $ a)[0..n']) . getInc $ n'
          }


import Data.List
import Data.Ord
import System.IO

type Long = Integer

parseLong :: IO [Long]
parseLong = fmap (map read . words) getLine

solve :: [Long] -> Long -> Int -> Long
solve a h l = if l == 1 then (max 1 $ h)
              else delta + (solve (tail a) (h - delta) (l - 1)) where delta = max 1 (h - a !! 1)

sortDescending = sortBy (comparing Down)

main :: IO ()
main = do
  [n, m] <- parseLong
  a <- parseLong
  print $ sum a - (solve (sortDescending a) (maximum a) (length a))

import Data.List

toint s = (read s) :: Integer

go [] a r = r + max a 0
go (x:xs) a r =
	go xs (min a x - 1) $ r + max (a-x) 0 + 1

doit a =
	let mx = maximum a in
	sum a - go (reverse $ sort a) mx 0

solve::String -> String
solve ss =
	let n:m:a = map toint $ words ss in
	show(doit a)++"\n"

main = do
  interact $ solve

import Data.List

main = do
    input <- getContents
    process input

process :: String -> IO ()
process s = print (solve (parse s))

parse :: String -> [Integer]
parse s = case words s of (n:m:a) -> map read a
                          _  -> []

solve :: [Integer] -> Integer
solve a = f 0 (sort a)

-- First argument: height of the combined remaining block so far.
-- Second argument: remainder of the stack list.
f :: Integer -> [Integer] -> Integer
-- For the last element we have to make the combined stack as high as the last stack. But if we were
-- already at the right height, we have to keep one block in order not to have an empty stack
f h (ai:[]) = h - if ai == h then 1 else 0
-- For an element that is not the last we try to grow the combined stack by one and remove every
-- unecessary block
f h (ai:a) = ai - 1 + f (if ai == h then h else h + 1) a
f _ _ = 0

-- Stacks having only one block cannot have any block removed from them. I have a feeling that
-- stacks should be iterated over in sorted order. We can climb one block at a time and keep
-- every necessary remaining block in the last (and therefore highest) stack.

import Data.List
import Data.Ord
import Data.Int
import System.IO

type Long = Int64

parseLong :: IO [Long]
parseLong = fmap (map read . words) getLine

solve :: [Long] -> Long -> Int -> Long
solve a h l = if l == 1 then (max 1 $ h)
              else delta + (solve (tail a) (h - delta) (l - 1)) where delta = max 1 (h - a !! 1)

sortDescending = sortBy (comparing Down)

main :: IO ()
main = do
  [n, m] <- parseLong
  a <- parseLong
  print $ foldr (+) 0 a -  (solve (sortDescending a) (maximum a) (length a))

import Data.List

toint s = (read s) :: Int

go [] a r = r + max a 0
go (x:xs) a r =
	go xs (min a x - 1) $ r + max (a-x) 0 + 1

doit a =
	let mx = maximum a in
	sum a - go (reverse $ sort a) mx 0

solve::String -> String
solve ss =
	let n:m:a = map toint $ words ss in
	show(doit a)++"\n"

main = do
  interact $ solve

import Data.List
import Data.Ord
import System.IO

parseInt :: IO [Int]
parseInt = fmap (map read . words) getLine

solve :: [Int] -> Int -> Int -> Int
solve a h l = if l == 1 then max 1 h
              else delta + (solve (tail a) (h - delta) (l - 1)) where delta = max 1 (a !! 0 - a !! 1)

sortDescending = sortBy (comparing Down)

main :: IO ()
main = do
  [n, m] <- parseInt
  a <- parseInt
  print $ foldl (+) 0 a - (solve (sortDescending a) (maximum a) (length a))

import Data.List
import Data.Ord
import System.IO

parseInt :: IO [Int]
parseInt = fmap (map read . words) getLine

solve :: [Int] -> Int -> Int -> Int
solve a h l = if l == 1 then max 1 h
              else delta + (solve (tail a) (h - delta) (l - 1)) where delta = max 1 (h - a !! 1)

sortDescending = sortBy (comparing Down)

main :: IO ()
main = do
  [n, m] <- parseInt
  a <- parseInt
  print $ foldl (+) 0 a - (solve (sortDescending a) (maximum a) (length a))


eeuclid :: Integer -> Integer -> (Integer, Integer, Integer)
eeuclid a 0 = (1, 0, a)
eeuclid a b | a < b = (m, n, d) where (n, m, d) = eeuclid b a
eeuclid a b = (m, n-q*m, g) where
   (q,r) = a `quotRem` b
   (m,n,g) = eeuclid r b

s[a,b,c]
  | c `mod` g /= 0 = [-1]
  | otherwise = [-(signum a * x * (c`div`g)), -(signum b * y*(c`div`g))]
  where
  (x,y,g)=eeuclid (abs a) (abs b) -- x*a + y*b = g

main=interact$unwords.map show.s.map read.words

import qualified Data.Tuple as Tup

maxPerm = truncate (5* 10 ** 18)

main = do
    line <- getLine
    let [a, b, c] = map read $ words line
    putStrLn $ formatter a b c

formatter :: Integer -> Integer -> Integer -> String
formatter a b c = case formatter' a b (-c)
                  of Just (x, y) | abs x <= maxPerm && abs y <= maxPerm -> show x ++ " " ++ show y
                     otherwise -> show $ -1

-- special cases
formatter' 0 b c = case c `divMod` b
                  of (q, 0) -> Just (0, q)
                     (_, _) -> Nothing
formatter' a 0 c = case c `divMod` a
                  of (q, 0) -> Just (q, 0)
                     (_, _) -> Nothing
formatter' a b 0 = Just (0, 0)
formatter' a b c
    | c `mod` b == 0 = Just (0, c `div` b)
    | c `mod` a == 0 = Just (c `div` a, 0)
    | a == max a b = solve a b c
    | otherwise = fmap Tup.swap $ solve b a c

-- assumes a > b
-- solve :: Int -> Int -> Int -> Maybe (Int, Int)
solve a b c = let (g, x', y') = goEuclid a b
              in  if c `mod` g == 0
                  then Just (x' * (c `div` g), y' * (c `div` g))
                  else Nothing

goEuclid a b = let (r0, r1) = (max a b, min a b)
               in  euclidExt r0 r1 1 0 0 1

-- returns (gcd, x, y)
euclidExt r0 r1 s0 s1 t0 t1 = if r2 == 0
                              then (r1, s1, t1)
                              else euclidExt r1 r2 s1 s2 t1 t2
    where (q, r2) = r0 `divMod` r1
          s2 = s0 - q * s1
          t2 = t0 - q * t1

import Monad (liftM)
import Prelude hiding (print)

(?) :: Bool -> a -> a -> a
(?) True   =  const
(?) False  =  flip const

gcd' :: Integral a => a -> a -> (a, (a, a))
gcd' 0 b  =  (b, (0, 1))
gcd' a b  =  (d, (y1 - x1 * div b a, x1))
  where
    (d, (x1, y1))  =  gcd' (mod b a) a

diofant :: Integral a => a -> a -> a -> Maybe (a, (a, a))
diofant a b c
  | mod c g == 0  =  Just (g, (signum a * x * div (-c) g, signum b * y * div (-c) g))
  | otherwise  =  Nothing
  where
    (g, (x, y))  =  gcd' (abs a) (abs b)

bounds :: Integral a => (a, a)
bounds  =  (-m, m)
  where
    m  =  5 * 10^18

solve :: Integral a => [a] -> Maybe (a, a)
solve [a, b, c]
  | a == 0 && b == 0  =  (c == 0) ? Just (0, 0) $ Nothing
  | a == 0  =  (mod (-c) b == 0) ? Just (0, div (-c) b) $ Nothing
  | b == 0  =  (mod (-c) a == 0) ? Just (div (-c) a, 0) $ Nothing
  | otherwise  =  do
        (g, (x0, y0))  <-  diofant a b c
        let (kxMin, kxMax)  =  getKx bounds x0 g
        let (kyMin, kyMax)  =  getKy bounds y0 g
        let (kMin, kMax)  =  (max kxMin kyMin, min kxMax kyMax)
        k  <-  (kMin <= kMax) ? return kMin $ fail ""
        return (x0 + k * div b g, y0 - k * div a g)
    where
      getKx (xMin, xMax) x0 g
        | b > 0  =  (1 + div (xMin - x0 - 1) (div b g), div (xMax - x0) (div b g))
        | b < 0  =  ((-1) * div (xMax - x0) (div (-b) g), (-1) * (1 + div (xMin - x0 - 1) (div (-b) g)))
      getKy (yMin, yMax) y0 g
        | a > 0  =  (1 + div (y0 - yMax - 1) (div a g), div (y0 - yMin) (div a g))
        | a < 0  =  ((-1) * div (y0 - yMin) (div (-a) g), (-1) * (1 + div (y0 - yMax - 1) (div (-a) g)))

print :: Show a => Maybe (a, a) -> IO ()
print Nothing  =  putStrLn "-1"
print (Just (a, b))  =  putStrLn (show a ++ " " ++ show b)

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

-- Codeforces 7C

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [a, b, c] <- (map read . words) <$> getLine
    let !(d, x, y) = exgcd a b
        !t = c `div` d
    if c `mod` d /= 0
        then print (-1)
        else putStrLn . unwords . map show $ [- x * t, - y * t]

exgcd :: Integer -> Integer -> (Integer, Integer, Integer)
exgcd !a !0 = (a, 1, 0)
exgcd !a !b = let !(d, x, y) = exgcd b (a `mod` b)
             in (d, y, x - y * (a `div` b))

import Control.Exception

ex_gcd a b
	| b==0 = (1,0,a)
	| otherwise = (a'',b'',r)
		where
			(a',b',r) = ex_gcd b (a `mod` b)
			a'' = b'
			b'' = a' - b' * (a `div` b)

solve a b c = (a'*c, b'*c)
	where
		(a',b',g) = ex_gcd a b

pprint a b c =
	if (c `mod` g) /= 0 then show (-1) else show x ++ " " ++ show y
		where
			(x,y) = solve a' b' c'
			(_,_,g) = ex_gcd a b
			[a',b',c'] = map (`div` g) [a,b,c]

main = do
	[a,b,c'] <- (map read . words) `fmap` getLine
	let c = -c'
	putStrLn $ pprint a b c

gcd_ext :: Integer -> Integer -> (Integer, Integer, Integer)
gcd_ext a 0 = (a, 1, 0)
gcd_ext a b =
	let (g, x, y) = gcd_ext b (a `mod` b)
	in (g, y, x - a `div` b * y)

solve :: (Integer, Integer, Integer) -> Maybe (Integer, Integer)
solve (a, b, c) =
	let (g, x, y) = gcd_ext a b
	in if c `mod` g == 0 then Just (x * c `div` (-g), y * c `div` (-g))
		else Nothing

output :: Maybe (Integer, Integer) -> String
output Nothing = "-1"
output (Just (x, y)) = (show x) ++ " " ++ (show y)

input :: [Integer] -> (Integer, Integer, Integer)
input s = (s !! 0, s !! 1, s !! 2)

main = do
	l <- getLine
	putStrLn $ output $ solve $ input $ map (read :: String -> Integer) $ words l

module Main where

import Data.Maybe (maybe)

main :: IO ()
main = interact $ maybe "-1" (\(x,y) -> show x <> " " <> show y) . solve . ints

ints :: String -> [Integer]
ints = map read . words

solve :: [Integer] -> Maybe (Integer, Integer)
solve [a, b, c]
  | c `mod` g == 0 = Just (signum a * s  * cg, signum b * t * cg)
  | otherwise = Nothing
  where
    (s, t, g) = gcd' (abs a) (abs b)
    cg = -(c `div` g)

gcd' :: (Integral a) => a -> a -> (a, a, a)
gcd' a 0 = (1, 0, a)
gcd' a b | a < b = (m, n, d) where (n, m, d) = gcd' b a
gcd' a b = (t, s - q * t, g) where
   (q, r) = a `quotRem` b
   (s, t, g) = gcd' b r

-- Codeforces 7C

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [a, b, c] <- (map read . words) <$> getLine
    let !(d, x, y) = exgcd a b
        !t = c `div` d
    putStrLn . unwords . map show $ [- x * t, - y * t]

exgcd :: Int64 -> Int64 -> (Int64, Int64, Int64)
exgcd !a !0 = (a, 1, 0)
exgcd !a !b = let !(d, y, x) = exgcd b (a `rem` b)
             in (d, x, y - x * (a `div` b))

-- Codeforces 7C

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Int

main :: IO ()
main = do
    [a, b, c] <- (map read . words) <$> getLine
    let !(d, x, y) = exgcd a b
        !t = c `div` d
    if c `mod` d /= 0
        then print (-1)
        else putStrLn . unwords . map show $ [- x * t, - y * t]

exgcd :: Int64 -> Int64 -> (Int64, Int64, Int64)
exgcd !a !0 = (a, 1, 0)
exgcd !a !b = let !(d, y, x) = exgcd b (a `rem` b)
             in (d, x, y - x * (a `div` b))

eeuclid :: Integer -> Integer -> (Integer, Integer, Integer)
eeuclid a 0 = (1, 0, a)
eeuclid a b | a < b = (m, n, d) where (n, m, d) = eeuclid b a
eeuclid a b = (m, n-q*m, g) where
   (q,r) = a `quotRem` b
   (m,n,g) = eeuclid r b

s[a,b,c]
  | c `mod` g /= 0 = [-1]
  | otherwise = [x * (c`div`g), y*(c`div`g)]
  where
  (x,y,g)=eeuclid a b -- x*a + y*b = g

main=interact$unwords.map show.s.map read.words


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

main = do
  n <- readLn :: IO Int
  let num = 10 ^ (n-1)
      m = num `mod` 210
      answer = if (n < 3) then -1 else num + (210 - m)
  print answer

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

getPowTen :: Integer -> Integer
getPowTen a = 10 ^ a

getDiv210 :: Integer -> Integer
getDiv210 a
	| mod a 210 == 0	= a
	| otherwise 		= getDiv210 (a + 10)

main :: IO()
main = do
	str <- getLine
	let n = read (str)
	if (n == 1 || n == 2)
		then putStrLn "-1"
		else putStrLn (show (getDiv210 (getPowTen (n - 1))))

as  =  [3,2,6,4,5,1]

solve :: Int -> String
solve 1  =  "-1"
solve 2  =  "-1"
solve 3  =  "210"
solve n  =  '1' : (replicate m '0') ++ (show d)
  where
    a  =  as !! ((n - 2) `mod` 6)
    d  =  head $ dropWhile (\y -> 7 /= a + y `mod` 7) [20, 50 .. 1000]
    m  =  n - 1 - length (show d)

main :: IO ()
main  =  readLn >>= putStrLn . solve

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

main = do
  n <- readLn :: IO Int
  let num = product $ replicate (n-1) 10
      m = num `mod` 210
      answer = if (n < 3) then -1 else num + (210 - m)
  print answer

main = interact $ show . solve . read

solve n | n < 3       = -1
            | otherwise = t  + 210 - (mod t 210) where t = 10^(n - 1)

main = do
    n <- readLn
    if n < 3 then print (-1)
        else let low = 10 ^ (n - 1) in
                print (head $ [x | x <- [low, low+2..], x `mod` 210 == 0])

module Main where

readInt :: IO Integer
readInt = readLn

solve :: Integer -> Integer
solve n | n < 3 = (-1)
        | otherwise = let base = 10 ^ (n - 1)
                          mod_ = base `mod` 210 in
                      if mod_ > 0 then base + 210 - mod_
                                  else base

main = do
    strn <- readInt
    print $ solve strn

main = interact $ show . f . read where
    f n
        | n < 3 = -1
        | otherwise = 210 * (div (10^(n-2)+20) 21)

main = getLine>>=(\n->pp (read n)$((10^(read n-1)+209)`div`210)*210)
pp n y=print$if length(show y)==n then y else -1

import Control.Applicative
main = do
  n <- read <$> getLine
  let y = ((10^(n-1)+209)`div`210)*210
  print $ if length (show y) == n then y else -1

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

main = do
  n <- readLn :: IO Int
  let num = pow 10 (n-1)
      m = num `mod` 210
      answer = if (n < 3) then -1 else num + (210 - m)
  print answer

pow x n = binaryPow n 1
  where
    binaryPow 1 acc = acc
    binaryPow n acc = if n `mod` 2 == 0 then binaryPow (n `div` 2) (acc*acc) else binaryPow (n-1) (acc*x)

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

main = do
  n <- readLn :: IO Int
  let num = product $ replicate (n-1) 10
      m = num `mod` 210
      answer = num + (210 - m)
  print answer


module Main where

data Tree = Node Tree Tree
          | Leaf Int
          deriving (Show)

buildTree :: String -> Tree
buildTree = buildTree' . zip [1..]
  where buildTree' [] = Leaf (-1)
        buildTree' ((n,c):xs) | c == 'l'  = Node (buildTree' xs) (Leaf n)
                              | otherwise = Node (Leaf n) (buildTree' xs)

preorder :: Tree -> [Int]
preorder tree = reverse $ preorder' tree []
  where preorder' (Leaf leaf) xs       = if leaf == -1 then xs else leaf:xs
        preorder' (Node left right) xs = preorder' right $ preorder' left xs

main = do
  line <- getLine
  putStrLn (unlines . map show . preorder $ buildTree line)

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
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 Data.Foldable
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
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.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

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

main = do
  ds <- getLine

  let
    f i [] = Seq.empty
    f i ('l':ds) = (f (i+1) ds) Seq.|> i
    f i ('r':ds) = i Seq.<| (f (i+1) ds)

  putStr $ unlines $ map show $ toList (f 1 ds)

import Data.Array.ST;
import Control.Monad;
import Control.Monad.ST;

findPos :: String -> ST s [Integer]
findPos stones = do
  let l = fromIntegral $ length stones
  pos <- newArray_ (1, l) :: ST s (STArray s Integer Integer)
  let placeStone (stoneIdx, lowIdx, highIdx) stone =
        case stoneIdx `seq` lowIdx `seq` highIdx `seq` stone of
          'l' -> do
                   writeArray pos highIdx stoneIdx
                   return (stoneIdx + 1, lowIdx, highIdx - 1)
          'r' -> do
                   writeArray pos lowIdx stoneIdx
                   return (stoneIdx + 1, lowIdx + 1, highIdx)
          _   -> error "Illegal character"
  foldM_ placeStone (1, 1, l) stones
  getElems pos

main :: IO ()
main = do
  o <- getLine
  let ord = runST $ findPos o
  forM_ ord print

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Char8 as B
import Data.Sequence (Seq,(<|),(|>),(><),ViewL(..),ViewR(..),viewl,viewr)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F

main = B.getLine >>= putStr . unlines . map show . F.toList . solve

solve bs = go 1 bs
   where
     go !i !bs
       | B.null bs = Seq.empty
       | B.head bs == 'l' = (go (i+1) $ B.tail bs)|>i
       | B.head bs == 'r' = i<|(go (i+1) $ B.tail bs)
       | otherwise = Seq.empty


{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array.Unboxed (UArray, array, (!))
import Data.Maybe (fromJust)
import Debug.Trace (trace)
import qualified Data.ByteString.Char8 as C

doy :: UArray (Int, Int) Int
doy = array ((1,1), (12,31)) $ zip mmdd $ map (*day) [0 ..]
  where
    dom = [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
    day = 24 * 60 * 60
    mmdd = [(m, d) | (m, n) <- zip [1 .. ] dom, d <- [1 .. n]]

newtype State a = State {
    runState :: C.ByteString -> (a, C.ByteString)
  }

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

get = State $ \st -> (st, st)
modify f = State $ \st -> ((), f st)

parse :: State Int
parse = do
  modify $ C.drop 4
  mm <- readInt
  dd <- readInt
  h <- readInt
  m <- readInt
  s <- readInt
  -- trace (show (mm, dd, h, m, s)) $
  return $ doy!(mm,dd) + (h * 60 + m) * 60 + s
  where
    readInt = State $ fromJust . C.readInt . C.tail

gao n m a = go b $ drop (m - 1) b
  where
    b = map (\i -> (fst $ runState parse i, i)) a
    go _ [] = "-1"
    go (a:ax) (b:bx) =
      if fst b - fst a < n
        then C.unpack $ C.take 19 $ snd b
        else go ax bx

main = do
  [n, m] <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  logs <- fmap C.lines $ C.getContents
  putStrLn $ gao n m logs

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

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

main = do
  [n,m] <- map read.words <$> getLine
  logs <- map parse.B.lines <$> B.getContents
  B.putStrLn $ solve n m logs

parse :: B.ByteString -> (Int,B.ByteString)
parse bs0 = num`seq`(num,bs1)
   where
     f c = if c=='-'||c==':' then ' ' else c
     bs1 = B.take 19 bs0
     num = calc.map readInt.tail.B.words.B.map f $! bs1
     calc [mm,dd,h,m,s] = (((mm2dd+dd)*24+h)*60+m)*60+s
      where
       mm2dd = [0,31,60,91,121,152,182,213,244,274,305,335]!!(mm-1)
     calc ns = error $ show ns

solve :: Int -> Int -> [(Int,B.ByteString)] -> B.ByteString
solve n m logs = safeHead.map snd.filter fst.zipWith f logs $ drop (m-1) logs
   where
     f (t0,msg0) (t1,msg1) = (t1<t0+n,msg1)
     safeHead (x:_) = x
     safeHead [] = B.pack "-1"


import Control.Monad

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, m] <- readInts
    a <- readInts
    putStrLn $ if  m == sum a
      then  "YES"
      else  "NO"

module Main where

import Control.Monad

solveCase :: (Int, [Int]) -> String
solveCase (m, xs)
  | sum xs == m = "YES"
  | otherwise = "NO"

readCase :: IO (Int, [Int])
readCase = do
  [_, m] <- map read . words <$> getLine
  xs <- map read . words <$> getLine
  return (m, xs)

main :: IO ()
main = do
  t <- read <$> getLine
  answer <- map solveCase <$> replicateM t readCase
  putStr $ unlines answer


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

-- a + trSum(ans) - x = b + x
-- a + trSum(ans) - b = 2x
-- x has to non negative for a valid ans

trSum :: Integer -> Integer
trSum n = (n * (n + 1)) `div` 2

solve :: Integer -> [Integer] -> Integer
solve ans [a,b]
    | x < 0 || x `mod` 2 /= 0 = solve (ans + 1) [a,b]
    | otherwise               = ans
    where x = (a + (trSum ans) - b)
solve _ _ = 0

-- putStrLn :: String -> IO ()
main :: IO ()
main = do
    input <- getContents
    putStrLn $ unlines . map (show . solve 0) . map (sort . map read . words) . tail . lines $ input

{-# LANGUAGE Safe #-}

module Main where

import qualified Data.ByteString.Char8 as B
import           Data.Maybe (fromJust)
import           Control.Monad (replicateM)
import qualified Data.Set as S
import qualified Data.Map.Strict as MS
import qualified Data.Map as M

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- map (show . diff . (map bInt . B.words)) <$> replicateM n B.getLine
  putStr (unlines xs)

bInt = fst . fromJust . B.readInt

diff :: [Int] -> Int
diff (x:y:_) = f sums where
  d = abs (x-y)
  l = floor . max 0 . (\x -> 1+x/2) . sqrt . fromIntegral $ (4*d+1)
  sums = [(i, (i * (i + 1)) `div` 2) | i <- [l-1 ..]]
  f ((i, x):xs) = if (x >= d) && (x `mod` 2 == d `mod` 2) then i else f xs

sums = [(i, (i * (i + 1)) `div` 2) | i <- [0 .. 44722]]

{-# LANGUAGE Safe #-}

module Main where

import qualified Data.ByteString.Char8 as B
import           Data.Maybe (fromJust)
import           Control.Monad (replicateM)
import qualified Data.Set as S
import qualified Data.Map.Strict as MS
import qualified Data.Map as M

main :: IO ()
main = do
  n <- bInt <$> B.getLine
  xs <- map (show . diff . (map bInt . B.words)) <$> replicateM n B.getLine
  putStr (unlines xs)

bInt = fst . fromJust . B.readInt

diff :: [Int] -> Int
diff (x:y:_) = f sums where
  d = abs (x-y)
  l = floor . max 0 . (\x -> 1+x/2) . sqrt . fromIntegral $ (4*d+1)
  sums = (0,0):[(i, (i * (i + 1)) `div` 2) | i <- [l ..]]
  f ((i, x):xs) = if (x >= d) && (x `mod` 2 == d `mod` 2) then i else f xs

sums = [(i, (i * (i + 1)) `div` 2) | i <- [0 .. 44722]]


import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')
import qualified Data.ByteString.Char8 as B

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap (words . B.unpack) B.getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if and[length (x:xs) > 2,all (\(a,_) -> a == fst (head xs)) (take 2 xs)]
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

{- ok -}
import Control.Applicative ((<$>))
import Data.List (groupBy, sortBy)
import Data.Function (on)
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Prelude hiding (getLine, getContents, lines, words)

readInt' = fst . fromJust . readInt

main = do
	getLine
	people <- map ((\[a, b, c] -> (unpack a, readInt' b, readInt' c)) . words) . lines <$> getContents

	let
		select [(name1, _, _), (name2, _, _)] = name1 ++ " " ++ name2
		select ((name1, _, score1):(name2, _, score2):(name3, _, score3):_) = if score2 == score3 then "?" else name1 ++ " " ++ name2

	putStr . unlines . map (select . reverse) . groupBy ((==) `on` (\(_, a, _) -> a)) $ sortBy (compare `on` (\(a, b, c) -> (b, c))) people

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap words getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 5 (sort i)
        if all (\(a,_) -> a == fst x) (x:xs)
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap words getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if all (\(a,_) -> a == fst x) (x:xs)
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))

import Data.List (foldl',sort)
import Control.Monad
import Data.IntMap hiding (map,foldl')
import qualified Data.ByteString.Char8 as B

main = do
    [n,m] <- fmap ((map read) . words) getLine :: IO [Int]
    l <- (forM [1..n] $ \i ->  do
        [name,region,rank] <- fmap (words . B.unpack) B.getLine
        return (read region,(-(read rank),name)) :: IO (Int,(Int,String)))
    let a = foldl' (\mp (k,v) -> update (\il -> return (v:il)) k mp) (fromList (zip [1..m] (repeat []))) l
        ls = elems a
    forM_ ls $ \i -> do
        let (x:xs) = take 3 (sort i)
        if and[length (x:xs) > 2,all (\(a,_) -> a == fst x) (take 2 xs)]
            then putStrLn "?"
            else putStrLn (snd x ++ " " ++ snd (xs!!0))


main = getLine >> getLine >>= print.solve

solve :: String -> Int
solve xs = min a b
  where ys = map read $ sequence [xs]
        a = count 1 0 ys
        b = count 0 0 ys

count :: Int    -- 次に来ると予想される数字
      -> Int    -- 現在までに塗り替えた回数
      -> [Int]  -- 数字列
      -> Int    -- 塗り替えた回数
count _ r []                = r
count n r (x:xs) | n == x   = count (0^n) r xs
                 |otherwise = count (0^n)(r+1)xs

main = do
	n <- getLine
	s <- getLine
	putStr $ show $ minimum [length $ filter id $ zipWith (==) s $ f $ concat $ repeat "01" | f <- [id, tail]]

gao [] _ = 0
gao (a:b) (c:d) = if a == c then gao b d else 1 + gao (drop 1 b) (tail d)

main = do
	n <- getLine
	s <- getLine
	putStr $ show $ minimum [gao s $ f $ concat $ repeat "01" | f <- [id, tail]]

main = do getLine >>= putStr . unwords . map show . (\n -> n:[1..n-1]) . read


-- Codeforces Round #534 Div.2 (C), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

-- 1st dim: False for vertical, True for Horizontal
-- 3rd dim: False for y, True for x
places :: UArray (Bool,Int,Bool) Int
places = A.listArray ((False,0,False), (True,3,True))
             [1, 1,
              2, 1,
              3, 1,
              4, 1,
              1, 4,
              3, 4,
              1, 4,
              3, 4]

main :: IO ()
main = do
  xs <- map (=='1') <$> getLine
  acc <- A.newArray (False,True) 0 :: IO (IOUArray Bool Int)
  forM_ xs $ \b -> do
    k <- A.readArray acc b
    let y = places A.! (b,k,False)
        x = places A.! (b,k,True)
    putStrLn $ shows x $ ' ' : show y
    A.writeArray acc b $ if k >= 3 then 0 else k+1

{-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
-- import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

-- import Data.Array.ST.Safe
-- import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = getLine >>= mapM_ ( uncurry $ printf "%d %d\n" ) . map ( succ *** succ ) . solve 0 0

solve :: Int -> Int -> String -> [ ( Int, Int ) ]
solve _ _ [] = []
solve v h (c:s)
	| c == '0' = ( 2, v `mod` 4 ) : solve ( succ v ) h s
	| otherwise = ( 0, h `mod` 2 * 2 ) : solve v ( succ h ) s

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

main = do
  s <- getLine
  putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ solve 0 0 s

solve _ _ [] = []
solve v h ('0' : s) = (v + 1, 1) : solve ((v + 2) `mod` 4) h s
solve v h ('1' : s) = (h + 1, 2) : solve v ((h + 1) `mod` 4) s

-- Codeforces Round #534 Div.2 (C), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

-- 1st dim: False for vertical, True for Horizontal
-- 3rd dim: False for x, True for y
places :: UArray (Bool,Int,Bool) Int
places = A.listArray ((False,0,False), (True,3,True))
             [1, 1,
              2, 1,
              3, 1,
              4, 1,
              1, 4,
              3, 4,
              1, 4,
              3, 4]

main :: IO ()
main = do
  xs <- map (=='1') <$> getLine
  acc <- A.newArray (False,True) 0 :: IO (IOUArray Bool Int)
  forM_ xs $ \b -> do
    k <- A.readArray acc b
    let x = places A.! (b,k,False)
        y = places A.! (b,k,True)
    putStrLn $ shows x $ ' ' : show y
    A.writeArray acc b $ if k >= 3 then 0 else k+1


import Data.List

main = interact (format . solve . parse)

parse s = case words s of
  (_:m:k:a) -> (read m :: Integer,
    read k :: Integer,
    map read a :: [Integer])
  _ -> (0, 0, [])

solve :: (Integer, Integer, [Integer]) -> ([Integer], Integer)
solve (m, k, a) =
  foldr (\(i, (index, value)) (l, sum) ->
    (if (mod i m == 0 && not (i == m * k)) then index:l else l, sum + value))
    ([], 0) $
  zip [1..] $
  sortBy (\a b -> compare (fst a) (fst b)) $
  genericTake (m * k) $
  sortBy (\a b -> compare (snd b) (snd a)) $
  zip [1..] a

format (l, sum) = (show sum) ++ "\n" ++ (unwords $ map show l)

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  [n,m,k] <- map readInt . words <$> getLine
  as <- take (m*k) . sortBy (compare `on` (Down . snd))
      . zip [1..] . map toI64 . unfoldr (BS.readInt . BS.dropWhile (<'!'))
        <$> BS.getLine
  print $ sum $ map snd as
  let arr = A.accumArray (\_ -> id) False (1,n) $ map ((,True) . fst) as
            :: UArray Int Bool
      taills = iterate (drop m) $ drop (m-1)
        $ map fst $ filter snd $ A.assocs arr
      ans = map head $ takeWhile (not . null) taills
  putStrLn $ unwords $ map show $ init ans

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N