They say "years are like dominoes, tumbling one after the other". But would a year fit into a grid? I don't think so.Limak is a little polar bear who loves to play. He has recently got a rectangular grid with h rows and w columns. Each cell is a square, either empty (denoted by '.') or forbidden (denoted by '#'). Rows are numbered 1 through h from top to bottom. Columns are numbered 1 through w from left to right.Also, Limak has a single domino. He wants to put it somewhere in a grid. A domino will occupy exactly two adjacent cells, located either in one row or in one column. Both adjacent cells must be empty and must be inside a grid.Limak needs more fun and thus he is going to consider some queries. In each query he chooses some rectangle and wonders, how many way are there to put a single domino inside of the chosen rectangle?

The first line of the input contains two integers h and w (1 ≤ h, w ≤ 500) – the number of rows and the number of columns, respectively. The next h lines describe a grid. Each line contains a string of the length w. Each character is either '.' or '#' — denoting an empty or forbidden cell, respectively. The next line contains a single integer q (1 ≤ q ≤ 100 000) — the number of queries. Each of the next q lines contains four integers r1i, c1i, r2i, c2i (1 ≤ r1i ≤ r2i ≤ h, 1 ≤ c1i ≤ c2i ≤ w) — the i-th query. Numbers r1i and c1i denote the row and the column (respectively) of the upper left cell of the rectangle. Numbers r2i and c2i denote the row and the column (respectively) of the bottom right cell of the rectangle.

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

NoteA red frame below corresponds to the first query of the first sample. A domino can be placed in 4 possible ways.

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

getInts = fmap (map read . words) getLine

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

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

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

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

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

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

  putStrLn $ unlines $ map show $ map solve qs

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  boardRowsStr <- getLines rCount
  let boardScans = parseBoard boardRowsStr

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

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

  let answers = map (placements boardScans) queries

  mapM_ (putStrLn . show) answers

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

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

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

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

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

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

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

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

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

module Main where

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

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

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

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

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

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

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

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

  let legalPlacements = placements board

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

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

  let answers = map (answerQuery legalPlacements) queries

  putStrLn $ show legalPlacements

  mapM_ (putStrLn . show) answers

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  let precomputedPlacements = placements board
  putStrLn $ show precomputedPlacements

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

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

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

  mapM_ (putStrLn . show) answers


Writing light novels is the most important thing in Linova's life. Last night, Linova dreamed about a fantastic kingdom. She began to write a light novel for the kingdom as soon as she woke up, and of course, she is the queen of it. There are $$$n$$$ cities and $$$n-1$$$ two-way roads connecting pairs of cities in the kingdom. From any city, you can reach any other city by walking through some roads. The cities are numbered from $$$1$$$ to $$$n$$$, and the city $$$1$$$ is the capital of the kingdom. So, the kingdom has a tree structure.As the queen, Linova plans to choose exactly $$$k$$$ cities developing industry, while the other cities will develop tourism. The capital also can be either industrial or tourism city.A meeting is held in the capital once a year. To attend the meeting, each industry city sends an envoy. All envoys will follow the shortest path from the departure city to the capital (which is unique).Traveling in tourism cities is pleasant. For each envoy, his happiness is equal to the number of tourism cities on his path.In order to be a queen loved by people, Linova wants to choose $$$k$$$ cities which can maximize the sum of happinesses of all envoys. Can you calculate the maximum sum for her?

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2\le n\le 2 \cdot 10^5$$$, $$$1\le k< n$$$)  — the number of cities and industry cities respectively. Each of the next $$$n-1$$$ lines contains two integers $$$u$$$ and $$$v$$$ ($$$1\le u,v\le n$$$), denoting there is a road connecting city $$$u$$$ and city $$$v$$$. It is guaranteed that from any city, you can reach any other city by the roads.

Print the only line containing a single integer  — the maximum possible sum of happinesses of all envoys.

NoteIn the first example, Linova can choose cities $$$2$$$, $$$5$$$, $$$6$$$, $$$7$$$ to develop industry, then the happiness of the envoy from city $$$2$$$ is $$$1$$$, the happiness of envoys from cities $$$5$$$, $$$6$$$, $$$7$$$ is $$$2$$$. The sum of happinesses is $$$7$$$, and it can be proved to be the maximum one.In the second example, choosing cities $$$3$$$, $$$4$$$ developing industry can reach a sum of $$$3$$$, but remember that Linova plans to choose exactly $$$k$$$ cities developing industry, then the maximum sum is $$$2$$$.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Tree

main = putStrLn "Testing import"


The Little Elephant loves Ukraine very much. Most of all he loves town Rozdol (ukr. "Rozdil").However, Rozdil is dangerous to settle, so the Little Elephant wants to go to some other town. The Little Elephant doesn't like to spend much time on travelling, so for his journey he will choose a town that needs minimum time to travel to. If there are multiple such cities, then the Little Elephant won't go anywhere.For each town except for Rozdil you know the time needed to travel to this town. Find the town the Little Elephant will go to or print "Still Rozdil", if he stays in Rozdil.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of cities. The next line contains n integers, separated by single spaces: the i-th integer represents the time needed to go from town Rozdil to the i-th town. The time values are positive integers, not exceeding 109. You can consider the cities numbered from 1 to n, inclusive. Rozdil is not among the numbered cities.

Print the answer on a single line — the number of the town the Little Elephant will go to. If there are multiple cities with minimum travel time, print "Still Rozdil" (without the quotes).

NoteIn the first sample there are only two cities where the Little Elephant can go. The travel time for the first town equals 7, to the second one — 4. The town which is closest to Rodzil (the only one) is the second one, so the answer is 2.In the second sample the closest cities are cities two and five, the travelling time to both of them equals 4, so the answer is "Still Rozdil".

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import qualified Data.ByteString.Char8 as B

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

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

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

