Anya has bought a new smartphone that uses Berdroid operating system. The smartphone menu has exactly n applications, each application has its own icon. The icons are located on different screens, one screen contains k icons. The icons from the first to the k-th one are located on the first screen, from the (k + 1)-th to the 2k-th ones are on the second screen and so on (the last screen may be partially empty).Initially the smartphone menu is showing the screen number 1. To launch the application with the icon located on the screen t, Anya needs to make the following gestures: first she scrolls to the required screen number t, by making t - 1 gestures (if the icon is on the screen t), and then make another gesture — press the icon of the required application exactly once to launch it.After the application is launched, the menu returns to the first screen. That is, to launch the next application you need to scroll through the menu again starting from the screen number 1.All applications are numbered from 1 to n. We know a certain order in which the icons of the applications are located in the menu at the beginning, but it changes as long as you use the operating system. Berdroid is intelligent system, so it changes the order of the icons by moving the more frequently used icons to the beginning of the list. Formally, right after an application is launched, Berdroid swaps the application icon and the icon of a preceding application (that is, the icon of an application on the position that is smaller by one in the order of menu). The preceding icon may possibly be located on the adjacent screen. The only exception is when the icon of the launched application already occupies the first place, in this case the icon arrangement doesn't change.Anya has planned the order in which she will launch applications. How many gestures should Anya make to launch the applications in the planned order? Note that one application may be launched multiple times.

The first line of the input contains three numbers n, m, k (1 ≤ n, m, k ≤ 105) — the number of applications that Anya has on her smartphone, the number of applications that will be launched and the number of icons that are located on the same screen. The next line contains n integers, permutation a1, a2, ..., an — the initial order of icons from left to right in the menu (from the first to the last one), ai —  is the id of the application, whose icon goes i-th in the menu. Each integer from 1 to n occurs exactly once among ai. The third line contains m integers b1, b2, ..., bm(1 ≤ bi ≤ n) — the ids of the launched applications in the planned order. One application may be launched multiple times.

Print a single number — the number of gestures that Anya needs to make to launch all the applications in the desired order.

NoteIn the first test the initial configuration looks like (123)(456)(78), that is, the first screen contains icons of applications 1, 2, 3, the second screen contains icons 4, 5, 6, the third screen contains icons 7, 8. After application 7 is launched, we get the new arrangement of the icons — (123)(457)(68). To launch it Anya makes 3 gestures. After application 8 is launched, we get configuration (123)(457)(86). To launch it Anya makes 3 gestures. After application 1 is launched, the arrangement of icons in the menu doesn't change. To launch it Anya makes 1 gesture.In total, Anya makes 7 gestures.

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

-- traceDebug = trace
traceDebug _ x = x

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

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

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

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

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

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

main = main_mut

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

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

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

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

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

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

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

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

type IntMap = Data.Map.Map Int Int

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

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

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

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

-- traceDebug = trace
traceDebug _ x = x

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

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

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

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

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

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

main = main_mut

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

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

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

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

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


In the autumn of this year, two Russian teams came into the group stage of the most prestigious football club competition in the world — the UEFA Champions League. Now, these teams have already started to play in the group stage and are fighting for advancing to the playoffs. In this problem we are interested in the draw stage, the process of sorting teams into groups.The process of the draw goes as follows (the rules that are described in this problem, are somehow simplified compared to the real life). Suppose n teams will take part in the group stage (n is divisible by four). The teams should be divided into groups of four. Let's denote the number of groups as m (). Each team has a rating — an integer characterizing the team's previous achievements. The teams are sorted by the rating's decreasing (no two teams have the same rating).After that four "baskets" are formed, each of which will contain m teams: the first m teams with the highest rating go to the first basket, the following m teams go to the second one, and so on.Then the following procedure repeats m - 1 times. A team is randomly taken from each basket, first from the first basket, then from the second, then from the third, and at last, from the fourth. The taken teams form another group. After that, they are removed from their baskets.The four teams remaining in the baskets after (m - 1) such procedures are performed, form the last group.In the real draw the random selection of teams from the basket is performed by people — as a rule, the well-known players of the past. As we have none, we will use a random number generator, which is constructed as follows. Its parameters are four positive integers x, a, b, c. Every time there is a call to the random number generator, it produces the following actions:  calculates ;  replaces parameter x by value y (assigns );  returns x as another random number. Operation  means taking the remainder after division: , .A random number generator will be used in the draw as follows: each time we need to randomly choose a team from the basket, it will generate a random number k. The teams that yet remain in the basket are considered numbered with consecutive integers from 0 to s - 1, in the order of decreasing rating, where s is the current size of the basket. Then a team number  is taken from the basket.Given a list of teams and the parameters of the random number generator, determine the result of the draw.

The first input line contains integer n (4 ≤ n ≤ 64, n is divisible by four) — the number of teams that take part in the sorting. The second line contains four space-separated integers x, a, b, c (1 ≤ x, a, b, c ≤ 1000) — the parameters of the random number generator. Each of the following n lines describes one team. The description consists of the name of the team and its rating, separated by a single space. The name of a team consists of uppercase and lowercase English letters and has length from 1 to 20 characters. A team's rating is an integer from 0 to 1000. All teams' names are distinct. All team's ratings are also distinct.

Print the way the teams must be sorted into groups. Print the groups in the order, in which they are formed in the sorting. Number the groups by consecutive uppercase English letters, starting from letter 'A'. Inside each group print the teams' names one per line, in the order of decreasing of the teams' rating. See samples for a better understanding of the output format.

