{-# 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 #-}

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

{-# 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

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


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

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


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)

{-# 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 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'


#!/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

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

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:


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

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

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


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

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 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..]


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


import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

getInts = fmap (map read . words) getLine

main = do
  [h, w] <- getInts
  a <- replicateM h getLine
  let
    scan2d :: [[Int]] -> [[Int]]
    scan2d = transpose . f . transpose . f where f = map (scanl1 (+))

    line :: String -> [Int]
    line l = map fromEnum $ (False:) $ zipWith (\a b -> a == '.' && b == '.') l $ tail l

    hor = listArray ((1, 1), (h, w)) $ concat $ scan2d $ map line a
    vert = listArray ((1, 1), (h, w)) $ concat $ scan2d $ transpose $ map line $ transpose a

    solve [r1, c1, r2, c2] =
        f r2 c2 - f r2 c1 - f (r1-1) c2 + f (r1-1) c1 +
        g r2 c2 - g r2 (c1-1) - g r1 c2 + g r1 (c1-1)
      where
        f 0 _ = 0
        f x y = hor!(x,y)

        g _ 0 = 0
        g x y = vert!(x,y)

  qs <- (readLn >>= \n -> replicateM n getInts)

  putStrLn $ unlines $ map show $ map solve qs

-- They say "years are like dominoes, tumbling one after the other". But would
-- a year fit into a grid? I don't think so.

-- Limak is a little polar bear who loves to play. He has recently got
-- a rectangular grid with h rows and w columns. Each cell is a square, either
-- empty (denoted by '.') or forbidden (denoted by '#'). Rows are numbered 1
-- through h from top to bottom. Columns are numbered 1 through w from left to
-- right.

-- Also, Limak has a single domino. He wants to put it somewhere in a grid.
-- A domino will occupy exactly two adjacent cells, located either in one row
-- or in one column. Both adjacent cells must be empty and must be inside a grid.

-- Limak needs more fun and thus he is going to consider some queries. In each
-- query he chooses some rectangle and wonders, how many way are there to put
-- a single domino inside of the chosen rectangle?

-- Input
-- The first line of the input contains two integers h and w (1 ≤ h, w ≤ 500)
-- – the number of rows and the number of columns, respectively.

-- The next h lines describe a grid. Each line contains a string of the length w.
-- Each character is either '.' or '#' — denoting an empty or forbidden cell,
-- respectively.

-- The next line contains a single integer q (1 ≤ q ≤ 100 000) — the number
-- of queries.

-- Each of the next q lines contains four integers r1i, c1i, r2i, c2i
-- (1 ≤ r1i ≤ r2i ≤ h, 1 ≤ c1i ≤ c2i ≤ w) — the i-th query. Numbers r1i and c1i
-- denote the row and the column (respectively) of the upper left cell of the
-- rectangle. Numbers r2i and c2i denote the row and the column (respectively)
-- of the bottom right cell of the rectangle.

-- Output
-- Print q integers, i-th should be equal to the number of ways to put a single
-- domino inside the i-th rectangle.

module Main where
import Data.Array ((!))
import qualified Data.Array as Array

annotate :: [[a]] -> [((Int,Int),a)]
annotate lst = [((i1,i2),x) | (i1,xs) <- zip [1..] lst, (i2,x) <- zip [1..] xs]

parseBoard :: [String] -> (Array.Array (Int,Int) Integer, Array.Array (Int,Int) Integer)
parseBoard rows = (rowScans, colScans)
  where rowScans = Array.array ((1,1),(rCnt,cCnt)) $ (annotate . interScans . intraScans) rows
        colScans = Array.array ((1,1),(cCnt,rCnt)) $ (annotate . interScans . intraScans . transpose) rows
        intraScans = map (\line -> tail $ scanl score 0 (zip ('#':line) line))
        score aggr (prevCell,curCell)
          | prevCell == '.' && curCell == '.' = aggr + 1
          | otherwise                         = aggr
        interScans = scanl1 addLists
        addLists l1 l2 = map (\(x,y) -> x+y) (zip l1 l2)
        rCnt = length rows
        cCnt = length $ head rows

placements :: (Array.Array (Int,Int) Integer, Array.Array (Int,Int) Integer) -> (Int,Int,Int,Int) -> Integer
placements (rowScans, colScans) (r1,c1,r2,c2)
  =   rowScans ! (r2,c2) - (get rowScans (r1-1,c2) + rowScans ! (r2,c1) - get rowScans (r1-1,c1))
    + colScans ! (c2,r2) - (colScans ! (c2,r1) + get colScans (c1-1,r2) - get colScans (c1-1,r1))
    where get arr (i,j) = if i >= 1 && j >= 1 then arr ! (i,j) else 0

transpose([]:_) = []
transpose (rows) = map head rows : transpose (map tail rows)

sublist start size lst = (take size) . (drop start) $ lst

toTuple [a,b,c,d] = (a,b,c,d)

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

main :: IO ()
main = do
  boardSpecStr <- getLine
  let [rCount, cCount] = map read (words boardSpecStr) :: [Int]

  boardRowsStr <- getLines rCount
  let boardScans = parseBoard boardRowsStr

  qCountStr <- getLine
  let qCount = read qCountStr :: Int

  queriesStr <- getLines qCount
  let queries = map (toTuple . (map read) . words) queriesStr :: [(Int,Int,Int,Int)]

  let answers = map (placements boardScans) queries

  mapM_ (putStrLn . show) answers

-- They say "years are like dominoes, tumbling one after the other". But would
-- a year fit into a grid? I don't think so.

-- Limak is a little polar bear who loves to play. He has recently got
-- a rectangular grid with h rows and w columns. Each cell is a square, either
-- empty (denoted by '.') or forbidden (denoted by '#'). Rows are numbered 1
-- through h from top to bottom. Columns are numbered 1 through w from left to
-- right.

-- Also, Limak has a single domino. He wants to put it somewhere in a grid.
-- A domino will occupy exactly two adjacent cells, located either in one row
-- or in one column. Both adjacent cells must be empty and must be inside a grid.

-- Limak needs more fun and thus he is going to consider some queries. In each
-- query he chooses some rectangle and wonders, how many way are there to put
-- a single domino inside of the chosen rectangle?

-- Input
-- The first line of the input contains two integers h and w (1 ≤ h, w ≤ 500)
-- – the number of rows and the number of columns, respectively.

-- The next h lines describe a grid. Each line contains a string of the length w.
-- Each character is either '.' or '#' — denoting an empty or forbidden cell,
-- respectively.

-- The next line contains a single integer q (1 ≤ q ≤ 100 000) — the number
-- of queries.

-- Each of the next q lines contains four integers r1i, c1i, r2i, c2i
-- (1 ≤ r1i ≤ r2i ≤ h, 1 ≤ c1i ≤ c2i ≤ w) — the i-th query. Numbers r1i and c1i
-- denote the row and the column (respectively) of the upper left cell of the
-- rectangle. Numbers r2i and c2i denote the row and the column (respectively)
-- of the bottom right cell of the rectangle.

-- Output
-- Print q integers, i-th should be equal to the number of ways to put a single
-- domino inside the i-th rectangle.

module Main where

parseBoard :: [String] -> [[Bool]]
parseBoard rowsStr = map parseRow rowsStr
  where parseRow rowStr = map parseCol rowStr
        parseCol colChr = case colChr of
                            '.' -> True
                            '#' -> False

placements :: [[Bool]] -> ([[Integer]], [[Integer]])
placements board = (rowPlacements, colPlacements)
  where rowPlacements = placements' board
        colPlacements = placements' (transpose board)
        placements' boardLines = map (map cellNo) goodAdjacentCells
          where allAdjacentCells = map (\line -> zip3 [1..] line (tail line)) boardLines
                goodAdjacentCells = map (filter cellIsOccupiable) allAdjacentCells
                goodStartingCells = map (map cellNo) goodAdjacentCells
                cellIsOccupiable (_,a,b) = a && b
                cellNo (n,_,_) = n

answerQuery :: ([[Integer]], [[Integer]]) -> [Integer] -> Integer
answerQuery (rPlacements, cPlacements) [r1,c1,r2,c2]
  = toInteger $ foldl (+) 0 (map length relevantRPlacements) + foldl (+) 0 (map length relevantCPlacements)
    where relevantRPlacements = map (takeWhile (\c -> c < c2) . dropWhile (\c -> c < c1)) $ sublist (r1-1) (r2-r1+1) rPlacements
          relevantCPlacements = map (takeWhile (\r -> r < r2) . dropWhile (\r -> r < r1)) $ sublist (c1-1) (c2-c1+1) cPlacements

sublist start size lst = (take $ fromInteger size) . (drop $ fromInteger start) $ lst

transpose ([]:_) = []
transpose x = (map head x) : transpose (map tail x)

main :: IO ()
main = do
  rawInput <- getContents
  let rawLines = lines rawInput

  let boardSpecStr = head $ sublist 0 1 rawLines
  let [rCount, cCount] = map read (words boardSpecStr) :: [Integer]

  let boardRowsStr = sublist 1 rCount rawLines
  let board = parseBoard boardRowsStr

  let legalPlacements = placements board

  let qCountStr = head $ sublist (1 + rCount) 1 rawLines
  let qCount = read qCountStr :: Integer

  let queriesStr = sublist (1 + rCount + 1) qCount rawLines
  let queries = map ((map read) . words) queriesStr :: [[Integer]]

  let answers = map (answerQuery legalPlacements) queries

  putStrLn $ show legalPlacements

  mapM_ (putStrLn . show) answers

-- They say "years are like dominoes, tumbling one after the other". But would
-- a year fit into a grid? I don't think so.

-- Limak is a little polar bear who loves to play. He has recently got
-- a rectangular grid with h rows and w columns. Each cell is a square, either
-- empty (denoted by '.') or forbidden (denoted by '#'). Rows are numbered 1
-- through h from top to bottom. Columns are numbered 1 through w from left to
-- right.

-- Also, Limak has a single domino. He wants to put it somewhere in a grid.
-- A domino will occupy exactly two adjacent cells, located either in one row
-- or in one column. Both adjacent cells must be empty and must be inside a grid.

-- Limak needs more fun and thus he is going to consider some queries. In each
-- query he chooses some rectangle and wonders, how many way are there to put
-- a single domino inside of the chosen rectangle?

-- Input
-- The first line of the input contains two integers h and w (1 ≤ h, w ≤ 500)
-- – the number of rows and the number of columns, respectively.

-- The next h lines describe a grid. Each line contains a string of the length w.
-- Each character is either '.' or '#' — denoting an empty or forbidden cell,
-- respectively.

-- The next line contains a single integer q (1 ≤ q ≤ 100 000) — the number
-- of queries.

-- Each of the next q lines contains four integers r1i, c1i, r2i, c2i
-- (1 ≤ r1i ≤ r2i ≤ h, 1 ≤ c1i ≤ c2i ≤ w) — the i-th query. Numbers r1i and c1i
-- denote the row and the column (respectively) of the upper left cell of the
-- rectangle. Numbers r2i and c2i denote the row and the column (respectively)
-- of the bottom right cell of the rectangle.

-- Output
-- Print q integers, i-th should be equal to the number of ways to put a single
-- domino inside the i-th rectangle.

module Main where
import Data.Array ((!))
import qualified Data.Array as Array

parseBoard :: [String] -> Array.Array (Int,Int) Bool
parseBoard rows = Array.array bounds $ concatMap parseRow (zip [1..] rows)
  where parseRow :: (Int, String) -> [((Int,Int),Bool)]
        parseRow (rIdx,row) = map parseCol $ zip3 (repeat rIdx) [1..] row
        parseCol :: (Int,Int,Char) -> ((Int,Int),Bool)
        parseCol (rIdx,cIdx,col) = case col of
                                     '.' -> ((rIdx,cIdx),True)
                                     '#' -> ((rIdx,cIdx),False)
        bounds = ((1,1), (rCnt,cCnt))
        rCnt = length rows
        cCnt = length $ head rows

placements :: Array.Array (Int,Int) Bool -> Array.Array (Int,Int) Int
placements board = Array.listArray bounds [combPlacements rc | rc <- Array.range bounds]
  where combPlacements (r,c) = if placeable (r,c)
                                 then (if placeable (r+1,c) then 1 else 0)
                                    + (if placeable (r,c+1) then 1 else 0)
                                 else 0
        placeable (r,c) = Array.inRange bounds (r,c) && board ! (r,c)
        bounds = Array.bounds board

answerQuerySlow :: Array.Array (Int,Int) Bool -> (Int,Int,Int,Int) -> Integer
answerQuerySlow board (r1,c1,r2,c2)
  =   foldl add 0 [dirPlacements rc (1,0) | rc <- Array.range ((r1,c1),(r2-1,c2))]
    + foldl add 0 [dirPlacements rc (0,1) | rc <- Array.range ((r1,c1),(r2,c2-1))]
    where add :: Integer -> Int -> Integer
          add x y = x + toInteger y
          combPlacements (r,c) = if placeable (r,c)
                                         then (if placeable (r+1,c) then 1 else 0)
                                            + (if placeable (r,c+1) then 1 else 0)
                                         else 0
          dirPlacements (r,c) (dr,dc) = if placeable (r,c) && placeable (r+dr,c+dc)
                                          then 1
                                          else 0
          placeable (r,c) = Array.inRange bounds (r,c) && board ! (r,c)
          bounds = Array.bounds board

answerQuery :: Array.Array (Int,Int) Int -> (Int,Int,Int,Int) -> Integer
answerQuery precomputedPlacements (r1,c1,r2,c2)
  = foldl add 0 [precomputedPlacements ! rc | rc <- Array.range ((r1,c1),(r2-1,c2-1))]
    where add :: Integer -> Int -> Integer
          add x y = x + toInteger y

sublist start size lst = (take $ fromInteger size) . (drop $ fromInteger start) $ lst

toTuple [a,b,c,d] = (a,b,c,d)

main :: IO ()
main = do
  rawInput <- getContents
  let rawLines = lines rawInput

  let boardSpecStr = head $ sublist 0 1 rawLines
  let [rCount, cCount] = map read (words boardSpecStr) :: [Integer]

  let boardRowsStr = sublist 1 rCount rawLines
  let board = parseBoard boardRowsStr

  let precomputedPlacements = placements board
  putStrLn $ show precomputedPlacements

  let qCountStr = head $ sublist (1 + rCount) 1 rawLines
  let qCount = read qCountStr :: Integer

  let queriesStr = sublist (1 + rCount + 1) qCount rawLines
  let queries = map (toTuple . (map read) . words) queriesStr :: [(Int,Int,Int,Int)]

  --let answers = map (answerQuery precomputedPlacements) queries
  let answers = map (answerQuerySlow board) queries

  mapM_ (putStrLn . show) answers


import Data.Graph
import Data.Foldable
import Control.Monad
import Data.List
import Data.Ord
import Data.Tuple
main :: IO ()
main = routine

routine :: IO ()
routine = do
    [n,k] <- (map read.words) <$> getLine
    edgs <- replicateM (n-1) $ (map read.words) <$> getLine
    let
      tree = toTree n edgs
      enriched = addChildren $ addDepth 0 tree
      scores = toScores $ toList enriched
      answer = sum $ take (n-k) $ sortOn Down scores
      in print answer

toTree :: Int ->  [[Int]] -> Tree Int
toTree n ps =head $ dfs gr [1]
  where
    tups = map (\[a,b] -> (a,b)) ps
    gr = buildG (1,n) (tups++map swap tups)

addDepth :: Integer -> Tree Int -> Tree (Int,Integer)
addDepth n (Node a ts) = Node (a,n) (map (addDepth (n+1)) ts)

addChildren :: Tree (Int,Integer) -> Tree ((Int,Integer),Integer)
addChildren (Node a ts) = Node (a,s) m
  where
    m = map addChildren ts
    s =sum $ map (\(Node (_,c) _) -> c+1 ) m

toScores :: [((Int,Integer),Integer)] -> [Integer]
toScores = map (\((_,d),c) -> c-d)

import Data.Tree
import Data.Graph
import Data.List
import Data.Ord
import Data.Tuple

makeTree :: Int -> [(Int, Int)] -> Tree Int
makeTree n edges = tree
    where
        revEdges = map swap edges
        graph = buildG (1,n) $ edges ++ revEdges
        tree = head $ dfs graph [1]

depthFold :: Int -> ((Int, a) -> [b] -> b) -> Tree a -> b
depthFold depth folder (Node x ts) = folder (depth, x) (map (depthFold (depth+1) folder) ts)

data MyNode = MyNode
    { id :: Int
    , nAncestors :: Int
    , nDescendants :: Int
    } deriving (Eq, Show)

value :: MyNode -> Integer
value (MyNode _ na nd) = fromIntegral na - fromIntegral nd

folder :: (Int, Int) -> [(Tree MyNode, Int)] -> (Tree MyNode, Int)
folder (depth, id) children = (Node (MyNode id depth nDes) $ map fst children, nDes+1)
    where
        nDes = sum $ map snd children

decorateTree :: Tree Int -> Tree MyNode
decorateTree = fst . depthFold 0 folder

maxHappiness :: Int -> Tree Int -> Integer
maxHappiness k rawTree = sum $ take k values
    where
        tree = decorateTree rawTree
        values = sortOn Down $ map value $ flatten tree

parseLine :: String -> [Int]
parseLine = map read . words

parseAndSolve :: [String] -> Integer
parseAndSolve (l1:edgeLines) = maxHappiness k tree
    where
        (n:k:_) = parseLine l1
        makeEdge (s:e:_) = (s,e)
        edges = map (makeEdge . parseLine) edgeLines
        tree = makeTree n edges

parseAndSolveIO :: [String] -> IO Integer
parseAndSolveIO (l1:edgeLines) = do
    _ <- putStrLn (drawTree $ fmap show deTree)
    return $ maxHappiness k tree
    where
        (n:k:_) = parseLine l1
        makeEdge (s:e:_) = (s,e)
        edges = map (makeEdge . parseLine) edgeLines
        tree = makeTree n edges
        deTree = decorateTree tree

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

main1 = do
    ans <- parseAndSolveIO ["8 5","7 5","1 7","6 1","3 7","8 3","2 1","4 5"]
    return ()

import Data.Graph
import Data.Foldable
import Control.Monad
import Data.List
import Data.Ord
import Data.Tuple
main :: IO ()
main = routine

routine :: IO ()
routine = do
    [n,k] <- (map read.words) <$> getLine
    edgs <- replicateM (n-1) $ (map read.words) <$> getLine
    let
      tree = toTree n edgs
      enriched = addChildren $ addDepth 0 tree
      scores = toScores $ toList enriched
      answer = sum $ take (n-k) $ sortOn Down scores
      in print answer

toTree :: Int ->  [[Int]] -> Tree Int
toTree n ps =head $ dfs gr [1]
  where
    tups = map (\[a,b] -> (a,b)) ps
    gr = buildG (1,n) (tups++map swap tups)

addDepth :: Int -> Tree Int -> Tree (Int,Int)
addDepth n (Node a ts) = Node (a,n) (map (addDepth (n+1)) ts)

addChildren :: Tree (Int,Int) -> Tree ((Int,Int),Int)
addChildren (Node a ts) = Node (a,s) m
  where
    m = map addChildren ts
    s =sum $ map (\(Node (_,c) _) -> c+1 ) m

toScores :: [((Int,Int),Int)] -> [Int]
toScores = map (\((_,d),c) -> c-d)

import Data.Tree
import Data.Graph
import Data.List
import Data.Ord
import Data.Tuple

makeTree :: Int -> [(Int, Int)] -> Tree Int
makeTree n edges = tree
    where
        revEdges = map swap edges
        graph = buildG (1,n) $ edges ++ revEdges
        tree = head $ dfs graph [1]

depthFold :: Int -> ((Int, a) -> [b] -> b) -> Tree a -> b
depthFold depth folder (Node x ts) = folder (depth, x) (map (depthFold (depth+1) folder) ts)

data MyNode = MyNode
    { id :: Int
    , nAncestors :: Int
    , nDescendants :: Int
    } deriving (Eq, Show)

value :: MyNode -> Int
value (MyNode _ na nd) = na - nd

folder :: (Int, Int) -> [(Tree MyNode, Int)] -> (Tree MyNode, Int)
folder (depth, id) children = (Node (MyNode id depth nDes) $ map fst children, nDes+1)
    where
        nDes = sum $ map snd children

decorateTree :: Tree Int -> Tree MyNode
decorateTree = fst . depthFold 0 folder

maxHappiness :: Int -> Tree Int -> Int
maxHappiness k rawTree = sum $ take k values
    where
        tree = decorateTree rawTree
        values = sortOn Down $ map value $ flatten tree

parseLine :: String -> [Int]
parseLine = map read . words

parseAndSolve :: [String] -> Int
parseAndSolve (l1:edgeLines) = maxHappiness k tree
    where
        (n:k:_) = parseLine l1
        makeEdge (s:e:_) = (s,e)
        edges = map (makeEdge . parseLine) edgeLines
        tree = makeTree n edges

parseAndSolveIO :: [String] -> IO Int
parseAndSolveIO (l1:edgeLines) = do
    _ <- putStrLn (drawTree $ fmap show deTree)
    return $ maxHappiness k tree
    where
        (n:k:_) = parseLine l1
        makeEdge (s:e:_) = (s,e)
        edges = map (makeEdge . parseLine) edgeLines
        tree = makeTree n edges
        deTree = decorateTree tree

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

main1 = do
    ans <- parseAndSolveIO ["8 5","7 5","1 7","6 1","3 7","8 3","2 1","4 5"]
    return ()

import Data.Tree

main = putStrLn "Testing import"


import Data.List
import Data.Function

f :: [(Int,Int)]->String
f ((_,x):(_,y):_) | x == y = "Still Rozdil"
f ((x,_):_) = show x
f [] = "Still Rozdil"

main = do
  num <- readLn
  nums <- getLine >>= (return.sortBy (compare `on` snd).zip [1..].map read.take num.words)
  putStrLn (f nums)

import Data.List

calc :: [Int] -> String
calc xs
  | length ys > 1 && ys!!0 == ys!!1 = "Still Rozdil"
  | otherwise = case findIndex (==(ys!!0)) xs of
                  Just n -> show (n+1)
                  Nothing -> error "not found"
  where
    ys = sort xs

main = do s <- getLine
          t <- getLine
          putStrLn $ calc $ map (\x -> read x :: Int) $ words t

-- Little Elephant and Rozdil

import Data.List (findIndices)
import Control.Applicative

main :: IO ()
{-
main = getLine >> getLine >>= putStrLn . sol . (map read . words)

sol :: [Int] -> String
sol xs = do
        let ys = findIndices (== minimum xs) xs
        return $ case length ys of
                1 ->  show $ succ . head ys
                _ -> "Still Rozdil"

sol' xs = if lenght (findIndices (== minimum xs) xs) == 1
            then succ $ head

-}

main = do
        getLine
        as <- map (read :: String -> Int) . words <$> getLine
        let m = minimum as
            is = filter ((== m) . snd) $ zip [1..] as

        if length is == 1
          then print $ fst . head $ is
          else putStrLn "Still Rozdil"

solve::Int -> Int -> [(Int,Int)] -> String
solve ret tmp (x:xs)
      | tmp > (snd(x)) = solve (fst(x)) (snd(x)) xs
      | tmp == (snd(x)) = solve (-1) tmp xs
      | otherwise = solve ret tmp xs
solve ret _ []
      | ret == (-1) = "Still Rozdil"
      | otherwise = show ret

main = do
     num <- getLine
     args <- getLine
     let l = zip [1..] $ map (read::String->Int) $ words args
     putStrLn(solve 0 (2^30) l)

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

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

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

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    m = minimum as
    is = findIndices (== m) as

  if length is == 1
     then print $ (head is) + 1
     else putStrLn "Still Rozdil"

main = do
		ngorodov  <- getLine
		goroda <- getLine
		putStrLn $ out ( map read (words goroda))

out :: 	[Integer] -> String
out [_]	= "1"
out goroda = if (first == second) then "Still Rozdil" else path
					where
					first = head $ quicksort goroda
					second = head $ tail $ quicksort goroda
					path = show (findNumberOfElem goroda first)

quicksort :: [Integer]  -> [Integer]
quicksort []           =  []
quicksort (x:xs)       =  quicksort [y | y <- xs, y<x ]
                       ++ [x]
                       ++ quicksort [y | y <- xs, y>=x]

findNumberOfElem ::  [Integer]-> Integer -> Integer
findNumberOfElem [] m = 0
findNumberOfElem (x:xs) m = 1 +  if x == m
								then 0
								else findNumberOfElem xs m

import Data.List
import Data.Function
import qualified Data.ByteString.Char8 as B
import Data.Maybe
main =   putStrLn =<< (\x -> if length x > 1 then "Still Rozdil" else show $ fst $ head x) . head . groupBy ((==) `on` snd ) . sortOn snd . zip [1..] . map ( fst .fromJust .B.readInt) . B.words <$> (B.getLine >> B.getLine)

import Data.List
import Data.Function
main =   putStrLn =<< (\x -> if length x > 1 then "Still Rozdil" else show $ fst $ head x) . head . groupBy ((==) `on` snd ) . sortOn snd . zip [1..] . map ( read :: String -> Int) . words <$> (getLine >> getLine)

import Data.Function (on)
import List (sortBy)

solve :: [Int] -> Maybe Int
solve [x]  =  Just 1
solve xs  =  solve' $ sortBy (compare `on` fst) (zipWith (,) xs [1..])
  where
    solve' ((a,n):(b,_):_)
      | a == b  =  Nothing
      | otherwise  =  Just n

printAns :: Maybe Int -> IO ()
printAns Nothing  =  putStrLn "Still Rozdil"
printAns (Just x)  =  print x

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

import Data.Maybe
import Data.List
main = do
    getLine
    s <- getLine
    let towns :: [Int]
        towns = map read . words $ s
        sortedTowns = group . sort $ towns
    if length (sortedTowns !! 0) == 1 then
        print $ fromJust (elemIndex (sortedTowns !! 0 !! 0) towns) + 1
    else
        putStrLn "Still Rozdil"

import Data.List
import Data.Maybe
f :: [Int] -> String
f a = if((==) 1 $ length $ filter(\x -> x == minimum a) a)
        then show $ (+) 1 $ fromJust $ elemIndex (minimum a) a
      else "Still Rozdil"
main=interact$f.map read.tail.words

import Data.List
import Data.Ord
import Data.Function
import Control.Applicative

main = do
  n <- readLn :: IO Int
  cities <- head.groupBy((==)`on`snd).sortBy(comparing snd).zip[1..n].map read.words <$> getLine :: IO [(Int,Int)]
  case cities of
       [(i,_)] -> print i
       _ -> putStrLn "Still Rozdil"

main = getContents >>= solve [].zip[1..].map read.tail.words

solve :: [(Int,Int)] -> [(Int,Int)] -> IO ()
solve [(i,_)] [] = print i
solve _ [] = putStrLn "Still Rozdil"
solve [] ((j,y):ys) = solve [(j,y)] ys
solve ixs@((i,x):xs) ((j,y):ys)
  | x==y = solve [(i,x),(i,x)] ys
  | x<y  = solve ixs ys
  | x>y  = solve [(j,y)] ys

import qualified Data.ByteString.Char8 as B

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

main = getLine >> B.getContents >>= solve [].zip[1..].map readInt.B.words

solve [(i,_)] [] = print i
solve _ [] = putStrLn "Still Rozdil"
solve [] ((j,y):ys) = solve [(j,y)] ys
solve ixs@((i,x):xs) ((j,y):ys)
  | x==y = solve [(i,x),(i,x)] ys
  | x<y  = solve ixs ys
  | x>y  = solve [(j,y)] ys

import Data.List
import Control.Arrow

main :: IO ()
main = interact $ lines >>> tail >>> head >>> words >>> map read >>> solve >>> showA >>> (++"\n")

showA :: Maybe Int -> String
showA Nothing  = "Still Rozdil"
showA (Just x) = show x

solve :: [Int] -> Maybe Int
solve xs = let m = minimum xs in case length $ elemIndices m xs of
  1 -> elemIndex m xs >>= (return . (+1))
  _ -> Nothing

import Control.Applicative
import Data.List

readInput :: IO [Int]
readInput = do
  _ <- getLine
  map read . words <$> getLine

countOccurences :: Eq a => a -> [a] -> Int
countOccurences x = length . (elemIndices x)

solve :: [Int] -> Maybe Int
solve xs | countOccurences m xs == 1 = elemIndex m xs
         | otherwise                 = Nothing
       where m = minimum xs

main :: IO ()
main = readInput >>= (putStrLn . show' . solve)
  where show' (Just x) = show $ x + 1
        show' Nothing  = "Still Rozdil"

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

-- readInput :: IO [Int]
-- readInput = do
--   _ <- getLine
--   map read . words <$> getLine

readInput :: IO [Int]
readInput = do
  _ <- B.getLine
  map (fst . fromJust . B.readInt) . B.words <$> B.getLine

countOccurences :: Eq a => a -> [a] -> Int
countOccurences x = length . (elemIndices x)

solve :: [Int] -> Maybe Int
solve xs | countOccurences m xs == 1 = elemIndex m xs
         | otherwise                 = Nothing
       where m = minimum xs

main :: IO ()
main = readInput >>= (putStrLn . show' . solve)
  where show' (Just x) = show $ x + 1
        show' Nothing  = "Still Rozdil"

module Main where

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

main = do
    getLine
    xs <- map (read::String->Int). words <$> getLine
    let
        m = minimum xs
        f = filter ((m==). snd)$ zip [1..] xs
    if length f == 1 then print. fst. head$ f
        else putStrLn "Still Rozdil"

import Data.List

calc :: [Int] -> String
calc xs
  | length xs > 1 && ys!!0 == ys!!1 = "Still Rozdil"
  | otherwise = case findIndex (== (ys!!0)) xs of
                  Just n -> show (n+1)
                  Nothing -> error "not found"
  where
    ys = sort xs

main = do s <- getLine
          t <- getLine
          putStrLn $ calc $ map (\x -> read x :: Int) $ words t

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

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

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

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    m = minimum as
    is = findIndices (== m) as

  if length is == 1
     then print m
     else putStrLn "Still Rozdil"

import List (sort)

solve :: [Int] -> Maybe Int
solve [x]  =  Just x
solve xs  =  solve' $ sort xs
  where
    solve' (a:b:_)
      | a == b  =  Nothing
      | otherwise  =  Just a

printAns :: Maybe Int -> IO ()
printAns Nothing  =  putStrLn "Still Rozdil"
printAns (Just x)  =  print x

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

import Data.Function (on)
import List (sortBy)

solve :: [Int] -> Maybe Int
solve [x]  =  Just x
solve xs  =  solve' $ sortBy (compare `on` fst) (zipWith (,) xs [1..])
  where
    solve' ((a,n):(b,_):_)
      | a == b  =  Nothing
      | otherwise  =  Just n

printAns :: Maybe Int -> IO ()
printAns Nothing  =  putStrLn "Still Rozdil"
printAns (Just x)  =  print x

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

import Data.List
import Control.Arrow

main :: IO ()
main = interact $ lines >>> tail >>> head >>> words >>> map read >>> solve >>> showA >>> (++"\n")

showA :: Maybe Int -> String
showA Nothing  = "Still Rozdil"
showA (Just x) = show x

solve :: [Int] -> Maybe Int
solve xs = let m = minimum xs in case length $ elemIndices m xs of
  1 -> Just m
  _ -> Nothing

import Data.List
import Control.Arrow

main :: IO ()
main = interact $ lines >>> tail >>> head >>> words >>> map read >>> solve >>> showA >>> (++"\n")

showA :: Maybe Int -> String
showA Nothing  = "Still Rozdil"
showA (Just x) = show x

solve :: [Int] -> Maybe Int
solve xs = let m = minimum xs in case length $ elemIndices m xs of
  1 -> elemIndex m xs
  _ -> Nothing

import Data.List

f :: [Int]->String
f (x:y:[]) | x == y = "Still Rozdil"
f (x:_) = show x
f [] = "Still Rozdil"

main = do
  num <- readLn
  nums <- getLine >>= (return.sort.map read.take num.words)
  putStrLn (f nums)

import Data.List

calc xs

  | length xs > 1 && xs!!0 == xs!!1 = "Still Rozdil"

  | otherwise = show $ xs!!0

main = do s <- getLine

          t <- getLine

          putStrLn $ calc $ sort $ map (\x -> read x :: Int) $ words t


main :: IO ()
main = interact $ unlines . map (solve . read) . drop 1 . lines

solve :: Int -> String
solve x = build (if x `mod` 3 == 1 then 1 else 2) x ""

build :: Int -> Int -> String -> String
build _ 0 res = reverse res
build d x acc = build (3 - d) (x - d) (show d ++ acc)

module Main where

import           Control.Monad
import           Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        if (n `mod` 3) == 1
        then
            putStrLn $ f 1 n
        else
            putStrLn $ f 2 n

f :: Int -> Int -> String
f _ 0 = ""
f 1 n = '1' : f 2 (n - 1)
f _ n = '2' : f 1 (n - 2)

-- 1
-- 2
-- 21
-- 121
-- 212
-- 2121
-- 12121

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> String
solve cnt
    | cnt `mod` 3 == 1 = concat $ "1" : replicate (cnt `div` 3) "21"
    | cnt `mod` 3 == 2 = concat $ "2" : replicate (cnt `div` 3) "12"
    | cnt `mod` 3 == 0 = concat $ replicate (cnt `div` 3) "21"

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        let answer = solve n
        puts answer

main :: IO ()
main = interact $ unlines . map (show . solve . read) . drop 1 . lines

solve :: Int -> Int
solve x = build (if x `mod` 3 == 1 then 1 else 2) x 0

build :: Int -> Int -> Int -> Int
build _ 0 res = res
build d x acc = build (3 - d) (x - d) (acc * 10 + d)


getList :: Read a => IO [a]
getList = map read . words <$> getLine

solve :: Int -> IO()
solve t
    | t > 0 = do
        getLine
        nums <- getList
        print $ length $ filter (/= 2) nums
        solve $ t - 1
    | otherwise = return ()

main :: IO()
main = do
    [t] <- getList
    solve t

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Integer

solve :: Integer -> [Integer] -> Output
solve n a = n - sum [1 | x<-a, x == 2]

plotResult :: Output -> IO ()
plotResult = print

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n a
	return ()

module Main where
   solve :: IO ()
   solve = do
       _ <- getLine
       s <- getLine
       print $ length . filter (/= "2") $ words s

   iter :: Integer -> IO ()
   iter 1 = solve
   iter x = do
       solve
       iter $ x - 1

   main :: IO ()
   main = do
       q <- getLine
       iter (read q :: Integer)

import Control.Monad

readInt :: IO Integer
readInt = readLn

readArray :: Read a => IO [a]
readArray = fmap (map read . words) getLine

readInts :: IO [Integer]
readInts = readArray

solve :: [Integer] -> Int
solve = length . filter (/= 2)

solveCase :: IO String
solveCase = readInt >> fmap (show . solve) readInts
--solveCase = do
--  (n:x:[]) <- readInts
--  fmap (show . solve x) readInts

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

getInts :: IO [Int]
getInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    rs <- getInts
    C.putStrLn $ C.pack $ show $ length $ filter (/= 2) rs


{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Data.IORef
import Control.Monad.ST.Safe
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as STT
import Control.Monad.Trans.Class
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C
import Text.Read (readEither)

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = do
    let bns = C.dropWhile isSpace b in
        if C.null bns then getNewLine >>= (\x -> STT.put x >>= const (return x))
        else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = do
    r <- STT.get
    (a, nr) <- liftM convert $ getRemain r
    STT.put nr
    return a

put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = do
    o <- STT.evalStateT main_ C.empty
    return o

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
main_ = do
    (n, m) <- liftM2 (,) get get
    l <- replicateM m $ liftM2 (,) get get
    k <- get
    p <- replicateM k get
    let (minr, maxr) = f1 (buildGraph n l) p in
        putln $ show minr ++ " " ++ show maxr

buildGraph :: Int -> [(Int, Int)] -> IntMap (IntSet)
buildGraph n l = foldl (\m (i, j) -> IntMap.adjust (IntSet.insert j) i m) (IntMap.fromSet (const IntSet.empty) $ IntSet.fromDistinctAscList [1..n]) l

transposeG :: IntMap (IntSet) -> IntMap (IntSet)
transposeG g = IntMap.foldlWithKey (\m i s -> IntSet.foldl (\m j -> IntMap.adjust (IntSet.insert i) j m) m s) (IntMap.map (const IntSet.empty) g) g

bfs :: a -> (a -> a) -> Int -> IntMap (IntSet) -> IntMap a
bfs init modify root g = let aux [] [] _ vs = foldl (\m (i, a) -> IntMap.insert i a m) IntMap.empty vs
                             aux [] nextv visited vs = aux (reverse nextv) [] visited vs
                             aux ((v, x) : l) nextv visited vs = let nextx = modify x in
                                                                 let (nvisited, nvlist) = IntSet.foldl (\(v, l) i -> if not $ IntSet.member i visited then (IntSet.insert i v, (i, nextx) : l) else (v, l)) (visited, nextv) (g IntMap.! v) in
                                                                 aux l nvlist nvisited $ (v, x) : vs
                         in
                         aux [(root, init)] [] (IntSet.singleton root) [(root, init)]

f1 :: IntMap (IntSet) -> [Int] -> (Int, Int)
f1 g [] = (0, 0)
f1 g (s : l) = let sd = bfs 0 ((+) 1) (last (s : l)) (transposeG g) in
               let (_, minr, maxr) = foldl (\(prev, i, j) p -> let pd = sd IntMap.! prev in
                                         if pd - (sd IntMap.! p) < 1 then (p, i + 1, j + 1)
                                         else if (IntSet.foldl (\b i -> if pd - (sd IntMap.! i) == 1 then b + 1 else b) 0 (g IntMap.! prev)) > 1 then (p, i, j + 1)
                                         else (p, i, j)
                     ) (s, 0, 0) l in
                (minr, maxr)

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Data.IORef
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C
import Text.Read (readEither)

getNewLine :: IO ByteString
getNewLine = C.hGetLine stdin >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: IORef ByteString -> IO ByteString
getRemain b = do
    bs <- readIORef b
    let bns = C.dropWhile isSpace bs in
        if C.null bns then getNewLine >>= (\x -> writeIORef b x >>= const (return x))
        else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => IORef ByteString -> IO a
get ibuf = do
    (a, r) <- liftM convert $ getRemain ibuf
    writeIORef ibuf r
    return a

put :: IOInteract a => a -> IO ()
put = (hPutStr stdout) . toShow
putln :: IOInteract a => a -> IO ()
putln = (hPutStrLn stdout) . toShow
flush :: IO ()
flush = hFlush stdout

main :: IO ()
main = do
    ibuf <- newIORef C.empty
    o <- main_ ibuf
    return o

main_ :: IORef ByteString -> IO ()
-------------------------------------------- template ------------------------------------------------------
main_ ibuf = do
    (n, m) <- liftM2 (,) (get ibuf) (get ibuf)
    l <- replicateM m $ liftM2 (,) (get ibuf) (get ibuf)
    k <- (get ibuf)
    p <- replicateM k (get ibuf)
    let (minr, maxr) = f1 (buildGraph n l) p in
        putln $ show minr ++ " " ++ show maxr

buildGraph :: Int -> [(Int, Int)] -> IntMap (IntSet)
buildGraph n l = foldl (\m (i, j) -> IntMap.adjust (IntSet.insert j) i m) (IntMap.fromSet (const IntSet.empty) $ IntSet.fromDistinctAscList [1..n]) l

transposeG :: IntMap (IntSet) -> IntMap (IntSet)
transposeG g = IntMap.foldlWithKey (\m i s -> IntSet.foldl (\m j -> IntMap.adjust (IntSet.insert i) j m) m s) (IntMap.map (const IntSet.empty) g) g

bfs :: a -> (a -> a) -> Int -> IntMap (IntSet) -> IntMap a
bfs init modify root g = let aux [] [] _ vs = foldl (\m (i, a) -> IntMap.insert i a m) IntMap.empty vs
                             aux [] nextv visited vs = aux (reverse nextv) [] visited vs
                             aux ((v, x) : l) nextv visited vs = let nextx = modify x in
                                                                 let (nvisited, nvlist) = IntSet.foldl (\(v, l) i -> if not $ IntSet.member i visited then (IntSet.insert i v, (i, nextx) : l) else (v, l)) (visited, nextv) (g IntMap.! v) in
                                                                 nvisited `seq` aux l nvlist nvisited $ (v, x) : vs
                         in
                         aux [(root, init)] [] (IntSet.singleton root) [(root, init)]

f1 :: IntMap (IntSet) -> [Int] -> (Int, Int)
f1 g [] = (0, 0)
f1 g (s : l) = let sd = bfs 0 ((+) 1) (last (s : l)) (transposeG g) in
               let (_, minr, maxr) = foldl (\(prev, i, j) p -> let pd = sd IntMap.! prev in
                                         if pd - (sd IntMap.! p) < 1 then (p, i + 1, j + 1)
                                         else if (IntSet.foldl (\b i -> if pd - (sd IntMap.! i) == 1 then b + 1 else b) 0 (g IntMap.! prev)) > 1 then (p, i, j + 1)
                                         else (p, i, j)
                     ) (s, 0, 0) l in
                (minr, maxr)

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Data.IORef
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C
import Text.Read (readEither)

getNewLine :: IO ByteString
getNewLine = C.hGetLine stdin >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: IORef ByteString -> IO ByteString
getRemain b = do
    bs <- readIORef b
    let bns = C.dropWhile isSpace bs in
        if C.null bns then getNewLine >>= (\x -> writeIORef b x >>= const (return x))
        else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => IORef ByteString -> IO a
get ibuf = do
    (a, r) <- liftM convert $ getRemain ibuf
    writeIORef ibuf r
    return a

put :: IOInteract a => a -> IO ()
put = (hPutStr stdout) . toShow
putln :: IOInteract a => a -> IO ()
putln = (hPutStrLn stdout) . toShow
flush :: IO ()
flush = hFlush stdout

main :: IO ()
main = do
    ibuf <- newIORef C.empty
    o <- main_ ibuf
    return o

main_ :: IORef ByteString -> IO ()
-------------------------------------------- template ------------------------------------------------------
main_ ibuf = do
    (n, m) <- liftM2 (,) (get ibuf) (get ibuf)
    l <- replicateM m $ liftM2 (,) (get ibuf) (get ibuf)
    k <- (get ibuf)
    p <- replicateM k (get ibuf)
    let (minr, maxr) = f1 (buildGraph n l) p in
        putln $ show minr ++ " " ++ show maxr

buildGraph :: Int -> [(Int, Int)] -> IntMap (IntSet)
buildGraph n l = foldl' (\m (i, j) -> IntMap.adjust (IntSet.insert j) i m) (IntMap.fromSet (const IntSet.empty) $ IntSet.fromDistinctAscList [1..n]) l

transposeG :: IntMap (IntSet) -> IntMap (IntSet)
transposeG g = IntMap.foldlWithKey (\m i s -> IntSet.foldl' (\m j -> IntMap.adjust (IntSet.insert i) j m) m s) (IntMap.map (const IntSet.empty) g) g

bfs :: a -> (a -> a) -> Int -> IntMap (IntSet) -> IntMap a
bfs init modify root g = let aux [] [] _ vs = foldl' (\m (i, a) -> IntMap.insert i a m) IntMap.empty vs
                             aux [] nextv visited vs = aux (reverse nextv) [] visited vs
                             aux ((v, x) : l) nextv visited vs = let nextx = modify x in
                                                                 let (nvisited, nvlist) = IntSet.foldl' (\(v, l) i -> if not $ IntSet.member i visited then (IntSet.insert i v, (i, nextx) : l) else (v, l)) (visited, nextv) (g IntMap.! v) in
                                                                 nvisited `seq` aux l nvlist nvisited $ (v, x) : vs
                         in
                         aux [(root, init)] [] (IntSet.singleton root) [(root, init)]

f1 :: IntMap (IntSet) -> [Int] -> (Int, Int)
f1 g [] = (0, 0)
f1 g (s : l) = let sd = bfs 0 ((+) 1) (last (s : l)) (transposeG g) in
               let (_, minr, maxr) = foldl' (\(prev, i, j) p -> let pd = sd IntMap.! prev in
                                         if pd - (sd IntMap.! p) < 1 then (p, i + 1, j + 1)
                                         else if (IntSet.foldl' (\b i -> if pd - (sd IntMap.! i) == 1 then b + 1 else b) 0 (g IntMap.! prev)) > 1 then (p, i, j + 1)
                                         else (p, i, j)
                     ) (s, 0, 0) l in
                (minr, maxr)