import Data.List
import Control.Arrow

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

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

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

import Control.Applicative
import Data.List

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

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

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

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

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

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

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

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

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

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

import Data.List
import Data.Function

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

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

module Main where

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

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

import Data.List

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

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

import Data.List

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

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

-- Little Elephant and Rozdil

import Data.List (findIndices)
import Control.Applicative

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

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

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

-}

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

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

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

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

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

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

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

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

import List (sort)

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

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

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

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

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

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

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

import Data.List
import Control.Arrow

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

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

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

import Data.List
import Control.Arrow

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

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

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

import Data.List

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

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

import Data.List

calc xs

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

  | otherwise = show $ xs!!0

main = do s <- getLine

          t <- getLine

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


Madoka finally found the administrator password for her computer. Her father is a well-known popularizer of mathematics, so the password is the answer to the following problem.Find the maximum decimal number without zeroes and with no equal digits in a row, such that the sum of its digits is $$$n$$$.Madoka is too tired of math to solve it herself, so help her to solve this problem!

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Description of the test cases follows. The only line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the required sum of the digits.

For each test case print the maximum number you can obtain.

NoteThe only numbers with the sum of digits equal to $$$2$$$ without zeros are $$$2$$$ and $$$11$$$. But the last one has two ones in a row, so it's not valid. That's why the answer is $$$2$$$.The only numbers with the sum of digits equal to $$$3$$$ without zeros are $$$111$$$, $$$12$$$, $$$21$$$, and $$$3$$$. The first one has $$$2$$$ ones in a row, so it's not valid. So the maximum valid number is $$$21$$$.The only numbers with the sum of digits equals to $$$4$$$ without zeros are $$$1111$$$, $$$211$$$, $$$121$$$, $$$112$$$, $$$13$$$, $$$31$$$, $$$22$$$, and $$$4$$$. Numbers $$$1111$$$, $$$211$$$, $$$112$$$, $$$22$$$ aren't valid, because they have some identical digits in a row. So the maximum valid number is $$$121$$$.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

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

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

module Main where

import           Control.Monad
import           Data.List

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

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

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

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

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

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


You are an upcoming movie director, and you have just released your first movie. You have also launched a simple review site with two buttons to press — upvote and downvote.However, the site is not so simple on the inside. There are two servers, each with its separate counts for the upvotes and the downvotes.$$$n$$$ reviewers enter the site one by one. Each reviewer is one of the following types:   type $$$1$$$: a reviewer has watched the movie, and they like it — they press the upvote button;  type $$$2$$$: a reviewer has watched the movie, and they dislike it — they press the downvote button;  type $$$3$$$: a reviewer hasn't watched the movie — they look at the current number of upvotes and downvotes of the movie on the server they are in and decide what button to press. If there are more downvotes than upvotes, then a reviewer downvotes the movie. Otherwise, they upvote the movie. Each reviewer votes on the movie exactly once.Since you have two servers, you can actually manipulate the votes so that your movie gets as many upvotes as possible. When a reviewer enters a site, you know their type, and you can send them either to the first server or to the second one.What is the maximum total number of upvotes you can gather over both servers if you decide which server to send each reviewer to?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The first line of each testcase contains a single integer $$$n$$$ ($$$1 \le n \le 50$$$) — the number of reviewers. The second line of each testcase contains $$$n$$$ integers $$$r_1, r_2, \dots, r_n$$$ ($$$1 \le r_i \le 3$$$) — the types of the reviewers in the same order they enter the site.

For each testcase print a single integer — the maximum total number of upvotes you can gather over both servers if you decide which server to send each reviewer to.

NoteIn the first testcase of the example you can send the only reviewer to either of the servers — they'll downvote anyway. The movie won't receive any upvotes.In the second testcase of the example you can send all reviewers to the first server:   the first reviewer upvotes;  the second reviewer downvotes;  the last reviewer sees that the number of downvotes is not greater than the number of upvotes — upvote themselves. There are two upvotes in total. Alternatevely, you can send the first and the second reviewers to the first server and the last reviewer — to the second server:   the first reviewer upvotes on the first server;  the second reviewer downvotes on the first server;  the last reviewer sees no upvotes or downvotes on the second server — upvote themselves.

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

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

import qualified Data.Array as A

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

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

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

type Output = Integer

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

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

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

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

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

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

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

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

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

import Control.Monad

readInt :: IO Integer
readInt = readLn

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

readInts :: IO [Integer]
readInts = readArray

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

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

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

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

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

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


$$$n$$$ robots have escaped from your laboratory! You have to find them as soon as possible, because these robots are experimental, and their behavior is not tested yet, so they may be really dangerous!Fortunately, even though your robots have escaped, you still have some control over them. First of all, you know the location of each robot: the world you live in can be modeled as an infinite coordinate plane, and the $$$i$$$-th robot is currently located at the point having coordinates ($$$x_i$$$, $$$y_i$$$). Furthermore, you may send exactly one command to all of the robots. The command should contain two integer numbers $$$X$$$ and $$$Y$$$, and when each robot receives this command, it starts moving towards the point having coordinates ($$$X$$$, $$$Y$$$). The robot stops its movement in two cases:  either it reaches ($$$X$$$, $$$Y$$$);  or it cannot get any closer to ($$$X$$$, $$$Y$$$). Normally, all robots should be able to get from any point of the coordinate plane to any other point. Each robot usually can perform four actions to move. Let's denote the current coordinates of the robot as ($$$x_c$$$, $$$y_c$$$). Then the movement system allows it to move to any of the four adjacent points:  the first action allows it to move from ($$$x_c$$$, $$$y_c$$$) to ($$$x_c - 1$$$, $$$y_c$$$);  the second action allows it to move from ($$$x_c$$$, $$$y_c$$$) to ($$$x_c$$$, $$$y_c + 1$$$);  the third action allows it to move from ($$$x_c$$$, $$$y_c$$$) to ($$$x_c + 1$$$, $$$y_c$$$);  the fourth action allows it to move from ($$$x_c$$$, $$$y_c$$$) to ($$$x_c$$$, $$$y_c - 1$$$). Unfortunately, it seems that some movement systems of some robots are malfunctioning. For each robot you know which actions it can perform, and which it cannot perform.You want to send a command so all robots gather at the same point. To do so, you have to choose a pair of integer numbers $$$X$$$ and $$$Y$$$ so that each robot can reach the point ($$$X$$$, $$$Y$$$). Is it possible to find such a point?