8
1 3 1 7
Barcelona 158
Milan 90
Spartak 46
Anderlecht 48
Celtic 32
Benfica 87
Zenit 79
Malaga 16

Group A:
Barcelona
Benfica
Spartak
Celtic
Group B:
Milan
Zenit
Anderlecht
Malaga

NoteIn the given sample the random number generator will be executed four times:   ,  ,  ,  .

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

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

countBasket  =  4 :: Int

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

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

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

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

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

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

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

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

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

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

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

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


Stanley and Megan decided to shop in the "Crossmarket" grocery store, which can be represented as a matrix with $$$n$$$ rows and $$$m$$$ columns. Stanley and Megan can move to an adjacent cell using $$$1$$$ unit of power. Two cells are considered adjacent if they share an edge. To speed up the shopping process, Megan brought her portals with her, and she leaves one in each cell she visits (if there is no portal yet). If a person (Stanley or Megan) is in a cell with a portal, that person can use $$$1$$$ unit of power to teleport to any other cell with a portal, including Megan's starting cell.They decided to split up: Stanley will go from the upper-left cell (cell with coordinates $$$(1, 1)$$$) to the lower-right cell (cell with coordinates $$$(n, m)$$$), whilst Megan needs to get from the lower-left cell (cell with coordinates $$$(n, 1)$$$) to the upper-right cell (cell with coordinates $$$(1, m)$$$).What is the minimum total energy needed for them both to do that?Note that they can choose the time they move. Time does not affect energy.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The only line in the test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10^5$$$).

For each test case print a single integer on a new line – the answer.

Note  In the first test case they can stick to the following plan:   Megan (red circle) moves to the cell $$$(7, 3)$$$. Then she goes to the cell $$$(1, 3)$$$, and Stanley (blue circle) does the same.  Stanley uses the portal in that cell (cells with portals are grey) to get to the cell $$$(7, 3)$$$. Then he moves to his destination — cell $$$(7, 5)$$$.  Megan also finishes her route and goes to the cell $$$(1, 5)$$$. The total energy spent is $$$(2 + 6) + (2 + 1 + 2) + (2)= 15$$$, which is our final answer.

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        ri
    mapM_ (putStrLn.show.solve) tcs

solve nm@[_,_] = f (minimum nm, maximum nm)
  where
    f (n,m) = ((n-1) + (m-1)) + ((n-1) + (min 1 (m-1)))
solve _ = error "Pair (n x m) expected."


Let's call a sequence of integers $$$x_1, x_2, \dots, x_k$$$ MEX-correct if for all $$$i$$$ ($$$1 \le i \le k$$$) $$$|x_i - \operatorname{MEX}(x_1, x_2, \dots, x_i)| \le 1$$$ holds. Where $$$\operatorname{MEX}(x_1, \dots, x_k)$$$ is the minimum non-negative integer that doesn't belong to the set $$$x_1, \dots, x_k$$$. For example, $$$\operatorname{MEX}(1, 0, 1, 3) = 2$$$ and $$$\operatorname{MEX}(2, 1, 5) = 0$$$.You are given an array $$$a$$$ consisting of $$$n$$$ non-negative integers. Calculate the number of non-empty MEX-correct subsequences of a given array. The number of subsequences can be very large, so print it modulo $$$998244353$$$. Note: a subsequence of an array $$$a$$$ is a sequence $$$[a_{i_1}, a_{i_2}, \dots, a_{i_m}]$$$ meeting the constraints $$$1 \le i_1 < i_2 < \dots < i_m \le n$$$. If two different ways to choose the sequence of indices $$$[i_1, i_2, \dots, i_m]$$$ yield the same subsequence, the resulting subsequence should be counted twice (i. e. two subsequences are different if their sequences of indices $$$[i_1, i_2, \dots, i_m]$$$ are not the same).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 5 \cdot 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le n$$$). The sum of $$$n$$$ over all test cases doesn't exceed $$$5 \cdot 10^5$$$.

For each test case, print a single integer — the number of non-empty MEX-correct subsequences of a given array, taken modulo $$$998244353$$$.

NoteIn the first example, the valid subsequences are $$$[0]$$$, $$$[1]$$$, $$$[0,1]$$$ and $$$[0,2]$$$.In the second example, the valid subsequences are $$$[0]$$$ and $$$[1]$$$.In the third example, any non-empty subsequence is valid.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
import Data.Array.ST.Safe
import Control.Monad.ST

p :: Int
p = 998244353

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

solve :: Int -> [Int] -> Int
solve n li = runST $ do
  safe   <- newArray (0-2, n+2) 0 :: ST s (STUArray s Int Int)
  unsafe <- newArray (0-2, n+2) 0 :: ST s (STUArray s Int Int)
  writeArray safe (0-1) 1
  forM_ li $ \ai -> do
    safeBelow   <- readArray safe $ ai - 1
    unsafeBelow <- readArray safe $ ai - 2
    currSafe   <- readArray safe   ai
    currUnsafe <- readArray unsafe ai
    writeArray safe   ai $ currSafe   +! currSafe   +! safeBelow
    writeArray unsafe ai $ currUnsafe +! currUnsafe +! unsafeBelow

    --Tricky test case: [0, 2, 0]; mex is monotonic, good sequences may not be
    unsafeAbove <- readArray unsafe $ ai + 2
    writeArray unsafe (ai + 2) $ unsafeAbove +! unsafeAbove
    {-
    traceShow ("ai", ai,
               "safe", safeBelow, currSafe,
               "unsafe", unsafeBelow, currUnsafe) $ pure ()
    -}
  (\fun -> foldM fun (p-1) [0-2 .. n]) $ \acc i -> acc `seq` do
    currSafe   <- readArray safe   i
    currUnsafe <- readArray unsafe i
    pure $ acc +! currSafe +! currUnsafe

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap putIntLns $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    pure $ solve n a

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putIntLns :: [Int] -> Builder
putIntLns vs = let
  sepPrim = (,) '\n' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