The first line contains one integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. Then $$$q$$$ queries follow. Each query begins with one line containing one integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of robots in the query. Then $$$n$$$ lines follow, the $$$i$$$-th of these lines describes the $$$i$$$-th robot in the current query: it contains six integer numbers $$$x_i$$$, $$$y_i$$$, $$$f_{i, 1}$$$, $$$f_{i, 2}$$$, $$$f_{i, 3}$$$ and $$$f_{i, 4}$$$ ($$$-10^5 \le x_i, y_i \le 10^5$$$, $$$0 \le f_{i, j} \le 1$$$). The first two numbers describe the initial location of the $$$i$$$-th robot, and the following four numbers describe which actions the $$$i$$$-th robot can use to move ($$$f_{i, j} = 1$$$ if the $$$i$$$-th robot can use the $$$j$$$-th action, and $$$f_{i, j} = 0$$$ if it cannot use the $$$j$$$-th action). It is guaranteed that the total number of robots over all queries does not exceed $$$10^5$$$.

You should answer each query independently, in the order these queries appear in the input. To answer a query, you should do one of the following:   if it is impossible to find a point that is reachable by all $$$n$$$ robots, print one number $$$0$$$ on a separate line;  if it is possible to find a point that is reachable by all $$$n$$$ robots, print three space-separated integers on the same line: $$$1$$$ $$$X$$$ $$$Y$$$, where $$$X$$$ and $$$Y$$$ are the coordinates of the point reachable by all $$$n$$$ robots. Both $$$X$$$ and $$$Y$$$ should not exceed $$$10^5$$$ by absolute value; it is guaranteed that if there exists at least one point reachable by all robots, then at least one of such points has both coordinates not exceeding $$$10^5$$$ by absolute value.

import Control.Monad
import Control.Arrow
main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    rs <- replicateM n (map read . words <$> getLine)
    let (x,y) = (fmap point . foldM inter line ***
                 fmap point . foldM inter line) $ unzip $ map area rs
    case liftM2 (,) x y of
      Nothing -> putStrLn "0"
      Just (i,j) -> putStrLn $ unwords $ map show [1,i,j]
line = (-10^5,10^5)
inter (a,b) (c,d) = guard (e <= f) *> pure (e,f)
  where e = max a c
        f = min b d
area [x,y,l,u,r,d] = ((left,right),(down,up)) where
  left  = if l > 0 then -10^5 else x
  right = if r > 0 then  10^5 else x
  down  = if d > 0 then -10^5 else y
  up    = if u > 0 then  10^5 else y
point (low,high) = low

import Control.Monad
import Control.Arrow
main = do
  q <- readLn
  replicateM_ q $ do
    n <- readLn
    rs <- replicateM n (map read . words <$> getLine)
    let (x,y) = (fmap point . foldM inter line ***
                 fmap point . foldM inter line) $ unzip $ map area rs
    case liftM2 (,) x y of
      Nothing -> putStrLn "0"
      Just (i,j) -> putStrLn $ unwords $ map show [1,i,j]
line = (-10^5,10^5)
inter (a,b) (c,d) = guard (f-e >= 0) *> pure (e,f)
  where e = max a c
        f = min b d
area [x,y,l,d,r,u] = ((left,right),(down,up)) where
  left = if l > 0 then -10^5 else x
  right = if r > 0 then 10^5 else x
  down = if d > 0 then -10^5 else y
  up = if u > 0 then 10^5 else y
point (low,high) = low


You are given array a with n elements and the number m. Consider some subsequence of a and the value of least common multiple (LCM) of its elements. Denote LCM as l. Find any longest subsequence of a with the value l ≤ m.A subsequence of a is an array we can get by erasing some elements of a. It is allowed to erase zero or all elements.The LCM of an empty array equals 1.

The first line contains two integers n and m (1 ≤ n, m ≤ 106) — the size of the array a and the parameter from the problem statement. The second line contains n integers ai (1 ≤ ai ≤ 109) — the elements of a.

In the first line print two integers l and kmax (1 ≤ l ≤ m, 0 ≤ kmax ≤ n) — the value of LCM and the number of elements in optimal subsequence. In the second line print kmax integers — the positions of the elements from the optimal subsequence in the ascending order. Note that you can find and print any subsequence with the maximum length.

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents, unpack)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Array.IArray (assocs, accumArray)
import Data.Array.Unboxed (UArray)
import Data.Tuple (swap)
import Data.List (maximumBy)
import Data.Ord (comparing)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, m] <- readInts
  as <- readInts :: IO [Int]

  let
    cs = filter (\(x, c) -> c > 0) $ assocs $ (accumArray (+) 0 (1, m) $ zip (filter (<= m) as) [1, 1..] :: UArray Int Int)

    divCounts = accumArray (+) 0 (1, m) $ concat $ map (\(x, c) -> map (flip (,) c) $ divs x) cs :: UArray Int Int
      where divs x = [x, x+x..m]

    (d, c) = maximumBy (comparing (\(d, c) -> (c, -d))) $ assocs divCounts

  putStrLn $ show d ++ " " ++ show c
  putStrLn $ unwords $ map show $ map snd $ filter (\(a, i) -> d `mod` a == 0) $ zip as [1..]

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents, unpack)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Data.Array (assocs, accumArray)
import Data.Tuple (swap)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n, m] <- readInts
  as <- readInts :: IO [Int]

  let
    cs = filter (\(x, c) -> c > 0) $ assocs $ accumArray (+) 0 (1, m) $ zip (filter (<= m) as) [1, 1..]

    divCounts = accumArray (+) 0 (1, m) $ concat $ map (\(x, c) -> map (flip (,) c) $ divs x) cs
      where divs x = [x, x+x..m]

    (k, d) = maximum $ map swap $ assocs divCounts

  putStrLn $ show d ++ " " ++ show k
  putStrLn $ unwords $ map show $ map snd $ filter (\(a, i) -> d `mod` a == 0) $ zip as [1..]


In this problem you have to implement an algorithm to defragment your hard disk. The hard disk consists of a sequence of clusters, numbered by integers from 1 to n. The disk has m recorded files, the i-th file occupies clusters with numbers ai, 1, ai, 2, ..., ai, ni. These clusters are not necessarily located consecutively on the disk, but the order in which they are given corresponds to their sequence in the file (cluster ai, 1 contains the first fragment of the i-th file, cluster ai, 2 has the second fragment, etc.). Also the disc must have one or several clusters which are free from files.You are permitted to perform operations of copying the contents of cluster number i to cluster number j (i and j must be different). Moreover, if the cluster number j used to keep some information, it is lost forever. Clusters are not cleaned, but after the defragmentation is complete, some of them are simply declared unusable (although they may possibly still contain some fragments of files).Your task is to use a sequence of copy operations to ensure that each file occupies a contiguous area of memory. Each file should occupy a consecutive cluster section, the files must follow one after another from the beginning of the hard disk. After defragmentation all free (unused) clusters should be at the end of the hard disk. After defragmenting files can be placed in an arbitrary order. Clusters of each file should go consecutively from first to last. See explanatory examples in the notes.Print the sequence of operations leading to the disk defragmentation. Note that you do not have to minimize the number of operations, but it should not exceed 2n.

The first line contains two integers n and m (1 ≤ n, m ≤ 200) — the number of clusters and the number of files, correspondingly. Next m lines contain descriptions of the files. The first number in the line is ni (ni ≥ 1), the number of clusters occupied by the i-th file. Then follow ni numbers ai, 1, ai, 2, ..., ai, ni (1 ≤ ai, j ≤ n). It is guaranteed that each cluster number occurs not more than once and , that is, there exists at least one unused cluster. Numbers on each line are separated by spaces.

In the first line print a single integer k (0 ≤ k ≤ 2n) — the number of operations needed to defragment the disk. Next k lines should contain the operations' descriptions as "i j" (copy the contents of the cluster number i to the cluster number j).

NoteLet's say that a disk consists of 8 clusters and contains two files. The first file occupies two clusters and the second file occupies three clusters. Let's look at examples of correct and incorrect positions of files after defragmentation. Example 2: each file must occupy a contiguous area of memory.Example 3: the order of files to each other is not important, at first the second file can be written, and then — the first one.Example 4: violating the order of file fragments to each other is not allowed.Example 5: unused clusters should be located at the end, and in this example the unused clusters are 3, 7, 8.

import Data.Array.IO
import Control.Monad

copy arr inv a b = do
  if a /= b then do v <- readArray arr a
                    writeArray arr b v
                    writeArray inv v b
            else return ()
  writeArray arr a (0,0)