import Data.Array.ST.Safe
import Control.Monad.ST

--import Debug.Trace

p :: Int
p = 998244353

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

solve :: Int -> [Int] -> Int
solve n li = runST $ do
  safe   <- newArray (0-2, n) 0 :: ST s (STUArray s Int Int)
  unsafe <- newArray (0-2, n) 0 :: ST s (STUArray s Int Int)
  writeArray safe (0-1) 1
  forM_ li $ \ai -> do
    safeBelow   <- readArray safe $ ai - 1
    unsafeBelow <- readArray safe $ ai - 2
    currSafe   <- readArray safe   ai
    currUnsafe <- readArray unsafe ai
    writeArray safe   ai $ currSafe   +! currSafe   +! safeBelow
    writeArray unsafe ai $ currUnsafe +! currUnsafe +! unsafeBelow
    {-
    traceShow ("ai", ai,
               "safe", safeBelow, currSafe,
               "unsafe", unsafeBelow, currUnsafe) $ pure ()
    -}
  (\fun -> foldM fun (0-1) [0-2 .. n]) $ \acc i -> acc `seq` do
    currSafe   <- readArray safe   i
    currUnsafe <- readArray unsafe i
    pure $ acc +! currSafe +! currUnsafe

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap putIntLns $ replicateM t $ do
    ~[n] <- getInts 1
    a <- getInts n
    pure $ solve n a

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putIntLns :: [Int] -> Builder
putIntLns vs = let
  sepPrim = (,) '\n' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


Let's call a string good if its length is at least $$$2$$$ and all of its characters are $$$\texttt{A}$$$ except for the last character which is $$$\texttt{B}$$$. The good strings are $$$\texttt{AB},\texttt{AAB},\texttt{AAAB},\ldots$$$. Note that $$$\texttt{B}$$$ is not a good string.You are given an initially empty string $$$s_1$$$.You can perform the following operation any number of times:   Choose any position of $$$s_1$$$ and insert some good string in that position. Given a string $$$s_2$$$, can we turn $$$s_1$$$ into $$$s_2$$$ after some number of operations?

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single string $$$s_2$$$ ($$$1 \leq |s_2| \leq 2 \cdot 10^5$$$). It is guaranteed that $$$s_2$$$ consists of only the characters $$$\texttt{A}$$$ and $$$\texttt{B}$$$. It is guaranteed that the sum of $$$|s_2|$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print "YES" (without quotes) if we can turn $$$s_1$$$ into $$$s_2$$$ after some number of operations, and "NO" (without quotes) otherwise. You can output "YES" and "NO" in any case (for example, strings "yEs", "yes" and "Yes" will be recognized as a positive response).

NoteIn the first test case, we transform $$$s_1$$$ as such: $$$\varnothing \to \color{red}{\texttt{AAB}} \to \texttt{A}\color{red}{\texttt{AB}}\texttt{AB}$$$.In the third test case, we transform $$$s_1$$$ as such: $$$\varnothing \to \color{red}{\texttt{AAAAAAAAB}}$$$.In the second and fourth test case, it can be shown that it is impossible to turn $$$s_1$$$ into $$$s_2$$$.

import Control.Arrow ((>>>))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

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

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

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

import Control.Arrow ((>>>))

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

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

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

import Control.Arrow ((>>>))

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

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

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

import Control.Arrow ((>>>))

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

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

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

import Control.Arrow ((>>>))

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

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

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

import Control.Arrow ((>>>))

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

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

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


Vova has won $$$n$$$ trophies in different competitions. Each trophy is either golden or silver. The trophies are arranged in a row.The beauty of the arrangement is the length of the longest subsegment consisting of golden trophies. Vova wants to swap two trophies (not necessarily adjacent ones) to make the arrangement as beautiful as possible — that means, to maximize the length of the longest such subsegment.Help Vova! Tell him the maximum possible beauty of the arrangement if he is allowed to do at most one swap.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of trophies. The second line contains $$$n$$$ characters, each of them is either G or S. If the $$$i$$$-th character is G, then the $$$i$$$-th trophy is a golden one, otherwise it's a silver trophy.

Print the maximum possible length of a subsegment of golden trophies, if Vova is allowed to do at most one swap.

NoteIn the first example Vova has to swap trophies with indices $$$4$$$ and $$$10$$$. Thus he will obtain the sequence "GGGGGGGSGS", the length of the longest subsegment of golden trophies is $$$7$$$. In the second example Vova can make no swaps at all. The length of the longest subsegment of golden trophies in the sequence is $$$4$$$. In the third example Vova cannot do anything to make the length of the longest subsegment of golden trophies in the sequence greater than $$$0$$$.

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

toint s = (read s) :: Integer

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

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

main = do
  interact $ solve

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

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

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

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

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

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


You're playing a game called Osu! Here's a simplified version of it. There are n clicks in a game. For each click there are two outcomes: correct or bad. Let us denote correct as "O", bad as "X", then the whole play can be encoded as a sequence of n characters "O" and "X".Using the play sequence you can calculate the score for the play as follows: for every maximal consecutive "O"s block, add the square of its length (the number of characters "O") to the score. For example, if your play can be encoded as "OOXOOOXXOO", then there's three maximal consecutive "O"s block "OO", "OOO", "OO", so your score will be 22 + 32 + 22 = 17. If there are no correct clicks in a play then the score for the play equals to 0.You know that the probability to click the i-th (1 ≤ i ≤ n) click correctly is pi. In other words, the i-th character in the play sequence has pi probability to be "O", 1 - pi to be "X". You task is to calculate the expected score for your play.