move arr inv q (ms,z,p) = do
  if p == q
    then return (ms,z,p+1)
    else do v <- readArray arr p
            if fst v == 0
              then do copy arr inv q p
                      return ((q,p):ms,q,p+1)
              else do copy arr inv p z
                      copy arr inv q p
                      let ms' = (q,p):(p,z):ms
                      return (ms',q,p+1)

defrag arr inv zp files = foldM go zp files
  where go zp (fid,fsize) = foldM (go' fid) zp [1..fsize]
        go' fid zp i = do q <- readArray inv (fid,i); move arr inv q zp

allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
allM _ []       = return True
allM p (x:xs)   = do
        q <- p x
        if q then allM p xs else return False

solve blks files = do
  let flen = length files
      mlen = maximum $ map length files
  arr <- newArray (1,blks) (0,0)        :: IO (IOArray Int (Int,Int))
  inv <- newArray ((1,1),(flen,mlen)) 0 :: IO (IOArray (Int,Int) Int)
  forM_ (zip [1..] files) $ \(fid,fblocks) -> do
    forM_ (zip [1..] fblocks) $ \(i,b) -> do
      writeArray arr b (fid,i)
      writeArray inv (fid,i) b
  -- find a free spot
  z <- do let loop i | i > blks = error "no free blocks"
              loop i = do v <- readArray arr i
                          if fst v == 0 then return i else loop (i+1)
          loop 1
  let fs = [ (fid, length fblocks) | (fid,fblocks) <- zip [1..] files ]
  (ms,_,_) <- defrag arr inv ([],z,1) fs
  let defragged  = [ (fid,i) | (fid,fblocks) <- fs, i <- [1..fblocks] ]
      used = length defragged

{-
  ok1 <- allM (\(i,p) -> do v <- readArray arr i; return $ v == p) (zip [1..] defragged)
  ok2 <- allM (\j -> do v <- readArray arr j; return $ v == (0,0)) [used+1..blks]
  when (not ok1) $ putStrLn "not ok1"
  when (not ok2) $ putStrLn "not ok2"
  when (True || not ok1 || not ok2) $ do
    putStr "arr: "; forM_ [1..blks]  $ \i -> do {v <- readArray arr i; putStr $ show v ++ " " }; putStrLn ""
-}

  return $ reverse $ filter (\(a,b) -> a /= b) ms

main = do
  (blocks:fcount:_) <- fmap (map read . words) getLine
  files <- replicateM fcount $ do (_:rest) <- fmap (map read . words) getLine; return rest
  ms <- solve blocks files
  print $ length ms
  forM_ ms $ \(a,b) -> putStrLn $ show a ++ " " ++ show b


The map of Bertown can be represented as a set of $$$n$$$ intersections, numbered from $$$1$$$ to $$$n$$$ and connected by $$$m$$$ one-way roads. It is possible to move along the roads from any intersection to any other intersection. The length of some path from one intersection to another is the number of roads that one has to traverse along the path. The shortest path from one intersection $$$v$$$ to another intersection $$$u$$$ is the path that starts in $$$v$$$, ends in $$$u$$$ and has the minimum length among all such paths.Polycarp lives near the intersection $$$s$$$ and works in a building near the intersection $$$t$$$. Every day he gets from $$$s$$$ to $$$t$$$ by car. Today he has chosen the following path to his workplace: $$$p_1$$$, $$$p_2$$$, ..., $$$p_k$$$, where $$$p_1 = s$$$, $$$p_k = t$$$, and all other elements of this sequence are the intermediate intersections, listed in the order Polycarp arrived at them. Polycarp never arrived at the same intersection twice, so all elements of this sequence are pairwise distinct. Note that you know Polycarp's path beforehand (it is fixed), and it is not necessarily one of the shortest paths from $$$s$$$ to $$$t$$$.Polycarp's car has a complex navigation system installed in it. Let's describe how it works. When Polycarp starts his journey at the intersection $$$s$$$, the system chooses some shortest path from $$$s$$$ to $$$t$$$ and shows it to Polycarp. Let's denote the next intersection in the chosen path as $$$v$$$. If Polycarp chooses to drive along the road from $$$s$$$ to $$$v$$$, then the navigator shows him the same shortest path (obviously, starting from $$$v$$$ as soon as he arrives at this intersection). However, if Polycarp chooses to drive to another intersection $$$w$$$ instead, the navigator rebuilds the path: as soon as Polycarp arrives at $$$w$$$, the navigation system chooses some shortest path from $$$w$$$ to $$$t$$$ and shows it to Polycarp. The same process continues until Polycarp arrives at $$$t$$$: if Polycarp moves along the road recommended by the system, it maintains the shortest path it has already built; but if Polycarp chooses some other path, the system rebuilds the path by the same rules.Here is an example. Suppose the map of Bertown looks as follows, and Polycarp drives along the path $$$[1, 2, 3, 4]$$$ ($$$s = 1$$$, $$$t = 4$$$): Check the picture by the link http://tk.codeforces.com/a.png   When Polycarp starts at $$$1$$$, the system chooses some shortest path from $$$1$$$ to $$$4$$$. There is only one such path, it is $$$[1, 5, 4]$$$;  Polycarp chooses to drive to $$$2$$$, which is not along the path chosen by the system. When Polycarp arrives at $$$2$$$, the navigator rebuilds the path by choosing some shortest path from $$$2$$$ to $$$4$$$, for example, $$$[2, 6, 4]$$$ (note that it could choose $$$[2, 3, 4]$$$);  Polycarp chooses to drive to $$$3$$$, which is not along the path chosen by the system. When Polycarp arrives at $$$3$$$, the navigator rebuilds the path by choosing the only shortest path from $$$3$$$ to $$$4$$$, which is $$$[3, 4]$$$;  Polycarp arrives at $$$4$$$ along the road chosen by the navigator, so the system does not have to rebuild anything. Overall, we get $$$2$$$ rebuilds in this scenario. Note that if the system chose $$$[2, 3, 4]$$$ instead of $$$[2, 6, 4]$$$ during the second step, there would be only $$$1$$$ rebuild (since Polycarp goes along the path, so the system maintains the path $$$[3, 4]$$$ during the third step).The example shows us that the number of rebuilds can differ even if the map of Bertown and the path chosen by Polycarp stays the same. Given this information (the map and Polycarp's path), can you determine the minimum and the maximum number of rebuilds that could have happened during the journey?

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le m \le 2 \cdot 10^5$$$) — the number of intersections and one-way roads in Bertown, respectively. Then $$$m$$$ lines follow, each describing a road. Each line contains two integers $$$u$$$ and $$$v$$$ ($$$1 \le u, v \le n$$$, $$$u \ne v$$$) denoting a road from intersection $$$u$$$ to intersection $$$v$$$. All roads in Bertown are pairwise distinct, which means that each ordered pair $$$(u, v)$$$ appears at most once in these $$$m$$$ lines (but if there is a road $$$(u, v)$$$, the road $$$(v, u)$$$ can also appear). The following line contains one integer $$$k$$$ ($$$2 \le k \le n$$$) — the number of intersections in Polycarp's path from home to his workplace. The last line contains $$$k$$$ integers $$$p_1$$$, $$$p_2$$$, ..., $$$p_k$$$ ($$$1 \le p_i \le n$$$, all these integers are pairwise distinct) — the intersections along Polycarp's path in the order he arrived at them. $$$p_1$$$ is the intersection where Polycarp lives ($$$s = p_1$$$), and $$$p_k$$$ is the intersection where Polycarp's workplace is situated ($$$t = p_k$$$). It is guaranteed that for every $$$i \in [1, k - 1]$$$ the road from $$$p_i$$$ to $$$p_{i + 1}$$$ exists, so the path goes along the roads of Bertown.

Print two integers: the minimum and the maximum number of rebuilds that could have happened during the journey.

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

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

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

data HInt
data HInt64
data HNormal
data HString
data HList

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data HInt
data HInt64
data HNormal
data HString
data HList

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


It's holiday. Mashmokh and his boss, Bimokh, are playing a game invented by Mashmokh. In this game Mashmokh writes sequence of n distinct integers on the board. Then Bimokh makes several (possibly zero) moves. On the first move he removes the first and the second integer from from the board, on the second move he removes the first and the second integer of the remaining sequence from the board, and so on. Bimokh stops when the board contains less than two numbers. When Bimokh removes numbers x and y from the board, he gets gcd(x, y) points. At the beginning of the game Bimokh has zero points.Mashmokh wants to win in the game. For this reason he wants his boss to get exactly k points in total. But the guy doesn't know how choose the initial sequence in the right way. Please, help him. Find n distinct integers a1, a2, ..., an such that his boss will score exactly k points. Also Mashmokh can't memorize too huge numbers. Therefore each of these integers must be at most 109.

The first line of input contains two space-separated integers n, k (1 ≤ n ≤ 105; 0 ≤ k ≤ 108).

If such sequence doesn't exist output -1 otherwise output n distinct space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109).

Notegcd(x, y) is greatest common divisor of x and y.

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

solve[1,0]=[1]
solve[1,_]=[-1]
solve[n,k]
  | k < n`div`2 = [-1]
  | k - q > 0 = (k-q):2*(k-q):take(n-2)[2*(k-q)+1..]
  | otherwise = [-1]
   where
     q = (n-2)`div`2

solve :: [Int] -> [Int]
solve [1, 0] = [ 1]
solve [1, _] = [-1]
solve [n, k] = case compare q k of
    LT -> a : a' : take (n - 2) (iterate f 1)
    EQ -> [1..n]
    GT -> [-1]
    where q = n `div` 2
          a = k - q + 1
          a' = 2 * a
          f x = let x' = x + 1 in x' + fromEnum (elem x' [a, a'])