The first line contains an integer n (1 ≤ n ≤ 105) — the number of clicks. The second line contains n space-separated real numbers p1, p2, ..., pn (0 ≤ pi ≤ 1). There will be at most six digits after the decimal point in the given pi.

Print a single real number — the expected score for your play. Your answer will be considered correct if its absolute or relative error does not exceed 10 - 6.

NoteFor the first example. There are 8 possible outcomes. Each has a probability of 0.125.  "OOO"  →  32 = 9;  "OOX"  →  22 = 4;  "OXO"  →  12 + 12 = 2;  "OXX"  →  12 = 1;  "XOO"  →  22 = 4;  "XOX"  →  12 = 1;  "XXO"  →  12 = 1;  "XXX"  →  0. So the expected score is

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

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

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

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

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

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

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

{-# OPTIONS -ffi -O2 #-}

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

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

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

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


There are n knights sitting at the Round Table at an equal distance from each other. Each of them is either in a good or in a bad mood.Merlin, the wizard predicted to King Arthur that the next month will turn out to be particularly fortunate if the regular polygon can be found. On all vertices of the polygon knights in a good mood should be located. Otherwise, the next month will bring misfortunes.A convex polygon is regular if all its sides have same length and all his angles are equal. In this problem we consider only regular polygons with at least 3 vertices, i. e. only nondegenerated.On a picture below some examples of such polygons are present. Green points mean knights in a good mood. Red points mean ones in a bad mood.  King Arthur knows the knights' moods. Help him find out if the next month will be fortunate or not.

The first line contains number n, which is the number of knights at the round table (3 ≤ n ≤ 105). The second line contains space-separated moods of all the n knights in the order of passing them around the table. "1" means that the knight is in a good mood an "0" means that he is in a bad mood.

Print "YES" without the quotes if the following month will turn out to be lucky. Otherwise, print "NO".

import List
import Array

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

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

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

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

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

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

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

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

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

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

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

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

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

module Main where

--import Debug.Trace

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

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

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

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

---- Answer Code Section ----

type MoodArray = Array Int Bool

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

module Main where

--import Debug.Trace

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

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

type MoodArray = Array Int Bool

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

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

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

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

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

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

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

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

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

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

polygon = filter (> 2) . divisors

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

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

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

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

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

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

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

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

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

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

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

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

polygon = filter (> 2) . divisors

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


Sasha grew up and went to first grade. To celebrate this event her mother bought her a multiplication table $$$M$$$ with $$$n$$$ rows and $$$n$$$ columns such that $$$M_{ij}=a_i \cdot a_j$$$ where $$$a_1, \dots, a_n$$$ is some sequence of positive integers.Of course, the girl decided to take it to school with her. But while she was having lunch, hooligan Grisha erased numbers on the main diagonal and threw away the array $$$a_1, \dots, a_n$$$. Help Sasha restore the array!

The first line contains a single integer $$$n$$$ ($$$3 \leqslant n \leqslant 10^3$$$), the size of the table.  The next $$$n$$$ lines contain $$$n$$$ integers each. The $$$j$$$-th number of the $$$i$$$-th line contains the number $$$M_{ij}$$$ ($$$1 \leq M_{ij} \leq 10^9$$$). The table has zeroes on the main diagonal, that is, $$$M_{ii}=0$$$.

In a single line print $$$n$$$ integers, the original array $$$a_1, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$). It is guaranteed that an answer exists. If there are multiple answers, print any.

import           Control.Monad (replicateM)
import           Data.List     (maximumBy, minimumBy)
import           Data.Ord      (comparing)

main = do
  n <- read <$> getLine :: IO Int
  xss <- replicateM n getLn
  putStrLn $ unwords $ map show $ solve xss

solve :: Integral a => [[a]] -> [a]
solve xss = map (\x -> x `div` (round . sqrt . fromIntegral) (raw !! zeroIndex)) raw
  where
    baseRowIndex = snd $ minimumBy (comparing fst) $ filter (\pair -> fst pair /= 0) (zip (map (!! 0) xss) [0 ..])
    baseRow = xss !! baseRowIndex
    refIndex =
      if baseRowIndex == 0
        then 1
        else 0
    ref = xss !! refIndex
    y = (!! 0) $filter (\i -> zeroIndex /= i && refZeroIndex /= i) [0 .. 2]
    scale = fromIntegral (ref !! y) / fromIntegral (baseRow !! y)
    zeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip baseRow [0 ..]
    refZeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip ref [0 ..]
    raw = take zeroIndex baseRow ++ [round (fromIntegral (ref !! zeroIndex) / scale)] ++ drop (zeroIndex + 1) baseRow

--solve xss = [round (fromIntegral (ref !! zeroIndex) / scale)]
getLn :: IO [Int]
getLn = map read . words <$> getLine

gcd' :: (Integral a) => [a] -> a
gcd' [x]    = x
gcd' (x:xs) = gcd x (gcd' xs)

import           Control.Monad (replicateM)
import           Data.List     (maximumBy, minimumBy)
import           Data.Ord      (comparing)

main = do
  n <- read <$> getLine :: IO Int
  xss <- replicateM n getLn
  putStrLn $ unwords $ map show $  solve xss

solve :: [[Int]] -> [Int]
solve xss = take zeroIndex baseRow ++ [(ref !! zeroIndex) `div` scale] ++ drop (zeroIndex + 1) baseRow
--solve xss = scale : ref
  where
    baseRowIndex = snd $ minimumBy (comparing fst) $ filter (\pair -> fst pair /= 0) (zip (map (!! 0) xss) [0 ..])
    baseRow = xss !! baseRowIndex
    refIndex =
      if baseRowIndex == 0
        then 1
        else 0
    ref = xss !! refIndex
    y = (!! 0) $filter (\i -> zeroIndex /= i && refZeroIndex /= i) [0 .. 2]
    scale = fromIntegral (ref !! y) `div` fromIntegral (baseRow !! y)
    zeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip baseRow [0 ..]
    refZeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip ref [0 ..]

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

import           Control.Monad (replicateM)
import           Data.List     (maximumBy, minimumBy)
import           Data.Ord      (comparing)

main = do
  n <- read <$> getLine :: IO Int
  xss <- replicateM n getLn
  putStrLn $ unwords $ map show $ solve xss

solve :: Integral a => [[a]] -> [a]
solve xss = map (`div` gcd' raw) raw
  where
    baseRowIndex = snd $ minimumBy (comparing fst) $ filter (\pair -> fst pair /= 0) (zip (map (!! 0) xss) [0 ..])
    baseRow = xss !! baseRowIndex
    refIndex =
      if baseRowIndex == 0
        then 1
        else 0
    ref = xss !! refIndex
    y = (!! 0) $filter (\i -> zeroIndex /= i && refZeroIndex /= i) [0 .. 2]
    scale = fromIntegral (ref !! y) / fromIntegral (baseRow !! y)
    zeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip baseRow [0 ..]
    refZeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip ref [0 ..]
    raw = take zeroIndex baseRow ++ [round (fromIntegral (ref !! zeroIndex) / scale)] ++ drop (zeroIndex + 1) baseRow

--solve xss = [round (fromIntegral (ref !! zeroIndex) / scale)]
getLn :: IO [Int]
getLn = map read . words <$> getLine

gcd' :: (Integral a) => [a] -> a
gcd' [x]    = x
gcd' (x:xs) = gcd x (gcd' xs)

import           Control.Monad (replicateM)
import           Data.List     (maximumBy, minimumBy)
import           Data.Ord      (comparing)

main = do
  n <- read <$> getLine :: IO Int
  xss <- replicateM n getLn
  print $ solve xss

solve :: [[Int]] -> [Int]
solve xss = take zeroIndex baseRow ++ [(ref !! zeroIndex) `div` scale] ++ drop (zeroIndex + 1) baseRow
--solve xss = scale : ref
  where
    baseRowIndex = snd $ minimumBy (comparing fst) $ filter (\pair -> fst pair /= 0) (zip (map (!! 0) xss) [0 ..])
    baseRow = xss !! baseRowIndex
    refIndex =
      if baseRowIndex == 0
        then 1
        else 0
    ref = xss !! refIndex
    y = (!! 0) $filter (\i -> zeroIndex /= i && refZeroIndex /= i) [0 .. 2]
    scale = fromIntegral (ref !! y) `div` fromIntegral (baseRow !! y)
    zeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip baseRow [0 ..]
    refZeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip ref [0 ..]

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

import           Control.Monad (replicateM)
import           Data.List     (maximumBy, minimumBy)
import           Data.Ord      (comparing)

main = do
  n <- read <$> getLine :: IO Int
  xss <- replicateM n getLn
  putStrLn $ unwords $ map show $ solve xss

solve :: Integral a => [[a]] -> [a]
solve xss = take zeroIndex baseRow ++ [round (fromIntegral (ref !! zeroIndex) / scale)] ++ drop (zeroIndex + 1) baseRow
--solve xss = [round (fromIntegral (ref !! zeroIndex) / scale)]
  where
    baseRowIndex = snd $ minimumBy (comparing fst) $ filter (\pair -> fst pair /= 0) (zip (map (!! 0) xss) [0 ..])
    baseRow = xss !! baseRowIndex
    refIndex =
      if baseRowIndex == 0
        then 1
        else 0
    ref = xss !! refIndex
    y = (!! 0) $filter (\i -> zeroIndex /= i && refZeroIndex /= i) [0 .. 2]
    scale = fromIntegral (ref !! y) / fromIntegral (baseRow !! y)
    zeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip baseRow [0 ..]
    refZeroIndex = snd . (!! 0) $ filter (\pair -> fst pair == 0) $ zip ref [0 ..]

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


You came to the exhibition and one exhibit has drawn your attention. It consists of $$$n$$$ stacks of blocks, where the $$$i$$$-th stack consists of $$$a_i$$$ blocks resting on the surface.The height of the exhibit is equal to $$$m$$$. Consequently, the number of blocks in each stack is less than or equal to $$$m$$$.There is a camera on the ceiling that sees the top view of the blocks and a camera on the right wall that sees the side view of the blocks. Find the maximum number of blocks you can remove such that the views for both the cameras would not change.Note, that while originally all blocks are stacked on the floor, it is not required for them to stay connected to the floor after some blocks are removed. There is no gravity in the whole exhibition, so no block would fall down, even if the block underneath is removed. It is not allowed to move blocks by hand either.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 100\,000$$$, $$$1 \le m \le 10^9$$$) — the number of stacks and the height of the exhibit. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le m$$$) — the number of blocks in each stack from left to right.