main = interact $ unwords . map show . solve . map read . words

solve :: Int -> Int -> [Int]
solve 1 0 = [ 1]
solve 1 _ = [-1]
solve n k = case compare q k of
    LT -> a : a' : take (n - 2) (iterate f 1)
    EQ -> [1..n]
    GT -> [-1]
    where q = n `div` 2
          a = k - q + 1
          a' = 2 * a
          f x = let x' = x + 1 in x' + fromEnum (elem x' [a, a'])
main = putStrLn . unwords . map show . (\[x, y] -> solve (read x) (read y)) . words =<< getLine

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

solve :: [Int] -> Maybe [Int]
solve [n, k] | (div n 2) > k   = Nothing
             | n == 1 && k > 0 = Nothing
             | n == 1          = Just [1]
             | otherwise       = let a = div n 2
                                     b = k - (a - 1)
                                 in  Just (b:(b*2):(solve' (b*2 + 1) (n - 2)))

solve' :: Int -> Int -> [Int]
solve' _ 0 = []
solve' i n = i : (solve' (i + 1) (n - 1))

output :: Maybe [Int] -> IO()
output Nothing       = putStrLn "-1"
output (Just [])     = putStrLn ""
output (Just (a:ax)) = do putStr ((show a) ++ " ")
                          output (Just ax)

{-# 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 qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, k] <- getInts

  let
    n' = 2*(n `div` 2)

    a =  k - (n`div`2 - 1)
    b = 2*a

    s = [a, b] ++ s'
    s' = take (n-2) $ concat $ filter (\[x, y] -> x /= a && y /= a && y /= b) $ [[a,a+1] | a <- [1,3..]]

  if n == 1
    then print (if k == 0 then 1 else -1)
    else
      if k < n `div` 2
        then print $ -1
        else
          putStrLn $ unwords $ map show $
            if k == n `div` 2
              then take n [1..]
              else s

import Data.List (intercalate,nub)
import Data.Ord

solve :: Int -> Int -> [Int]
solve 1 0 = [1]
solve 1 _ = []
solve n k | n `div` 2 > k = []
solve n k =
  let parts = n `div` 2
      m = k - (parts-1)
      r = if odd n then 1 else 0
      fit m c o | c+o < m   = [1..c+o]
                | c < m     = [1..c] ++ [m+1..m+o]
                | otherwise = [2*m+1..2*m+c+o]
  in [m,2*m] ++ (fit m (2*(parts-1)) r)

score (a:b:rest) = gcd a b + score rest
score _ = 0

check :: Int -> Int -> [Int] -> Bool
check n k xs = length xs == n && score xs == k && length (nub xs) == n

main = do
  (n:k:_) <- (map read . words) `fmap` getLine
  case solve n k of
    [] -> putStrLn "-1"
    xs -> putStrLn $ intercalate " " (map show xs)

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k == 0 && n == 1 = [1]
            | k < n' || n == 1 = [-1]
            | otherwise = take n $ [k-n''] ++ [2*(k-n''),2*(k-n'')+1..]
  where n' = n `div` 2
        n'' = (n-2) `div` 2

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

inf :: Int
inf = 10^9
solve[1,_]=[-1]
solve[n,k]
  | k - q > 0 = (k-q):2*(k-q):take(n-2)[inf,inf-1..]
  | otherwise = [-1]
   where
     q = (n-2)`div`2

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

solve[1,_]=[-1]
solve[n,k]
  | k < n`div`2 = [-1]
  | k - q > 0 = (k-q):2*(k-q):take(n-2)[2*(k-q)+1..]
  | otherwise = [-1]
   where
     q = (n-2)`div`2

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

inf :: Int
inf = 10^9

solve[n,k]
  | n`div`2 > k = [-1]
  | otherwise = (k-q):2*(k-q):take(n-2)[inf,inf-1..]
   where
     q = (n-2)`div`2

{-# 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 qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  [n, k] <- getInts

  let
    n' = 2*(n `div` 2)

    a =  k - (n`div`2 - 1)
    b = 2*a

    s = [a, b] ++ s'
    s' = take (n-2) $ concat $ filter (\[x, y] -> x /= a && y /= a && y /= b) $ [[a,a+1] | a <- [1,3..]]

  if k < n `div` 2
    then print $ -1
    else
      putStrLn $ unwords $ map show $
        if k == n `div` 2
          then take n [1..]
          else s

import Data.List (intercalate,nub)
import Data.Ord

solve :: Int -> Int -> [Int]
solve n k | n `div` 2 > k = []
solve n k =
  let parts = n `div` 2
      m = k - (parts-1)
      r = if odd n then 1 else 0
      fit m c o | c+o < m   = [1..c+o]
                | c < m     = [1..c] ++ [m+1..m+o]
                | otherwise = [2*m+1..2*m+c+o]
  in [m,2*m] ++ (fit m (2*(parts-1)) r)

score (a:b:rest) = gcd a b + score rest
score _ = 0

check :: Int -> Int -> [Int] -> Bool
check n k xs = length xs == n && score xs == k && length (nub xs) == n

main = do
  (n:k:_) <- (map read . words) `fmap` getLine
  case solve n k of
    [] -> putStrLn "-1"
    xs -> do putStrLn $ intercalate " " (map show xs)
             putStrLn $ show $ check n k xs

import Data.List (intercalate,nub)
import Data.Ord

solve :: Int -> Int -> [Int]
solve 1 _ = []
solve n k | n `div` 2 > k = []
solve n k =
  let parts = n `div` 2
      m = k - (parts-1)
      r = if odd n then 1 else 0
      fit m c o | c+o < m   = [1..c+o]
                | c < m     = [1..c] ++ [m+1..m+o]
                | otherwise = [2*m+1..2*m+c+o]
  in [m,2*m] ++ (fit m (2*(parts-1)) r)

score (a:b:rest) = gcd a b + score rest
score _ = 0

check :: Int -> Int -> [Int] -> Bool
check n k xs = length xs == n && score xs == k && length (nub xs) == n

main = do
  (n:k:_) <- (map read . words) `fmap` getLine
  case solve n k of
    [] -> putStrLn "-1"
    xs -> putStrLn $ intercalate " " (map show xs)

import Data.List (intercalate,nub)
import Data.Ord

solve :: Int -> Int -> [Int]
solve n k | n `div` 2 > k = []
solve n k =
  let parts = n `div` 2
      m = k - (parts-1)
      r = if odd n then 1 else 0
      fit m c o | c+o < m   = [1..c+o]
                | c < m     = [1..c] ++ [m+1..m+o]
                | otherwise = [2*m+1..2*m+c+o]
  in [m,2*m] ++ (fit m (2*(parts-1)) r)

score (a:b:rest) = gcd a b + score rest
score _ = 0

check :: Int -> Int -> [Int] -> Bool
check n k xs = length xs == n && score xs == k && length (nub xs) == n

main = do
  (n:k:_) <- (map read . words) `fmap` getLine
  case solve n k of
    [] -> putStrLn "-1"
    xs -> putStrLn $ intercalate " " (map show xs)

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k < n' = [-1]
            | k `mod` n' == 0 = concatMap pair (replicate n' (k `div` n')) ++ c
            | otherwise = concatMap pair ((k `div` n' + k `mod` n') : replicate (n'-1) (k `div` n')) ++ c
  where n' = n `div` 2
        c | odd n = [1] | even n = []
pair x = [x,x]

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k == 0 = [1]
            | k < n' || n == 1 = [-1]
            | otherwise = take n $ [k-n''] ++ [2*(k-n''),2*(k-n'')+1..]
  where n' = n `div` 2
        n'' = (n-2) `div` 2

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k == 0 = [1..n]
            | k < n' || n == 1 = [-1]
            | otherwise = take n $ [k-n''] ++ [2*(k-n''),2*(k-n'')+1..]
  where n' = n `div` 2
        n'' = (n-2) `div` 2

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k < n' = [-1]
            | otherwise = take n $ [k-n''] ++ [2*(k-n''),2*(k-n'')+1..]
  where n' = n `div` 2
        n'' = (n-2) `div` 2

main = interact $ unwords . map show . solve . map read . words
solve [n,k] | k < n' || n == 1 = [-1]
            | otherwise = take n $ [k-n''] ++ [2*(k-n''),2*(k-n'')+1..]
  where n' = n `div` 2
        n'' = (n-2) `div` 2


Suppose there is a $$$h \times w$$$ grid consisting of empty or full cells. Let's make some definitions:  $$$r_{i}$$$ is the number of consecutive full cells connected to the left side in the $$$i$$$-th row ($$$1 \le i \le h$$$). In particular, $$$r_i=0$$$ if the leftmost cell of the $$$i$$$-th row is empty.  $$$c_{j}$$$ is the number of consecutive full cells connected to the top end in the $$$j$$$-th column ($$$1 \le j \le w$$$). In particular, $$$c_j=0$$$ if the topmost cell of the $$$j$$$-th column is empty. In other words, the $$$i$$$-th row starts exactly with $$$r_i$$$ full cells. Similarly, the $$$j$$$-th column starts exactly with $$$c_j$$$ full cells.    These are the $$$r$$$ and $$$c$$$ values of some $$$3 \times 4$$$ grid. Black cells are full and white cells are empty. You have values of $$$r$$$ and $$$c$$$. Initially, all cells are empty. Find the number of ways to fill grid cells to satisfy values of $$$r$$$ and $$$c$$$. Since the answer can be very large, find the answer modulo $$$1000000007\,(10^{9} + 7)$$$. In other words, find the remainder after division of the answer by $$$1000000007\,(10^{9} + 7)$$$.

The first line contains two integers $$$h$$$ and $$$w$$$ ($$$1 \le h, w \le 10^{3}$$$) — the height and width of the grid. The second line contains $$$h$$$ integers $$$r_{1}, r_{2}, \ldots, r_{h}$$$ ($$$0 \le r_{i} \le w$$$) — the values of $$$r$$$. The third line contains $$$w$$$ integers $$$c_{1}, c_{2}, \ldots, c_{w}$$$ ($$$0 \le c_{j} \le h$$$) — the values of $$$c$$$.

NoteIn the first example, this is the other possible case.  In the second example, it's impossible to make a grid to satisfy such $$$r$$$, $$$c$$$ values.In the third example, make sure to print answer modulo $$$(10^9 + 7)$$$.

import Data.Foldable
import Data.Int

main :: IO ()
main = do
    [h, w] <- map read . words <$> getLine :: IO [Int64]
    r      <- map read . words <$> getLine :: IO [Int64]
    c      <- map read . words <$> getLine :: IO [Int64]
    let t = do
        (i, r') <- zip [0..h - 1] r
        (j, c') <- zip [0..w - 1] c
        let a | j < r'      = 1 :: Int
              | j == r'     = 2
              | otherwise   = 0
        let b | i < c'      = 1
              | i == c'     = 2
              | otherwise   = 0
        let result | a /= 0 && b /= 0 && a /= b = 0
                   | a /= 0 || b /= 0           = 1
                   | otherwise                  = 2
        pure result
    print $ foldl' (\a b -> (a * b) `mod` 1000000007 :: Int64) 1 t


A team quiz game called "What? Where? When?" is very popular in Berland. The game is centered on two teams competing. They are the team of six Experts versus the team of the Audience. A person from the audience asks a question and the experts are allowed a minute on brainstorming and finding the right answer to the question. All it takes to answer a typical question is general knowledge and common logic. The question sent be the audience are in envelops lain out in a circle on a round table. Each envelop is marked by the name of the asker's town. Each question is positioned in a separate sector. In the centre of the table is a spinning arrow. Thus, the table rather resembles a roulette table with no ball but with a spinning arrow instead. The host sets off the spinning arrow to choose a question for the experts: when the arrow stops spinning, the question it is pointing at is chosen. If the arrow points at the question that has already been asked, the host chooses the next unanswered question in the clockwise direction. Your task is to determine which will be the number of the next asked question if the arrow points at sector number k.

The first line contains two positive integers n and k (1 ≤ n ≤ 1000 and 1 ≤ k ≤ n) — the numbers of sectors on the table and the number of the sector where the arrow is pointing. The second line contains n numbers: ai = 0 if the question from sector i has already been asked and ai = 1 if the question from sector i hasn't been asked yet (1 ≤ i ≤ n). The sectors are given in the clockwise order, the first sector follows after the n-th one.

Print the single number — the number of the sector containing the question the experts will be asked. It is guaranteed that the answer exists, that is that not all the questions have already been asked.

solve (1:_) = 0
solve (_:xs) = solve xs + 1

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, k] = map read . words . head $ input
	let k' = k - 1
	let as = map read . words $ input !! 1
	writeFile "output.txt" . (++"\n") . show . (+1) . (`mod`n) . (+k') . solve $ drop k' as ++ take k' as

solve [[n,k],xs] = show.fst.head.dropWhile ((==0).snd). drop (k-1).cycle.zip [1..n] $ xs
main = readFile "input.txt" >>= writeFile "output.txt".solve.map(map read.words).lines

#! /usr/bin/runhaskell
import Data.List
import Data.Maybe
main = do
  file <- readFile "input.txt"
  writeFile "output.txt" (show $ (f file))

f file =
  if i <= n
     then i
     else i `mod` n
    where str = map read (words file) :: [Int]
	  n = str !! 0
	  k = (str !! 1) - 1
          lstr = tail (tail str)
	  list = lstr ++ lstr
	  i = (fromJust $ find (\x -> x >= k) (elemIndices 1 list)) + 1

import IO

solve :: Int -> [Int] -> Int
solve k xs  =  solve' (k-1) xs
  where
    n  =  length xs
    solve' k xs
      | xs !! k == 1  =  k + 1
      | otherwise  =  solve' (mod (k + 1) n) xs

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, k]  <-  hGetLine hInput >>= return . map read . words
    xs  <-  hGetLine hInput >>= return . map read . words
    hPutStrLn hOutput (show $ solve k xs)

    hClose hOutput
    hClose hInput

solve [[n, k], xs] =
    show $ fst $ head $ dropWhile ((==0).snd) $ dropWhile ((/=k).fst) $ cycle $ zip [1..n] xs

main = do text <- readFile "input.txt"
          writeFile "output.txt" (solve $ map (map read.words) $ lines text)

import System.IO
solve k a = let ai = zip a [1..]
                (f,l) = splitAt (k-1) ai
                ai' = l++f
            in
              snd.head.dropWhile ((==0).fst) $ ai'

main = do fin <- openFile "input.txt" ReadMode
          l <- hGetLine fin
          a <- hGetLine fin
          hClose fin
          fout <- openFile "output.txt" WriteMode
          hPutStrLn fout.show $ solve (read (head.tail.words $ l)::Int) (map (read :: String -> Int) (words a))
          hClose fout

solve (1:_) = 0
solve (_:xs) = solve xs + 1

main = do
	input <- fmap lines $ readFile "input.txt"
	let [n, k] = map read . words . head $ input
	let as = map read . words $ input !! 1
	writeFile "output.txt" . (++"\n") . show . (`mod`n) . (+n) . solve $ drop (n-1) as ++ take (n-1) as