Print exactly one integer — the maximum number of blocks that can be removed.

NoteThe following pictures illustrate the first example and its possible solution.Blue cells indicate removed blocks. There are $$$10$$$ blue cells, so the answer is $$$10$$$.

import Data.List

toint s = (read s) :: Integer

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

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

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

main = do
  interact $ solve

import Data.List

main = do
    input <- getContents
    process input

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

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

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

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

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

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

type Long = Integer

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

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

sortDescending = sortBy (comparing Down)

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

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

type Long = Int64

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

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

sortDescending = sortBy (comparing Down)

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

import Data.List

toint s = (read s) :: Int

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

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

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

main = do
  interact $ solve

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

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

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

sortDescending = sortBy (comparing Down)

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

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

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

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

sortDescending = sortBy (comparing Down)

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


A line on the plane is described by an equation Ax + By + C = 0. You are to find any point on this line, whose coordinates are integer numbers from  - 5·1018 to 5·1018 inclusive, or to find out that such points do not exist.

The first line contains three integers A, B and C ( - 2·109 ≤ A, B, C ≤ 2·109) — corresponding coefficients of the line equation. It is guaranteed that A2 + B2 > 0.

If the required point exists, output its coordinates, otherwise output -1.

import qualified Data.Tuple as Tup

maxPerm = truncate (5* 10 ** 18)

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

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

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

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

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

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

import Monad (liftM)
import Prelude hiding (print)

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

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

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

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

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

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

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

-- Codeforces 7C

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

import Control.Applicative
import Data.Int

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

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

import Control.Exception

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

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

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

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

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

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

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

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

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

module Main where

import Data.Maybe (maybe)

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

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

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

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

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

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

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

-- Codeforces 7C

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

import Control.Applicative
import Data.Int

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

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

-- Codeforces 7C

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

import Control.Applicative
import Data.Int

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

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

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

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

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


This is the hard version of the problem. The only difference is that in this version $$$1 \le q \le 10^5$$$. You can make hacks only if both versions of the problem are solved.There is a process that takes place on arrays $$$a$$$ and $$$b$$$ of length $$$n$$$ and length $$$n-1$$$ respectively. The process is an infinite sequence of operations. Each operation is as follows:   First, choose a random integer $$$i$$$ ($$$1 \le i \le n-1$$$).  Then, simultaneously set $$$a_i = \min\left(a_i, \frac{a_i+a_{i+1}-b_i}{2}\right)$$$ and $$$a_{i+1} = \max\left(a_{i+1}, \frac{a_i+a_{i+1}+b_i}{2}\right)$$$ without any rounding (so values may become non-integer).  See notes for an example of an operation.It can be proven that array $$$a$$$ converges, i. e. for each $$$i$$$ there exists a limit $$$a_i$$$ converges to. Let function $$$F(a, b)$$$ return the value $$$a_1$$$ converges to after a process on $$$a$$$ and $$$b$$$.You are given array $$$b$$$, but not array $$$a$$$. However, you are given a third array $$$c$$$. Array $$$a$$$ is good if it contains only integers and satisfies $$$0 \leq a_i \leq c_i$$$ for $$$1 \leq i \leq n$$$.Your task is to count the number of good arrays $$$a$$$ where $$$F(a, b) \geq x$$$ for $$$q$$$ values of $$$x$$$. Since the number of arrays can be very large, print it modulo $$$10^9+7$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 100$$$). The second line contains $$$n$$$ integers $$$c_1, c_2 \ldots, c_n$$$ ($$$0 \le c_i \le 100$$$). The third line contains $$$n-1$$$ integers $$$b_1, b_2, \ldots, b_{n-1}$$$ ($$$0 \le b_i \le 100$$$). The fourth line contains a single integer $$$q$$$ ($$$1 \le q \le 10^5$$$). The fifth line contains $$$q$$$ space separated integers $$$x_1, x_2, \ldots, x_q$$$ ($$$-10^5 \le x_i \le 10^5$$$).

Output $$$q$$$ integers, where the $$$i$$$-th integer is the answer to the $$$i$$$-th query, i. e. the number of good arrays $$$a$$$ where $$$F(a, b) \geq x_i$$$ modulo $$$10^9+7$$$.

NoteThe following explanation assumes $$$b = [2, 1]$$$ and $$$c=[2, 3, 4]$$$ (as in the sample).Examples of arrays $$$a$$$ that are not good:   $$$a = [3, 2, 3]$$$ is not good because $$$a_1 > c_1$$$;  $$$a = [0, -1, 3]$$$ is not good because $$$a_2 < 0$$$. One possible good array $$$a$$$ is $$$[0, 2, 4]$$$. We can show that no operation has any effect on this array, so $$$F(a, b) = a_1 = 0$$$.Another possible good array $$$a$$$ is $$$[0, 1, 4]$$$. In a single operation with $$$i = 1$$$, we set $$$a_1 = \min(\frac{0+1-2}{2}, 0)$$$ and $$$a_2 = \max(\frac{0+1+2}{2}, 1)$$$. So, after a single operation with $$$i = 1$$$, $$$a$$$ becomes equal to $$$[-\frac{1}{2}, \frac{3}{2}, 4]$$$. We can show that no operation has any effect on this array, so $$$F(a, b) = -\frac{1}{2}$$$.

import Control.Monad ( forM_, when )
import Data.Array.ST ( readArray, writeArray, runSTUArray, MArray(newArray) )
import Data.Array.Unboxed ( (!), array, elems, listArray, UArray )
import Data.Int ( Int64 )

m :: Int64
m = 1000000007

plusMod  a b = if c >= m then c - m else c where c = a + b
minusMod a b = if c < 0 then c + m else c where c = a - b
multMod  a b = a * b `mod` m

solve :: IO()
solve = do
    n <- readLn :: IO Int
    c <- readMany :: IO [Int]
    b <- readMany :: IO [Int]
    q <- readLn :: IO Int
    x <- readMany :: IO [Int]
    let ans = array (-10^5, 10^5) [(i, getAns i) | i <- [-10^5..10^5]] :: UArray Int Int64
        getAns x
            | chk <= 0   = allPoss
            | chk > sumC = 0
            | otherwise  = calc x
            where
                chk     = x * n + bss!n
                allPoss = foldr multMod 1 $ map ((1+) . fromIntegral) c
        sumC = sum c
        bss = listArray (1, n) $ scanl1 (+) $ scanl (+) 0 b :: UArray Int Int
        calc x =
            sum (elems dp) `mod` m
            where
                dp :: UArray Int Int64
                dp = runSTUArray $ do
                    a1 <- newArray (0, sumC) 0
                    a2 <- newArray (0, sumC) 0
                    let ok i j = j >= i * x + bss!i
                    forM_ [0..sumC] $ \j -> when (ok 1 j && j <= ca!1) (writeArray a1 j 1)
                    forM_ [2..n] $ \i -> do
                        let (last, cur) = if even i then (a1, a2) else (a2, a1)
                        forM_ [1..sumC] $ \j -> do
                            x <- readArray last (j - 1)
                            y <- readArray last j
                            writeArray last j (x `plusMod` y)
                        forM_ [0..sumC] $ \j -> do
                            writeArray cur j 0
                            when (ok i j) $ do
                                x <- readArray last j
                                let l = j - ca!i - 1
                                y <- if l < 0 then return 0 else readArray last l
                                writeArray cur j (x `minusMod` y)
                    return (if even n then a2 else a1)
                ca = listArray (1, n) c :: UArray Int Int
    putStr $ unlines $ map (show . (ans!)) x

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

main :: IO()
main = solve

import Control.Monad ( forM_, when )
import Data.Array.ST ( readArray, writeArray, runSTUArray, MArray(newArray) )
import Data.Array.Unboxed ( (!), array, elems, listArray, UArray )
import Data.Int ( Int64 )

m :: Int64
m = 1000000007

plusMod  a b = if c >= m then c - m else c where c = a + b
minusMod a b = if c < 0 then c + m else c where c = a - b
multMod  a b = a * b `mod` m

solve :: IO()
solve = do
    n <- readLn :: IO Int
    c <- readMany :: IO [Int]
    b <- readMany :: IO [Int]
    q <- readLn :: IO Int
    x <- readMany :: IO [Int]
    let ans = array (-10^5, 10^5) [(i, getAns i) | i <- [-10^5..10^5]] :: UArray Int Int64
        getAns x
            | chk <= 0    = allPoss
            | chk >= sumC = 0
            | otherwise   = calc x
            where
                chk     = x * n + bss!n
                allPoss = foldr multMod 1 $ map ((1+) . fromIntegral) c
        sumC = sum c
        bss = listArray (1, n) $ scanl1 (+) $ scanl (+) 0 b :: UArray Int Int
        calc x =
            sum (elems dp) `mod` m
            where
                dp :: UArray Int Int64
                dp = runSTUArray $ do
                    a1 <- newArray (0, sumC) 0
                    a2 <- newArray (0, sumC) 0
                    let ok i j = j >= i * x + bss!i
                    forM_ [0..sumC] $ \j -> when (ok 1 j && j <= ca!1) (writeArray a1 j 1)
                    forM_ [2..n] $ \i -> do
                        let (last, cur) = if even i then (a1, a2) else (a2, a1)
                        forM_ [1..sumC] $ \j -> do
                            x <- readArray last (j - 1)
                            y <- readArray last j
                            writeArray last j (x `plusMod` y)
                        forM_ [0..sumC] $ \j -> do
                            writeArray cur j 0
                            when (ok i j) $ do
                                x <- readArray last j
                                let l = j - ca!i - 1
                                y <- if l < 0 then return 0 else readArray last l
                                writeArray cur j (x `minusMod` y)
                    return (if even n then a2 else a1)
                ca = listArray (1, n) c :: UArray Int Int
    putStr $ unlines $ map (show . (ans!)) x

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

main :: IO()
main = solve


Chilly Willy loves playing with numbers. He only knows prime numbers that are digits yet. These numbers are 2, 3, 5 and 7. But Willy grew rather bored of such numbers, so he came up with a few games that were connected with them.Chilly Willy wants to find the minimum number of length n, such that it is simultaneously divisible by all numbers Willy already knows (2, 3, 5 and 7). Help him with that.A number's length is the number of digits in its decimal representation without leading zeros.

A single input line contains a single integer n (1 ≤ n ≤ 105).

Print a single integer — the answer to the problem without leading zeroes, or "-1" (without the quotes), if the number that meet the problem condition does not exist.

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

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

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

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

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

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

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

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

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

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

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

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

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

main = interact $ show . solve . read

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

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

module Main where

readInt :: IO Integer
readInt = readLn

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

main = do
    strn <- readInt
    print $ solve strn

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

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

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

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

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

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


Squirrel Liss lived in a forest peacefully, but unexpected trouble happens. Stones fall from a mountain. Initially Squirrel Liss occupies an interval [0, 1]. Next, n stones will fall and Liss will escape from the stones. The stones are numbered from 1 to n in order.The stones always fall to the center of Liss's interval. When Liss occupies the interval [k - d, k + d] and a stone falls to k, she will escape to the left or to the right. If she escapes to the left, her new interval will be [k - d, k]. If she escapes to the right, her new interval will be [k, k + d].You are given a string s of length n. If the i-th character of s is "l" or "r", when the i-th stone falls Liss will escape to the left or to the right, respectively. Find the sequence of stones' numbers from left to right after all the n stones falls.

The input consists of only one line. The only line contains the string s (1 ≤ |s| ≤ 106). Each character in s will be either "l" or "r".

Output n lines — on the i-th line you should print the i-th stone's number from the left.

NoteIn the first example, the positions of stones 1, 2, 3, 4, 5 will be , respectively. So you should print the sequence: 3, 5, 4, 2, 1.

module Main where

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

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

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

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

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

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

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

main = do
  ds <- getLine

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

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

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

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

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

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

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

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


You've got a list of program warning logs. Each record of a log stream is a string in this format:  "2012-MM-DD HH:MM:SS:MESSAGE" (without the quotes). String "MESSAGE" consists of spaces, uppercase and lowercase English letters and characters "!", ".", ",", "?". String "2012-MM-DD" determines a correct date in the year of 2012. String "HH:MM:SS" determines a correct time in the 24 hour format.The described record of a log stream means that at a certain time the record has got some program warning (string "MESSAGE" contains the warning's description).Your task is to print the first moment of time, when the number of warnings for the last n seconds was not less than m.

The first line of the input contains two space-separated integers n and m (1 ≤ n, m ≤ 10000). The second and the remaining lines of the input represent the log stream. The second line of the input contains the first record of the log stream, the third line contains the second record and so on. Each record of the log stream has the above described format. All records are given in the chronological order, that is, the warning records are given in the order, in which the warnings appeared in the program.  It is guaranteed that the log has at least one record. It is guaranteed that the total length of all lines of the log stream doesn't exceed 5·106 (in particular, this means that the length of some line does not exceed 5·106 characters). It is guaranteed that all given dates and times are correct, and the string 'MESSAGE" in all records is non-empty.

If there is no sought moment of time, print -1. Otherwise print a string in the format "2012-MM-DD HH:MM:SS" (without the quotes) — the first moment of time when the number of warnings for the last n seconds got no less than m.

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

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

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

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

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

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

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

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

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

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

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

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

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


There are $$$n$$$ candles on a Hanukkah menorah, and some of its candles are initially lit. We can describe which candles are lit with a binary string $$$s$$$, where the $$$i$$$-th candle is lit if and only if $$$s_i=1$$$.  Initially, the candle lights are described by a string $$$a$$$. In an operation, you select a candle that is currently lit. By doing so, the candle you selected will remain lit, and every other candle will change (if it was lit, it will become unlit and if it was unlit, it will become lit).You would like to make the candles look the same as string $$$b$$$. Your task is to determine if it is possible, and if it is, find the minimum number of operations required.

The first line contains an integer $$$t$$$ ($$$1\le t\le 10^4$$$) — the number of test cases. Then $$$t$$$ cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 10^5$$$) — the number of candles. The second line contains a string $$$a$$$ of length $$$n$$$ consisting of symbols 0 and 1 — the initial pattern of lights. The third line contains a string $$$b$$$ of length $$$n$$$ consisting of symbols 0 and 1 — the desired pattern of lights. It is guaranteed that the sum of $$$n$$$ does not exceed $$$10^5$$$.

For each test case, output the minimum number of operations required to transform $$$a$$$ to $$$b$$$, or $$$-1$$$ if it's impossible.

NoteIn the first test case, the two strings are already equal, so we don't have to perform any operations.In the second test case, we can perform a single operation selecting the second candle to transform $$$01$$$ into $$$11$$$.In the third test case, it's impossible to perform any operations because there are no lit candles to select.In the fourth test case, we can perform the following operations to transform $$$a$$$ into $$$b$$$:   Select the $$$7$$$-th candle: $$$100010{\color{red}1}11\to 011101{\color{red} 1}00$$$.  Select the $$$2$$$-nd candle: $$$0{\color{red} 1}1101100\to 1{\color{red} 1}0010011$$$.  Select the $$$1$$$-st candle: $$${\color{red}1}10010011\to {\color{red}1}01101100$$$. In the fifth test case, we can perform the following operations to transform $$$a$$$ into $$$b$$$:   Select the $$$6$$$-th candle: $$$00101{\color{red}1}011\to 11010{\color{red}1}100$$$  Select the $$$2$$$-nd candle: $$$1{\color{red}1}0101100\to 0{\color{red}1}1010011$$$  Select the $$$8$$$-th candle: $$$0110100{\color{red}1}1\to 1001011{\color{red}1}0$$$  Select the $$$7$$$-th candle: $$$100101{\color{red}1}10\to 011010{\color{red}1}01$$$

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

c2i :: Char -> Int
c2i v = fromEnum v - fromEnum '0'

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    ~[a, b] <- map (map c2i . P.unpack) <$> getNext 2
    let
      pa = foldl' (+) 0 a
      pb = foldl' (+) 0 b
      tryEven = do
        guard $ pa == pb
        pure $ foldl' (+) 0 $ zipWith (\x y -> abs $ x - y) a b
      tryOdd = do
        guard $ pa + pb == n + 1
        pure $ foldl' (+) 0 $ zipWith (\x y -> abs $ 1 - x - y) a b
    pure $ putInts $ pure $ case  tryEven ++ tryOdd  of
      [] -> 0-1
      li -> minimum li

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp