Polycarpus is a system administrator. There are two servers under his strict guidance — a and b. To stay informed about the servers' performance, Polycarpus executes commands "ping a" and "ping b". Each ping command sends exactly ten packets to the server specified in the argument of the command. Executing a program results in two integers x and y (x + y = 10; x, y ≥ 0). These numbers mean that x packets successfully reached the corresponding server through the network and y packets were lost.Today Polycarpus has performed overall n ping commands during his workday. Now for each server Polycarpus wants to know whether the server is "alive" or not. Polycarpus thinks that the server is "alive", if at least half of the packets that we send to this server reached it successfully along the network.Help Polycarpus, determine for each server, whether it is "alive" or not by the given commands and their results.

The first line contains a single integer n (2 ≤ n ≤ 1000) — the number of commands Polycarpus has fulfilled. Each of the following n lines contains three integers — the description of the commands. The i-th of these lines contains three space-separated integers ti, xi, yi (1 ≤ ti ≤ 2; xi, yi ≥ 0; xi + yi = 10). If ti = 1, then the i-th command is "ping a", otherwise the i-th command is "ping b". Numbers xi, yi represent the result of executing this command, that is, xi packets reached the corresponding server successfully and yi packets were lost. It is guaranteed that the input has at least one "ping a" command and at least one "ping b" command.

In the first line print string "LIVE" (without the quotes) if server a is "alive", otherwise print "DEAD" (without the quotes). In the second line print the state of server b in the similar format.

NoteConsider the first test case. There 10 packets were sent to server a, 5 of them reached it. Therefore, at least half of all packets sent to this server successfully reached it through the network. Overall there were 10 packets sent to server b, 6 of them reached it. Therefore, at least half of all packets sent to this server successfully reached it through the network.Consider the second test case. There were overall 20 packages sent to server a, 10 of them reached it. Therefore, at least half of all packets sent to this server successfully reached it through the network. Overall 10 packets were sent to server b, 0 of them reached it. Therefore, less than half of all packets sent to this server successfully reached it through the network.

import Control.Monad (replicateM)
import Data.List (transpose)

gao a = if n >= d then "LIVE" else "DEAD"
  where
    (n:d:_) = map sum $ transpose $ map (map read . tail) a

main = do
  n <- fmap read getLine
  a <- replicateM n $ fmap words getLine
  putStrLn $ gao $ filter ((=="1") . head) a
  putStrLn $ gao $ filter ((=="2") . head) a

import Control.Monad (liftM)

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: [(Int, Int, Int)] -> (Bool, Bool)
solve qs  =  (a, b)
  where
    a  =  live 1
    b  =  live 2
    live t  =  sum (map (\(_, a, _) -> a) qs') >= sum (map (\(_, _, b) -> b) qs')
      where
        qs'  =  filter (\(n, _, _) -> n == t) qs

parseQ :: String -> (Int, Int, Int)
parseQ line  =  case map read (words line) of
    [n, a, b]  ->  (n, a, b)

main :: IO ()
main  =  do
    n   <-  readLn
    qs  <-  mapM (\i -> liftM parseQ getLine) [1..n]
    let (a, b)  =  solve qs
    putStrLn $ "LIVE" <?> "DEAD" $ a
    putStrLn $ "LIVE" <?> "DEAD" $ b

main=interact$f 0 0 0 0.map read.tail.words
f a b totala totalb (1:x:_:rest) = f (a+x) b (totala+10) totalb rest
f a b totala totalb (_:x:_:rest) = f a (b+x) totala (totalb+10) rest
f a b totala totalb [] = g a totala ++g b totalb
g x totalx|x+x>=totalx ="LIVE\n"|0<1="DEAD\n"

import Data.List
import Control.Monad

main :: IO()
main = do
         num <- fmap read getLine
         input <- forM [1..num] (\x -> fmap (map read. words) getLine)
         let a = sum [ y | [x,y,z] <- input , x == 1]
         let b = sum [ y | [x,y,z] <- input, x == 2]
         let c = length [ y | [x,y,z] <-input, x == 1]
         let d = length [ y | [x,y,z] <- input, x == 2]

         if a >= (c*5)  then putStrLn "LIVE" else putStrLn "DEAD"
         if b >= (d*5)  then putStrLn "LIVE" else putStrLn "DEAD"

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

process1 a b c d [] = x1 ++ x2
	where 	x1 =  if a>=b  then ["LIVE"] else ["DEAD"]
		x2 =  if c>=d  then ["LIVE"] else ["DEAD"]

process1 a b c d ([x,y,z]:zs) | x==1 = process1 (a+y) (b+z) c d zs
                              | otherwise = process1 a b (c+y) (d+z) zs

main = do
		c<-read <$> getLine ::IO Int
		x<-map (map read. words) <$> replicateM c getLine ::IO [[Int]]
		mapM_ putStrLn $ process1 0 0 0 0 x

isAlive :: Int -> [[Int]] -> Bool
isAlive t txys = sx >= sy
    where
        (sx,sy) = foldr f (0,0) txys
        f [t',x',y'] p@(sx',sy')
            | t' == t = ((x'+sx'),(y'+sy'))
            | otherwise = p

isAliveAll :: Int -> [[Int]] -> [Bool]
isAliveAll n txys = map (\t -> isAlive t txys) [1..n]

readInt :: String -> Int
readInt = read

showBool :: Bool -> String
showBool False = "DEAD"
showBool True = "LIVE"

main = do
    n <- fmap readInt getLine
    s <- fmap (map (map readInt.words).lines) getContents
    putStrLn.unlines.map showBool $ isAliveAll 2 s

main=interact$f False False . map read.tail.words
f a b (1:x:_:rest)
  | x>=5 = f True b rest
  | otherwise = f a b rest
f a b (_:x:_:rest)
  | x>=5 = f a True rest
  | otherwise = f a b rest
f a b [] = g a++g b
g True = "LIVE\n"
g _ = "DEAD\n"


Ivan decided to prepare for the test on solving integer equations. He noticed that all tasks in the test have the following form:  You are given two positive integers $$$u$$$ and $$$v$$$, find any pair of integers (not necessarily positive) $$$x$$$, $$$y$$$, such that: $$$$$$\frac{x}{u} + \frac{y}{v} = \frac{x + y}{u + v}.$$$$$$  The solution $$$x = 0$$$, $$$y = 0$$$ is forbidden, so you should find any solution with $$$(x, y) \neq (0, 0)$$$. Please help Ivan to solve some equations of this form.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases. The next lines contain descriptions of test cases. The only line of each test case contains two integers $$$u$$$ and $$$v$$$ ($$$1 \leq u, v \leq 10^9$$$) — the parameters of the equation.

For each test case print two integers $$$x$$$, $$$y$$$ — a possible solution to the equation. It should be satisfied that $$$-10^{18} \leq x, y \leq 10^{18}$$$ and $$$(x, y) \neq (0, 0)$$$. We can show that an answer always exists. If there are multiple possible solutions you can print any.

import qualified Control.Monad as CM

solve :: IO ()
solve = do
  ~[x,y] <- readv
  printv [x^2, -y^2]

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve

import Control.Arrow ((>>>))

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

solve :: [Integer] -> [Integer]
solve [u, v] = [u^2, -v^2]

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [u, v] = map read $ words input
        (x, y) = findXY (u, v)
        output = unwords $ map show [x, y]

findXY :: (Integer, Integer) -> (Integer, Integer)
findXY (u, v) = (u ^ 2, -v ^ 2)


One day, Vogons wanted to build a new hyperspace highway through a distant system with $$$n$$$ planets. The $$$i$$$-th planet is on the orbit $$$a_i$$$, there could be multiple planets on the same orbit. It's a pity that all the planets are on the way and need to be destructed.Vogons have two machines to do that.  The first machine in one operation can destroy any planet at cost of $$$1$$$ Triganic Pu.  The second machine in one operation can destroy all planets on a single orbit in this system at the cost of $$$c$$$ Triganic Pus. Vogons can use each machine as many times as they want.Vogons are very greedy, so they want to destroy all planets with minimum amount of money spent. Can you help them to know the minimum cost of this project?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then the test cases follow. Each test case consists of two lines. The first line contains two integers $$$n$$$ and $$$c$$$ ($$$1 \le n, c \le 100$$$) — the number of planets and the cost of the second machine usage. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$), where $$$a_i$$$ is the orbit of the $$$i$$$-th planet.

For each test case print a single integer — the minimum cost of destroying all planets.

NoteIn the first test case, the cost of using both machines is the same, so you can always use the second one and destroy all planets in orbit $$$1$$$, all planets in orbit $$$2$$$, all planets in orbit $$$4$$$, all planets in orbit $$$5$$$.In the second test case, it is advantageous to use the second machine for $$$2$$$ Triganic Pus to destroy all the planets in orbit $$$2$$$, then destroy the remaining two planets using the first machine.In the third test case, you can use the first machine twice or the second machine once.In the fourth test case, it is advantageous to use the first machine twice.

import Control.Arrow ((>>>))
import Data.List (group, sort)

(>$>) = flip ($)
infixl 0 >$>

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

solve :: [[Int]] -> Int
solve [[n, c], xs] = xs >$> sort >>> group >>> map (length >>> min c) >>> sum

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

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n,c], as] <- replicateM 2 ri
        return (c,as)
    mapM_ (putStrLn.show.solve) tcs

solve (c,as) = sum . map (min c . length) . L.group . L.sort $ as

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, c] -> map read . words <$> getLine >>= print . minCost n c

minCost :: Int -> Int -> [Int] -> Int
minCost n c as = let am = countF as
                     f acc (_, count) = acc + min count c
                 in
                   foldl f 0 am

-- max input is 100
countF :: [Int] -> [(Int, Int)]
countF as = let a = listArray (1, 100) [0, 0 ..]
                f a e = a//[(e, 1+a!e)]
            in
              assocs $ foldl f a as


Little boy Igor wants to become a traveller. At first, he decided to visit all the cities of his motherland — Uzhlyandia.It is widely known that Uzhlyandia has n cities connected with m bidirectional roads. Also, there are no two roads in the country that connect the same pair of cities, but roads starting and ending in the same city can exist. Igor wants to plan his journey beforehand. Boy thinks a path is good if the path goes over m - 2 roads twice, and over the other 2 exactly once. The good path can start and finish in any city of Uzhlyandia.Now he wants to know how many different good paths are in Uzhlyandia. Two paths are considered different if the sets of roads the paths goes over exactly once differ. Help Igor — calculate the number of good paths.

The first line contains two integers n, m (1 ≤ n, m ≤ 106) — the number of cities and roads in Uzhlyandia, respectively. Each of the next m lines contains two integers u and v (1 ≤ u, v ≤ n) that mean that there is road between cities u and v. It is guaranteed that no road will be given in the input twice. That also means that for every city there is no more than one road that connects the city to itself.

Print out the only integer — the number of good paths in Uzhlyandia.

NoteIn first sample test case the good paths are:   2 → 1 → 3 → 1 → 4 → 1 → 5,  2 → 1 → 3 → 1 → 5 → 1 → 4,  2 → 1 → 4 → 1 → 5 → 1 → 3,  3 → 1 → 2 → 1 → 4 → 1 → 5,  3 → 1 → 2 → 1 → 5 → 1 → 4,  4 → 1 → 2 → 1 → 3 → 1 → 5. There are good paths that are same with displayed above, because the sets of roads they pass over once are same:   2 → 1 → 4 → 1 → 3 → 1 → 5,  2 → 1 → 5 → 1 → 3 → 1 → 4,  2 → 1 → 5 → 1 → 4 → 1 → 3,  3 → 1 → 4 → 1 → 2 → 1 → 5,  3 → 1 → 5 → 1 → 2 → 1 → 4,  4 → 1 → 3 → 1 → 2 → 1 → 5,  and all the paths in the other direction. Thus, the answer is 6.In the second test case, Igor simply can not walk by all the roads.In the third case, Igor walks once over every road.

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Applicative
import           Control.Monad
import           Data.Array.IO.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import           Debug.Trace

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  seen <- newArray (1, n) False :: IO (IOUArray Int Bool)
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        unless (ip == jp) $ do
          si  <- readArray dsSize ip
          sj  <- readArray dsSize jp
          let assign a b = do
                writeArray dsParent a b
                writeArray dsSize b (si + sj)
          if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        writeArray seen i True
        writeArray seen j True
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
      linked i k u | i > n =  return $ k == u
                   | otherwise = do
                     s <- readArray seen i
                     if not s then linked (i + 1) k u else do
                       u' <- if u /= 0 then return u else do
                              p <- parent i
                              readArray dsSize p
                       linked (i + 1) (k + 1) u'
  loops <- go m 0
  lnk <- linked 1 0 0
  if not lnk then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * (toInteger m - 1) - c2 loops

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Applicative
import           Control.Monad
import           Data.Array.IO.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        unless (ip == jp) $ do
          si  <- readArray dsSize ip
          sj  <- readArray dsSize jp
          let assign a b = do
                writeArray dsParent a b
                writeArray dsSize b (si + sj)
          if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
  loops <- go m 0
  p <- max 1 <$> readArray dsParent 1
  sz <- readArray dsSize p
  if sz /= n then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * (toInteger m - 1) - c2 loops

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Applicative
import           Control.Monad
import           Data.Array.IO.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
-- import           Debug.Trace

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        unless (ip == jp) $ do
          si  <- readArray dsSize ip
          sj  <- readArray dsSize jp
          let assign a b = do
                writeArray dsParent a b
                writeArray dsSize b (si + sj)
          if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
      linked i k u | i > n = do
                      return $ k == u
                   | otherwise = do
                     q <- readArray degree i
                     if q == 0 then linked (i + 1) k u else do
                       u' <- if u /= 0 then return u else do
                              p <- parent i
                              u <- readArray dsSize p
                              return u
                       linked (i + 1) (k + 1) u'
  loops <- go m 0
  lnk <- linked 1 0 0
  if not lnk then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * (toInteger m - 1) - c2 loops

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Applicative
import           Control.Monad
import           Data.Array.IO.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        unless (ip == jp) $ do
          si  <- readArray dsSize ip
          sj  <- readArray dsSize jp
          let assign a b = do
                writeArray dsParent a b
                writeArray dsSize b (si + sj)
          if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
      linked i | i > n = return True
               | otherwise = do
                 q <- readArray degree i
                 if q == 0 then linked (i + 1) else do
                   p <- parent i
                   sz <- readArray dsSize p
                   return (sz == n)
  loops <- go m 0
  lnk <- linked 1
  if not lnk then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * (toInteger m - 1) - c2 loops

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Applicative
import           Control.Monad
import           Data.Array.IO.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        unless (ip == jp) $ do
          si  <- readArray dsSize ip
          sj  <- readArray dsSize jp
          let assign a b = do
                writeArray dsParent a b
                writeArray dsSize b (si + sj)
          if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
      linked i | i > n = return True
               | otherwise = do
                 q <- readArray degree i
                 if q == 0 then linked (i + 1) else do
                   p <- parent i
                   sz <- readArray dsSize p
                   return (sz == n)
  loops <- go m 0
  lnk <- linked 1
  if lnk then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * (toInteger m - 1) - c2 loops

{-# LANGUAGE FlexibleContexts #-}
module Main where
import           Control.Monad
import           Data.Array.IO.Safe
import qualified Data.ByteString.Char8 as BS

getInt2::IO (Int,Int)
getInt2 = do
  line <- BS.getLine
  let Just (x, l') = BS.readInt line
      Just (y, _)  = BS.readInt $ BS.drop 1 l'
  return (x,y)

main :: IO ()
main = do
  (n, m) <- getInt2
  let intArray::Int -> IO (IOUArray Int Int)
      intArray = newArray (1, n)
  degree <- intArray 0
  dsParent <- intArray 0
  dsSize <- intArray 1
  let inc i = do
        cnt <- readArray degree i
        writeArray degree i (cnt + 1)
      parent i = do
        p <- readArray dsParent i
        if p == 0 then return i else do
          p1 <- parent p
          unless (p == p1) $ writeArray dsParent i p1
          return p1
      merge i j = do
        ip  <- parent i
        jp  <- parent j
        si  <- readArray dsSize ip
        sj  <- readArray dsSize jp
        let assign a b = do
              writeArray dsParent a b
              writeArray dsSize b (si + sj)
        if si > sj then assign jp ip else assign ip jp
      go 0 loops = return loops
      go x loops = do
        (i, j) <- getInt2
        if i /= j
          then do
            inc i
            inc j
            merge i j
            go (x - 1) loops
          else go (x - 1) (loops + 1)
      c2 x = let xi = toInteger x in xi * (xi - 1) `quot` 2
      cntSqs i acc = if  i > n then return acc else do
        cnt <- readArray degree i
        cntSqs (i + 1) (acc + c2 cnt)
  loops <- go m 0
  p <- readArray dsParent 1
  sz <- readArray dsSize p
  if sz /= n then print 0 else do
    sqs <- cntSqs 1 0
    print $ sqs + loops * toInteger m - c2 loops


Monocarp has forgotten the password to his mobile phone. The password consists of $$$4$$$ digits from $$$0$$$ to $$$9$$$ (note that it can start with the digit $$$0$$$).Monocarp remembers that his password had exactly two different digits, and each of these digits appeared exactly two times in the password. Monocarp also remembers some digits which were definitely not used in the password.You have to calculate the number of different sequences of $$$4$$$ digits that could be the password for Monocarp's mobile phone (i. e. these sequences should meet all constraints on Monocarp's password).

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 200$$$) — the number of testcases. The first line of each testcase contains a single integer $$$n$$$ ($$$1 \le n \le 8$$$) — the number of digits for which Monocarp remembers that they were not used in the password. The second line contains $$$n$$$ different integers $$$a_1, a_2, \dots a_n$$$ ($$$0 \le a_i \le 9$$$) representing the digits that were not used in the password. Note that the digits $$$a_1, a_2, \dots, a_n$$$ are given in ascending order.

For each testcase, print one integer — the number of different $$$4$$$-digit sequences that meet the constraints.

NoteIn the first example, all possible passwords are: "3377", "3737", "3773", "7337", "7373", "7733".

import Data.Char

every2nd (x:y:xs) = x:(every2nd xs)
every2nd _ = []

solve k = max (k*(k-1)*3) 0

main = do
  rawInput <- getContents
  let input = tail . lines $ rawInput
  let ns = every2nd input
  let ans = map (solve . (10-) .  read)  ns
  mapM_ print ans

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
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 qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

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

{- solution -}

solve :: Int -> [Int] -> Int
solve n as = digitPairsCount * 6
    where
        digitPairsCount = digitsCount * (digitsCount - 1) `div` 2
        digitsCount = (10 - L.length as)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer

import Data.Char

every2nd (x:y:xs) = x:(every2nd xs)
every2nd _ = []

solve k = max (k*(k-1)*3) 0

main = do
  rawInput <- getContents
  let input = tail . lines $ rawInput
  let ns = every2nd input
  let ans = map (solve . (10-) .  read)  ns
  print(ans)


You are given $$$n$$$ words of equal length $$$m$$$, consisting of lowercase Latin alphabet letters. The $$$i$$$-th word is denoted $$$s_i$$$.In one move you can choose any position in any single word and change the letter at that position to the previous or next letter in alphabetical order. For example:  you can change 'e' to 'd' or to 'f';  'a' can only be changed to 'b';  'z' can only be changed to 'y'. The difference between two words is the minimum number of moves required to make them equal. For example, the difference between "best" and "cost" is $$$1 + 10 + 0 + 0 = 11$$$.Find the minimum difference of $$$s_i$$$ and $$$s_j$$$ such that $$$(i < j)$$$. In other words, find the minimum difference over all possible pairs of the $$$n$$$ words.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains $$$2$$$ integers $$$n$$$ and $$$m$$$ ($$$2 \leq n \leq 50$$$, $$$1 \leq m \leq 8$$$) — the number of strings and their length respectively. Then follows $$$n$$$ lines, the $$$i$$$-th of which containing a single string $$$s_i$$$ of length $$$m$$$, consisting of lowercase Latin letters.

For each test case, print a single integer — the minimum difference over all possible pairs of the given strings.

6

2 4

best

cost

6 3

abb

zba

bef

cdu

ooo

zzz

2 7

aaabbbc

bbaezfe

3 2

ab

ab

ab

2 8

aaaaaaaa

zzzzzzzz

3 1

a

u

y

NoteFor the second test case, one can show that the best pair is ("abb","bef"), which has difference equal to $$$8$$$, which can be obtained in the following way: change the first character of the first string to 'b' in one move, change the second character of the second string to 'b' in $$$3$$$ moves and change the third character of the second string to 'b' in $$$4$$$ moves, thus making in total $$$1 + 3 + 4 = 8$$$ moves.For the third test case, there is only one possible pair and it can be shown that the minimum amount of moves necessary to make the strings equal is $$$35$$$.For the fourth test case, there is a pair of strings which is already equal, so the answer is $$$0$$$.

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

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve number 0 = return ()
solve number current = do
	line <- getLine
	let ws = words line
	let n = (read . head) ws :: Int
	let m = (read . head . tail) ws :: Int
	ls <- replicateM n getLine
	putStrLn $ (show . minimum) $ lejat ls
	solve number (current - 1)

lejat :: [String] -> [Int]
lejat ss = do
		let kezya = zip ss [1..]
		(a, b) <- kezya
		(c, d) <- kezya
		True <- return $ b /= d
		return $ sosat a c

sosat :: String -> String -> Int
sosat left right = sum $ zipWith (\a -> \b -> abs $ (fromEnum a) - (fromEnum b)) left right

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

sol :: [String] -> Int
sol xs = minimum [f x y | (x, i) <- ps, (y, j) <- ps, i /= j]
  where
    f xs' ys' = sum (zipWith (\x y -> abs (ord x - ord y)) xs' ys')
    ps = zip xs [1 .. length xs]

readCase :: IO [String]
readCase = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  replicateM n getLine

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  cases <- replicateM t readCase
  putStrLn $ intercalate "\n" (map (show . sol) cases)

module Main where

import Data.List
import Data.Maybe

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let sols = map (format . solve . parse) $ take t $ sep $ lines input
  mapM_ putStrLn sols

sep [] = []
sep (x:xs) = h:(sep t)
  where (h,t) = splitAt (read $ head $ words x) xs

parse :: [String] -> [[Int]]
parse = map (map fromEnum)

format = show

solve xs = minimum $ map distance $ pairs xs
  where pairs [] = []
        pairs (y:ys) = [(y,z) | z <- ys] ++ pairs ys
        distance (y,z) = sum $ map (abs . uncurry (-)) $ zip y z

import Control.Monad (replicateM_, replicateM)

letterDiff :: Char -> Char -> Int
letterDiff c1 c2 = abs (fromEnum c1 - fromEnum c2)

wordDiff :: String -> String -> Int
wordDiff w1 w2 = sum $ zipWith letterDiff w1 w2

solve :: [String] -> [[Int]]
solve [] = []
solve (x:xs) = (map (wordDiff x) xs) : solve xs

main = do
  t <- readLn :: IO Int
  replicateM_ t $ do
    l <- getLine
    let [n, m] = (map read . words) l :: [Int]
    words <- replicateM n getLine
    print $ minimum $ concat $ drop 1 $ reverse $ solve words

import Data.Char (ord)
import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = map read . words <$> getLine >>=
             \([n, m]) -> replicateM n getLine >>=
             print . findmin (maxBound :: Int)

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

strDiff :: String -> String -> Int
strDiff s1 s2 = foldl (\acc (c1, c2)-> acc + charDiff c1 c2) 0 $ zip s1 s2

findmin :: Int -> [String] -> Int
findmin m [] = m
findmin m (x:xs) = let m1 = foldl (\a s -> min a (strDiff x s)) m xs in
                     findmin m1 xs

import Data.Char (ord)

distC :: Char -> Char -> Int
distC a b = abs $ ord a - ord b

dist :: String -> String -> Int
dist [] [] = 0
dist (x: xs) (y: ys) = distC x y + dist xs ys

readStr :: Int -> IO [String]
readStr 0 = pure []
readStr i = do
  s <- getLine
  ans <- readStr $ i - 1
  pure (s: ans)

calcH :: String -> [String] -> Int
calcH _ [] = 100000000
calcH s (x: xs) = min (dist s x) (calcH s xs)

calc :: [String] -> Int
calc [] = 100000000
calc (x: xs) = min (calcH x xs) (calc xs)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: _) <- map (\s -> read s :: Int) <$> (words <$> getLine)
  arr <- readStr n
  print $ calc arr
  for $ i - 1

main = do
  t <- readLn :: IO Int
  for t

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

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve number 0 = return ()
solve number current = do
	line <- getLine
	let ws = words line
	let n = (read . head) ws :: Int
	let m = (read . head . tail) ws :: Int
	ls <- replicateM n getLine
	let vars = lejat ls
	if length vars == 0 then putStrLn "0"
	else putStrLn $ (show . minimum) $ vars
	solve number (current - 1)

lejat :: [String] -> [Int]
lejat ss = do
		firstVar <- ss
		secondVar <- ss
		True <- return $ firstVar /= secondVar
		return $ sosat firstVar secondVar

sosat :: String -> String -> Int
sosat left right = sum $ zipWith (\a -> \b -> abs $ (fromEnum a) - (fromEnum b)) left right

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

sol :: [String] -> Int
sol xs = minimum [abs (x - y) | (x, i) <- ps, (y, j) <- ps, i /= j]
  where
    conv = foldl' (\acc x -> acc + ord x) 0
    ps = zip (map conv xs) [1 .. (length xs)]

readCase :: IO [String]
readCase = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  replicateM n getLine

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  cases <- replicateM t readCase
  putStrLn $ intercalate "\n" (map (show . sol) cases)


While resting on the ship after the "Russian Code Cup" a boy named Misha invented an interesting game. He promised to give his quadrocopter to whoever will be the first one to make a rectangular table of size n × m, consisting of positive integers such that the sum of the squares of numbers for each row and each column was also a square.Since checking the correctness of the table manually is difficult, Misha asks you to make each number in the table to not exceed 108.

The first line contains two integers n and m (1 ≤ n, m ≤ 100)  — the size of the table.

Print the table that meets the condition: n lines containing m integers, separated by spaces. If there are multiple possible answers, you are allowed to print anyone. It is guaranteed that there exists at least one correct answer.

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]
-- }}}

row :: Int -> [Int]
row 1 = [1]
row 2 = [3,4]
row 3 = [3,4,12]
row m = (m-2) : replicate (m-1) 2

table :: Int -> Int -> [[Int]]
table n m = [[x*y | y <- row m] | x <- row n]

main :: IO ()
main = do
	[n,m] <- inputInts
	let t = table n m in forM_ t $ \r -> putStrLn $ unwords (map show r)

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')*(sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')*(sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Int
readInt = read <$> getLine
readIntList :: IO [Int]
readIntList = fmap read . words <$> getLine
readIntArray :: Int -> IO (Array Int Int)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Int -> IO (Array Int Int)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

squares :: [Int]
squares = flip fmap [1..] $ \i -> i * i

squareRoot :: Int -> Either Int Int
squareRoot x = squareRootImpl 1 x
  where
    squareRootImpl lo hi =
      if lo >= hi
        then
          case (lo * lo) `compare` x of
            LT -> Left $ lo
            EQ -> Right lo
            GT -> Left $ lo - 1
        else
          let mid = (lo + hi) `div` 2 in
          case (mid * mid) `compare` x of
            LT -> squareRootImpl (mid + 1) hi
            EQ -> Right mid
            GT -> squareRootImpl lo (mid - 1)

squareSum :: [[Int]]
squareSum = flip fmap [1..] $ \x ->
  case squareRoot x of
    Right y -> [y]
    Left y -> foldr1 (\l l' -> if (length l) < (length l') then l else l') $ flip fmap [1..y] (\i -> (i:)$ squareSum !! (x-i*i-1))

squareSumN :: [Int]
squareSumN = fmap length squareSum

smallS :: [[Int]]
smallS =
  [ [1]
  , [3, 4]
  , [3, 4, 12]
  , [3, 4, 12, 84]
  ]

main :: IO ()
main = do
  [n, m] <- readIntList
  let sn = squareSum !! (n-1)
  let pn = product $ fmap (\i -> i * i) sn
  let sn' = smallS !! (length sn - 1)
  let sm = squareSum !! (m-1)
  let pm = product $ fmap (\i -> i * i) sm
  let sm' = smallS !!(length sm - 1)
  forM_ [0..length sn - 1] $ \n' -> do
    let ni = (sn!!n')*(sn!!n')
    forM_ [1..(sn!!n')*(sn!!n')] $ \_ -> do
      forM_ [0..length sm - 1] $ \m' -> do
        let mi = (sm!!m')*(sm!!m')
        forM_ [1..(sm!!m')*(sm!!m')] $ \_ -> do
          putStr $ show ((sn'!!n')*(pn `div` ni)*(sm'!!m')*(pm `div` mi)) ++ " "
      putStrLn ""


Ilya the Lion wants to help all his friends with passing exams. They need to solve the following problem to pass the IT exam.You've got string s = s1s2... sn (n is the length of the string), consisting only of characters "." and "#" and m queries. Each query is described by a pair of integers li, ri (1 ≤ li < ri ≤ n). The answer to the query li, ri is the number of such integers i (li ≤ i < ri), that si = si + 1.Ilya the Lion wants to help his friends but is there anyone to help him? Help Ilya, solve the problem.

The first line contains string s of length n (2 ≤ n ≤ 105). It is guaranteed that the given string only consists of characters "." and "#". The next line contains integer m (1 ≤ m ≤ 105) — the number of queries. Each of the next m lines contains the description of the corresponding query. The i-th line contains integers li, ri (1 ≤ li < ri ≤ n).

Print m integers — the answers to the queries in the order in which they are given in the input.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array.Unboxed
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  s <- C.getLine
  let a = C.zipWith (\i j -> if i == j then 1 else 0) s $ C.tail s
      b :: UArray Int Int
      b = listArray (1, C.length s) $ scanl (+) 0 a
  q <- fmap (pairs . map readInt . tail . C.words) C.getContents
  putStr $ unlines $ map (\(i, j) -> show $ b!j - b!i) $ q

import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  s <- B.getLine
  let a = listArray (1, B.length s) $ scanl (+) 0 $ B.zipWith f s $ B.tail s
  B.getLine
  mapM_ (print . solve a . map (maybe 0 fst . B.readInt) . B.words) . B.lines =<< B.getContents

f :: Char -> Char -> Int
f a b = fromEnum $ a == b

solve :: UArray Int Int -> [Int] -> Int
solve a [l, r] = a ! r - a ! l

import Data.Array.Unboxed

main = interact $ unlines.g.lines

f (x:[]) ans = reverse ans
f (x:y:xs) ans
  | x == y = f (y:xs) (1:ans)
  | otherwise = f (y:xs) (0:ans)

prefixsum [] sumsofar ans = reverse (sumsofar:ans)
prefixsum (x:xs) sumsofar ans = prefixsum xs (sumsofar+x) (sumsofar:ans)

query (a:b:[]) xs = (xs ! b) - (xs ! a)

g (x:y:xs) = map show (reverse (h k (trtd xs) []))
  where j = (prefixsum (f x []) 0 [])
        k = listArray (1, (length j)) j

h :: Array Int Int -> [[Int]] -> [Int] -> [Int]
h a [] ans = ans
h a (x:xs) ans = h a xs ((query x a):ans)

trtd = map (\x -> (map read (words x)) :: [Int])

import Data.Array.Unboxed
import Numeric

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ unlines.g.lines

f (x:[]) ans = reverse ans
f (x:y:xs) ans
  | x == y = f (y:xs) (1:ans)
  | otherwise = f (y:xs) (0:ans)

prefixsum [] sumsofar ans = reverse (sumsofar:ans)
prefixsum (x:xs) sumsofar ans = prefixsum xs (sumsofar+x) (sumsofar:ans)

query (a:b:[]) xs = (xs ! b) - (xs ! a)

g (x:y:xs) = map show (reverse (h k (trtd xs) []))
  where j = (prefixsum (f x []) 0 [])
        k = listArray (1, (length j)) j

h :: Array Int Int -> [[Int]] -> [Int] -> [Int]
h a [] ans = ans
h a (x:xs) ans = h a xs ((query x a):ans)

trtd = map (\x -> (map fastRead (words x)) :: [Int])

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- 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.Ord
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.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
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
  s <- getLine

  let
    cs = listArray (1, length l) l :: UArray Int Int
      where
        l = scanl (+) 0 $ map fromEnum $ zipWith (==) s $ tail s

  m <- readLn

  qs <- replicateM m getInts

  putStrLn $ unlines $ map show $ map (\[l, r] -> cs!r - cs!l) qs

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.(\ (a1:a2:as)->a1:(take (read a2) as)). lines
solve :: [String]->String
solve (xx:xs) = unlines $ map show $ slv1 (ones2, xsnum)
  where
  ones1  = map fst $ scanl (\(b1,b2) a->if a==b2 then (b1,a) else (b1+1,a) ) (0,head xx) xx
  ones2  = array (1,length $ tail ones1) $ zip [1..length $ tail ones1] $ tail ones1
  xsnum  = map (map (read::String->Int).words) xs
slv1 (xs,yss)=[z|[y1,y2]<-yss, let z = y2-y1 - (xs!y2 -xs!y1)]

import Control.Monad (liftM, replicateM)
import Data.Array
import Data.Char (ord)
import Data.List (intercalate)

solve :: String -> [(Int, Int)] -> [Int]
solve s qs  =  map solve' qs
  where
    n  =  length s
    solve' (l, r)  =  a ! r - a ! l
    a  =  listArray (1,n) $ scanl (+) 0 $ zipWith eqToInt s $ tail s
    eqToInt a b  =  if a == b then 1 else 0

main :: IO ()
main  =  do
    s  <-  getLine
    n  <-  readLn
    qs  <-  replicateM n readPair
    mapM_ print $ solve s qs

  where

    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

import Data.Array.Unboxed ((!), Array, listArray)

main :: IO ()
main = getLine >>= \s -> getContents >>= mapM_ print . solve s . map (map read . words) . tail . lines

solve :: String -> [[Int]] -> [Int]
solve s lrs = [ dp ! r - dp ! l | [ l, r ] <- lrs ]
  where dp :: Array Int Int
        dp = listArray (1, length s) $ scanl (+) 0 $ zipWith (\x y -> fromEnum (x == y)) s $ tail s

import Data.Array.Unboxed ((!), Array, listArray)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

main :: IO ()
main = B.getLine >>= \s -> B.getContents >>= mapM_ print . solve s . map (map (fst . fromJust . B.readInt) . B.words) . tail . B.lines

solve :: B.ByteString -> [[Int]] -> [Int]
solve s lrs = [ dp ! r - dp ! l | [ l, r ] <- lrs ]
  where dp :: Array Int Int
        dp = listArray (1, B.length s) $ scanl (+) 0 $ B.zipWith (curry (fromEnum . uncurry (==))) s $ B.tail s

import Data.Array.Unboxed
import Control.Monad
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = do
  s <- B.getLine
  let a = listArray (0,B.length s) $ scanl (+) 0 $
          B.zipWith ((fromEnum .) . (==)) s (B.tail s) :: UArray Int Int
  q <- readI <$> B.getLine
  replicateM_ q $ do
    [l,r] <- map readI . B.words <$> B.getLine
    print $ a!(r-1) - a!(l-1)

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

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

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

main :: IO ()
main = do
  xs <- scanl1(+).f <$> getLine
  let arr = listArray (0,length xs-1) xs
  _ <- getLine
  lrs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show$solve arr lrs

solve :: UArray Int Int -> [Int] -> [Int]
solve arr lrs = go lrs
   where
     go (l:r:rest)
       | l==1 = unsafeAt arr (r-2) : go rest
       | otherwise = unsafeAt arr (r-2) - unsafeAt arr (l-2) : go rest
     go _ = []

f (x:y:z)
  | x==y = 1 : f (y:z)
  | otherwise = 0 : f (y:z)
f _ = []

import Data.Array

getQu :: [String] -> [(Int, Int)]
getQu [] = []
getQu (sl : sr : xs) = (read sl, read sr) : (getQu xs)

getSufSum :: String -> [Int]
getSufSum [x] = [0]
getSufSum (x1 : x2 : xs) = ((if x1 == x2 then 1 else 0) + head t) : t
    where
        t = getSufSum (x2 : xs)

getAns :: Array Int Int -> (Int, Int) -> [String]
getAns sum (l, r) = [show $ (sum ! l)  - (sum ! r)]

handle :: [String] -> [[String]]
handle (s : _ : sq) = map (getAns (listArray (1, length(sum)) sum)) (getQu sq)
    where
        sum = getSufSum s

main :: IO ()
main = interact $ unlines . map unwords . handle . words

import Control.Applicative
import Data.List
import Data.Array

main= do
	s<-getLine
	let ls = length s
	let s1 = tail s
	let ls1 = length s1
	let ans = listArray (1,ls) $ scanl1 (+) $ [0]++ (zipWith (\a b-> if a==b then 1 else 0) s s1) ++[0]
	getLine
	q<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ intercalate "\n" $ map show$  map (\[x,y]->ans!y-ans!x) q

import qualified Data.IntMap as Map
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Array

cons :: BS.ByteString -> Array Int Int
cons s  = (extract . BS.foldl' f (1,' ',0,[])) s
  where
    extract (_,_,_,m) = array (1, fromIntegral $ BS.length s) m
    f (idx, before, count,m) c
      | before == c = (idx+1, c, count+1, (idx, count + 1): m)
      | otherwise = (idx + 1, c, count, (idx, count): m)

main :: IO ()
main = do
  (s:_:rest) <- liftM BS.lines BS.getContents
  let m = cons s
  mapM_ (print . rush m . readTuple) rest

readTuple :: BS.ByteString -> (Int, Int)
readTuple s = let (a, aRest) = fromJust $ BS.readInt s
                  rest = BS.dropWhile (== ' ') aRest
                  (b, _) = fromJust $ BS.readInt rest in (a,b)

rush :: Array Int Int -> (Int, Int) -> Int
rush m (l, r) = m!r - m!l

import Data.List
import Data.Maybe
import Data.Char
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.(\ (a1:a2:as)->a1:(take (read a2) as)). lines
solve :: [String]->String
solve (xx:xs) = unlines $ map show $ slv1 (ones1, xsnum)
  where
  ones1  = map fst $ scanl (\(b1,b2) a->if a==b2 then (b1,a) else (b1+1,a) ) (0,head xx) xx
  xsnum  = map (map (read::String->Int).words) xs
slv1 (xs,yss)=[z|[y1,y2]<-yss, let z = y2-y1]

import Control.Applicative
import Data.List
import Data.Array

main= do
	s<-getLine
	let s1 = tail s
	let ls1 = length s
	let ans = listArray (1,ls1) $ (zipWith (\a b-> if a==b then 1 else 0) s s1)++[0]
	print ans
	let ans2d = array ((1,1),(ls1,ls1)) $ [((i,j),(if i+1==j then ans!i else ans2d!(i+1,j)+ans!i ))| i<-[1..ls1],j<-[i+1..ls1]]
	getLine
	q<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	putStrLn $ intercalate " " $ map show$  map (\[a,b]->ans2d!(a,b)) q


Cirno gives AquaMoon a problem. There are $$$m$$$ people numbered from $$$0$$$ to $$$m - 1$$$. They are standing on a coordinate axis in points with positive integer coordinates. They are facing right (i.e. in the direction of the coordinate increase). At this moment everyone will start running with the constant speed in the direction of coordinate increasing. The initial coordinate of the $$$i$$$-th person on the line is $$$x_i$$$, and the speed of the $$$i$$$-th person is $$$v_i$$$. So the coordinate of the $$$i$$$-th person at the moment $$$t$$$ will be $$$x_i + t \cdot v_i$$$.Cirno captured the coordinates of $$$m$$$ people in $$$k$$$ consecutive integer moments from $$$0$$$ to $$$k - 1$$$. In every moment, the coordinates of $$$m$$$ people were recorded in arbitrary order.To make the problem more funny, Cirno modified one coordinate at the moment $$$y$$$ ($$$0 < y < k-1$$$) to a different integer.AquaMoon wants to find the moment $$$y$$$ and the original coordinate $$$p$$$ before the modification. Actually, she is not a programmer at all. So she wasn't able to solve it. Can you help her?

This problem is made as interactive. It means, that your solution will read the input, given by the interactor. But the interactor will give you the full input at the beginning and after that, you should print the answer. So you should solve the problem, like as you solve the usual, non-interactive problem because you won't have any interaction process. The only thing you should not forget is to flush the output buffer, after printing the answer. Otherwise, you can get an "Idleness limit exceeded" verdict. Refer to the interactive problems guide for the detailed information about flushing the output buffer. The first line contains two integers $$$m$$$ and $$$k$$$ ($$$5 \leq m \leq 1000$$$, $$$7 \leq k \leq 1000$$$) — the number of people and the number of recorded moments.  The next $$$k$$$ lines contain captured positions. $$$i$$$-th of these lines contains $$$m$$$ integers between $$$1$$$ and $$$10^6$$$ (inclusive), representing positions captured by Cirno at the moment $$$i-1$$$. The input is guaranteed to be valid (i.e. only one integer was modified to a different value according to the problem statement). Also, it is guaranteed, that $$$1 \le v_i \le 1000$$$ for all $$$1 \leq i \leq m$$$. Hack format: The first line should contain two integers $$$m$$$ and $$$k$$$ ($$$5 \leq m \leq 1000$$$, $$$7 \leq k \leq 1000$$$) — the number of people and the number of moments.  In the second line, there should be $$$m$$$ integers $$$x_0, x_1, \dots,x_{m - 1}$$$ ($$$1 \le x_i \le 10^6$$$), where $$$x_i$$$ is the initial coordinate of the $$$i$$$-th person. In the third line, there should be $$$m$$$ integers $$$v_0, v_1, \dots,v_{m - 1}$$$ ($$$1 \le v_i \le 1000$$$), where $$$v_i$$$ is the speed of the $$$i$$$-th person. It should be true that $$$x_i + (k-1) v_i \leq 10^6$$$ for each $$$0 \leq i < m$$$. In the next $$$k$$$ lines, each line should contain $$$m$$$ integers. $$$i$$$-th line should contain $$$m$$$ distinct integers $$$p_0, p_1, \ldots, p_{m-1}$$$ ($$$0 \leq p_j < m$$$). The meaning of these numbers: $$$j$$$-th integer in the input in the $$$i$$$-th moment is the coordinate of the $$$p_{j}$$$-th person. In the last line, there should be three integers $$$y$$$, $$$i$$$, $$$c$$$. Cirno modified the coordinate of the $$$i$$$-th person at the moment $$$y$$$ to $$$c$$$ ($$$1 \leq y \leq k-2$$$, $$$0 \leq i \leq m - 1$$$, $$$1 \leq c \leq 10^6$$$, $$$c \neq x_i + y \cdot v_i$$$).

Print a single line with two integers $$$y$$$, $$$p$$$ — the moment that contains the modified coordinate and the original coordinate.

NoteIn the first test the initial coordinates of people are $$$9$$$, $$$6$$$, $$$6$$$, $$$9$$$, $$$9$$$ and their speeds are $$$1$$$, $$$2$$$, $$$1$$$, $$$1$$$, $$$1$$$. So, it's easy to see, that at the moment $$$4$$$ one coordinate was modified from $$$13$$$ to $$$12$$$.This is the first test in the hack format:5 79 6 6 9 91 2 1 1 12 3 4 1 00 2 3 1 44 3 0 1 21 3 4 0 21 4 0 2 32 4 1 3 02 4 1 3 04 0 12

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

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

import Data.Int

z3t :: [t] -> [(t, t, t)]
z3t li = let
  l2 = tail li
  in  zip3 li l2 (tail l2)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [m, k] <- readInts
  x <- replicateM k readInts
  let
    tot1s :: [Int64]
    tot1s = map (foldl' (\p q -> p + fromIntegral q) 0) x
    tot2s :: [Int64]
    tot2s = map (foldl' (\p q -> p + fromIntegral q ^ 2) 0) x
    okIx = head $ [ix | (ix, (p, q, r)) <- zip [0..] $ z3t tot1s, p+r == 2*q]
    okIx32 = fromIntegral okIx
    [p1, q1, _r1] = take 3 $ drop okIx32 $ tot1s
    li2@[p2, q2, r2] = take 3 $ drop okIx32 $ tot2s
    slope = q1 - p1
    intercept = p1 - slope * okIx
    quad2 = div (r2 + p2 - 2*q2) 2
    [p2x, q2x, _r2x] = zipWith (-) li2 [quad2 * j * j | j <- [okIx..]]
    slope2 = q2x - p2x
    intercept2 = p2x - slope2 * okIx

    real_tot1s = take k [slope * ix + intercept | ix <- [0..]]
    real_tot2s = take k [quad2 * ix * ix + slope2 * ix + intercept2
                        | ix <- [0..]]
    [wrongIx] = [ix | (ix, t1, rt1) <- zip3 [0..] tot1s real_tot1s, t1 /= rt1]
    wix32 = fromIntegral wrongIx
    p64s = putInts . map fromIntegral
    error1_amt = tot1s !! wix32 - real_tot1s !! wix32
    error2_amt = tot2s !! wix32 - real_tot2s !! wix32
    origVal = div (error2_amt - error1_amt^2) (2 * error1_amt)
  {-
  p64s tot1s
  p64s $ real_tot1s
  p64s $ tot2s
  p64s $ real_tot2s
  putInts [fromIntegral slope]
  putInts [fromIntegral intercept]
  -}
  p64s [wrongIx, origVal]

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

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

import Data.Int

z3t :: [t] -> [(t, t, t)]
z3t li = let
  l2 = tail li
  in  zip3 li l2 (tail l2)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [m, k] <- readInts
  x <- replicateM k readInts
  let
    tot1s :: [Int64]
    tot1s = map (foldl' (\p q -> p + fromIntegral q) 0) x
    tot2s :: [Int64]
    tot2s = map (foldl' (\p q -> p + fromIntegral q ^ 2) 0) x
    okIx = head $ [ix | (ix, (p, q, r)) <- zip [0..] $ z3t tot1s, p+r == 2*q]
    okIx32 = fromIntegral okIx
    [p1, q1, _r1] = take 3 $ drop okIx32 $ tot1s
    li2@[p2, q2, r2] = take 3 $ drop okIx32 $ tot2s
    slope = q1 - p1
    intercept = p1 - slope * okIx
    quad2 = div (r2 + p2 - 2*q2) 2
    [p2x, q2x, _r2x] = zipWith (-) li2 [quad2 * j | j <- [okIx..]]
    slope2 = q2x - p2x
    intercept2 = p2x - slope2 * okIx

    real_tot1s = take k [slope * ix + intercept | ix <- [0..]]
    real_tot2s = take k [quad2 * ix * ix + slope2 * ix + intercept2
                        | ix <- [0..]]
    [wrongIx] = [ix | (ix, t1, rt1) <- zip3 [0..] tot1s real_tot1s, t1 /= rt1]
    wix32 = fromIntegral wrongIx
    p64s = putInts . map fromIntegral
    error1_amt = tot1s !! wix32 - real_tot1s !! wix32
    error2_amt = tot2s !! wix32 - real_tot2s !! wix32
    origVal = div (error2_amt - error1_amt^2) (2 * error1_amt)
  {-
  p64s tot1s
  p64s $ real_tot1s
  p64s $ tot2s
  p64s $ real_tot2s
  putInts [fromIntegral slope]
  putInts [fromIntegral intercept]
  -}
  p64s [wrongIx, origVal]

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Given three numbers $$$n, a, b$$$. You need to find an adjacency matrix of such an undirected graph that the number of components in it is equal to $$$a$$$, and the number of components in its complement is $$$b$$$. The matrix must be symmetric, and all digits on the main diagonal must be zeroes.In an undirected graph loops (edges from a vertex to itself) are not allowed. It can be at most one edge between a pair of vertices.The adjacency matrix of an undirected graph is a square matrix of size $$$n$$$ consisting only of "0" and "1", where $$$n$$$ is the number of vertices of the graph and the $$$i$$$-th row and the $$$i$$$-th column correspond to the $$$i$$$-th vertex of the graph. The cell $$$(i,j)$$$ of the adjacency matrix contains $$$1$$$ if and only if the $$$i$$$-th and $$$j$$$-th vertices in the graph are connected by an edge.A connected component is a set of vertices $$$X$$$ such that for every two vertices from this set there exists at least one path in the graph connecting this pair of vertices, but adding any other vertex to $$$X$$$ violates this rule.The complement or inverse of a graph $$$G$$$ is a graph $$$H$$$ on the same vertices such that two distinct vertices of $$$H$$$ are adjacent if and only if they are not adjacent in $$$G$$$.

In a single line, three numbers are given $$$n, a, b \,(1 \le n \le 1000, 1 \le a, b \le n)$$$: is the number of vertexes of the graph, the required number of connectivity components in it, and the required amount of the connectivity component in it's complement.

If there is no graph that satisfies these constraints on a single line, print "NO" (without quotes). Otherwise, on the first line, print "YES"(without quotes). In each of the next $$$n$$$ lines, output $$$n$$$ digits such that $$$j$$$-th digit of $$$i$$$-th line must be $$$1$$$ if and only if there is an edge between vertices $$$i$$$ and $$$j$$$ in $$$G$$$ (and $$$0$$$ otherwise). Note that the matrix must be symmetric, and all digits on the main diagonal must be zeroes.  If there are several matrices that satisfy the conditions — output any of them.

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        n:ia:ib:_ = map fastRead . words $ input
        a:b:_ = sort [ia, ib]
        can = min a b == 1 && not specialcase
        inverted = ia == 1
        specialcase
            | n == 2 && a == 1 && b == 1 = True
            | n == 3 && a == 1 && b == 1 = True
            | otherwise = False

        table = intercalate "\n" . map tableRow $ [1..n]
        tableRow rowIdx = map cellValue [1..n]
            where
                onValue = if inverted then '0' else '1'
                offValue = if inverted then '1' else '0'
                cellValue colIdx
                    | colIdx == rowIdx = '0'
                    | rowIdx > n-b+1 || colIdx > n-b+1 = offValue
                    | abs (rowIdx - colIdx) == 1 = onValue
                    | otherwise = offValue

        answer
            | not can = "NO"
            | otherwise = "YES\n" ++ table

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        n:ia:ib:_ = map fastRead . words $ input
        a:b:_ = sort [ia, ib]
        can = min a b == 1 && not specialcase
        inverted = a /= ia
        specialcase
            | n == 2 && a == 1 && b == 1 = True
            | n == 3 && a == 1 && b == 1 = True
            | otherwise = False

        table = intercalate "\n" . map tableRow $ [1..n]
        tableRow rowIdx = map cellValue [1..n]
            where
                onValue = if inverted then '0' else '1'
                offValue = if inverted then '1' else '0'
                cellValue colIdx
                    | colIdx == rowIdx = '0'
                    | abs (rowIdx - colIdx) == 1 = onValue
                    | otherwise = offValue

        answer
            | not can = "NO"
            | otherwise = "YES\n" ++ table

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        n:ia:ib:_ = map fastRead . words $ input
        a:b:_ = sort [ia, ib]
        can = min a b == 1 && not specialcase
        inverted = a /= ia
        specialcase
            | n == 2 && a == 1 && b == 1 = True
            | n == 3 && a == 1 && b == 1 = True
            | otherwise = False

        table = intercalate "\n" . map tableRow $ [1..n]
        tableRow rowIdx = map cellValue [1..n]
            where
                onValue = if inverted then '0' else '1'
                offValue = if inverted then '1' else '0'
                cellValue colIdx
                    | colIdx == rowIdx = '0'
                    | rowIdx > b + 1 || colIdx > b + 1 = offValue
                    | abs (rowIdx - colIdx) == 1 = onValue
                    | otherwise = offValue

        answer
            | not can = "NO"
            | otherwise = "YES\n" ++ table

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
        n:ia:ib:_ = map fastRead . words $ input
        a:b:_ = sort [ia, ib]
        can = min a b == 1 && not specialcase
        inverted = a /= ia
        specialcase
            | n == 2 && a == 1 && b == 1 = True
            | n == 3 && a == 1 && b == 1 = True
            | otherwise = False

        table = intercalate "\n" . map tableRow $ [1..n]
        tableRow rowIdx = map cellValue [1..n]
            where
                onValue = if inverted then '0' else '1'
                offValue = if inverted then '1' else '0'
                cellValue colIdx
                    | colIdx == rowIdx = '0'
                    | rowIdx > n-b+2 || colIdx > n-b+2 = offValue
                    | abs (rowIdx - colIdx) == 1 = onValue
                    | otherwise = offValue

        answer
            | not can = "NO"
            | otherwise = "YES\n" ++ table


You are given an integer $$$n$$$. You have to construct a permutation of size $$$n$$$.A permutation is an array where each integer from $$$1$$$ to $$$s$$$ (where $$$s$$$ is the size of permutation) occurs exactly once. For example, $$$[2, 1, 4, 3]$$$ is a permutation of size $$$4$$$; $$$[1, 2, 4, 5, 3]$$$ is a permutation of size $$$5$$$; $$$[1, 4, 3]$$$ is not a permutation (the integer $$$2$$$ is absent), $$$[2, 1, 3, 1]$$$ is not a permutation (the integer $$$1$$$ appears twice).A subsegment of a permutation is a contiguous subsequence of that permutation. For example, the permutation $$$[2, 1, 4, 3]$$$ has $$$10$$$ subsegments: $$$[2]$$$, $$$[2, 1]$$$, $$$[2, 1, 4]$$$, $$$[2, 1, 4, 3]$$$, $$$[1]$$$, $$$[1, 4]$$$, $$$[1, 4, 3]$$$, $$$[4]$$$, $$$[4, 3]$$$ and $$$[3]$$$.The value of the permutation is the number of its subsegments which are also permutations. For example, the value of $$$[2, 1, 4, 3]$$$ is $$$3$$$ since the subsegments $$$[2, 1]$$$, $$$[1]$$$ and $$$[2, 1, 4, 3]$$$ are permutations.You have to construct a permutation of size $$$n$$$ with minimum possible value among all permutations of size $$$n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 48$$$) — the number of test cases. Then, $$$t$$$ lines follow. The $$$i$$$-th of them contains one integer $$$n$$$ ($$$3 \le n \le 50$$$) representing the $$$i$$$-th test case.

For each test case, print $$$n$$$ integers — the permutation of size $$$n$$$ with minimum possible value. If there are multiple such permutations, print any of them.

NoteIn the first example, the permutation $$$[1, 4, 3, 5, 2]$$$ is one of the possible answers; its value is $$$2$$$.In the second example, the permutation $$$[4, 1, 6, 2, 5, 3]$$$ is one of the possible answers; its value is $$$2$$$.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
{-# LANGUAGE Strict #-}
-- {-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
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 qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

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

{- solution -}

solve :: Int -> [Int]
solve n = solve' 1 n
    where
        solve' l r
            | l == r = [l]
            | odd l = l : solve' (l + 1) r
            | even l = (solve' (l + 1) r) ++ [l]

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        let answer = solve n
        M.forM_ answer $ \x -> printf "%d " x
        printf "\n"


You are given a board of size $$$n \times n$$$, where $$$n$$$ is odd (not divisible by $$$2$$$). Initially, each cell of the board contains one figure.In one move, you can select exactly one figure presented in some cell and move it to one of the cells sharing a side or a corner with the current cell, i.e. from the cell $$$(i, j)$$$ you can move the figure to cells:   $$$(i - 1, j - 1)$$$;  $$$(i - 1, j)$$$;  $$$(i - 1, j + 1)$$$;  $$$(i, j - 1)$$$;  $$$(i, j + 1)$$$;  $$$(i + 1, j - 1)$$$;  $$$(i + 1, j)$$$;  $$$(i + 1, j + 1)$$$; Of course, you can not move figures to cells out of the board. It is allowed that after a move there will be several figures in one cell.Your task is to find the minimum number of moves needed to get all the figures into one cell (i.e. $$$n^2-1$$$ cells should contain $$$0$$$ figures and one cell should contain $$$n^2$$$ figures).You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 200$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of the test case contains one integer $$$n$$$ ($$$1 \le n < 5 \cdot 10^5$$$) — the size of the board. It is guaranteed that $$$n$$$ is odd (not divisible by $$$2$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$5 \cdot 10^5$$$ ($$$\sum n \le 5 \cdot 10^5$$$).

For each test case print the answer — the minimum number of moves needed to get all the figures into one cell.

import           Control.Arrow

main = interact $
  words >>> drop 1 >>> map (read >>> solve >>> show) >>> unlines

solve :: Integer -> Integer
solve n = 4 * (n2 * (n2 + 1) * (2*n2 + 1)) `div` 3
  where
    n2 = n `div` 2

import Control.Monad

type Test = Integer

getLines :: Int -> IO [String]
getLines count = replicateM count getLine

parseData :: [String] -> [Test]
parseData [] = []
parseData (first:rest) = (read first) : parseData rest

getAnswer :: [Test] -> [Integer]
getAnswer [] = []
getAnswer (first:rest) = solve first : getAnswer rest

solve :: Integer -> Integer
solve 1 = 0
solve n = sideCells * middle + solve (n - 2)
    where middle = n `div` 2
          inner = (n - 2)^2
          sideCells = n^2 - inner

main :: IO ()
main = do
    count <- getLine
    tests <- getLines $ read count
    mapM_ print (getAnswer $ parseData tests)

import Control.Monad

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

routine :: IO ()
routine = do
    n <- (readLn :: IO Integer)
    let a = n `div` 2
    print $ 8 * (a * (a + 1) * (2*a + 1)) `div` 6

import Data.Map as M
import Data.List as L

fun :: Integer -> Integer
fun 1 = 0
fun n = (n*2 + 2*(n-2))*(div n 2) + fun (n-2)

solve :: String -> String
solve input = show $ fun n
  where n = read input :: Integer

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


You are given an array $$$a$$$ consisting of $$$n$$$ integers. Each $$$a_i$$$ is one of the six following numbers: $$$4, 8, 15, 16, 23, 42$$$.Your task is to remove the minimum number of elements to make this array good.An array of length $$$k$$$ is called good if $$$k$$$ is divisible by $$$6$$$ and it is possible to split it into $$$\frac{k}{6}$$$ subsequences $$$4, 8, 15, 16, 23, 42$$$.Examples of good arrays:  $$$[4, 8, 15, 16, 23, 42]$$$ (the whole array is a required sequence);  $$$[4, 8, 4, 15, 16, 8, 23, 15, 16, 42, 23, 42]$$$ (the first sequence is formed from first, second, fourth, fifth, seventh and tenth elements and the second one is formed from remaining elements);  $$$[]$$$ (the empty array is good). Examples of bad arrays:   $$$[4, 8, 15, 16, 42, 23]$$$ (the order of elements should be exactly $$$4, 8, 15, 16, 23, 42$$$);  $$$[4, 8, 15, 16, 23, 42, 4]$$$ (the length of the array is not divisible by $$$6$$$);  $$$[4, 8, 15, 16, 23, 42, 4, 8, 15, 16, 23, 23]$$$ (the first sequence can be formed from first six elements but the remaining array cannot form the required sequence).

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 5 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ (each $$$a_i$$$ is one of the following numbers: $$$4, 8, 15, 16, 23, 42$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

Print one integer — the minimum number of elements you have to remove to obtain a good array.

count :: [Int] -> [Int] -> Int
count (x:xs) res
    | x == 4 = count xs [a + 1,b,c,d,e,f]
    | x == 8 && a > 0 = count xs [a - 1,b + 1,c,d,e,f]
    | x == 15 && b > 0 = count xs [a,b - 1,c + 1,d,e,f]
    | x == 16 && c > 0 = count xs [a,b,c - 1,d + 1,e,f]
    | x == 23 && d > 0 = count xs [a,b,c,d - 1,e + 1,f]
    | x == 42 && e > 0 = count xs [a,b,c,d,e - 1,f + 1]
    | otherwise = count xs res
    where a = res!!0
          b = res!!1
          c = res!!2
          d = res!!3
          e = res!!4
          f = res!!5
count _ res = res!!5

solve :: [Int] -> Int
solve (x:xs)
    | length xs < 6 = length xs
    | otherwise = x - 6 * (count xs (replicate 6 0))

main = interact $ show . solve . map (read::String->Int) . words


You are given a string $$$s$$$ such that each its character is either 1, 2, or 3. You have to choose the shortest contiguous substring of $$$s$$$ such that it contains each of these three characters at least once.A contiguous substring of string $$$s$$$ is a string that can be obtained from $$$s$$$ by removing some (possibly zero) characters from the beginning of $$$s$$$ and some (possibly zero) characters from the end of $$$s$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 20000$$$) — the number of test cases. Each test case consists of one line containing the string $$$s$$$ ($$$1 \le |s| \le 200000$$$). It is guaranteed that each character of $$$s$$$ is either 1, 2, or 3. The sum of lengths of all strings in all test cases does not exceed $$$200000$$$.

For each test case, print one integer — the length of the shortest contiguous substring of $$$s$$$ containing all three types of characters at least once. If there is no such substring, print $$$0$$$ instead.

NoteConsider the example test:In the first test case, the substring 123 can be used.In the second test case, the substring 213 can be used.In the third test case, the substring 1223 can be used.In the fourth test case, the substring 3221 can be used.In the fifth test case, there is no character 3 in $$$s$$$.In the sixth test case, there is no character 1 in $$$s$$$.In the seventh test case, the substring 3112 can be used.

import Data.List (group)
main = interact $ unlines . map f . tail . lines

f x = show $ ans
  where g = map (\x -> (head x, length x)) (group x)
        inp = zip3 g (tail g) (tail (tail g))
        h = map (\((i, x), (j, y), (k, z)) -> if i == k then 0 else y+2) inp
        h1 = filter (/= 0) h
        ans = if (h1==[]) then 0 else minimum h1

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s
  | null fs = 0
  | otherwise = minimum $ map(\((a,la),(b,lb),(c,lc)) -> lb + 2 ) fs

  where
    ps = map (\x -> (head x,length x)) $ group s
    ts = zip3 ps (tail ps) (tail $ tail $ ps)
    fs = filter (\((a,la),(b,lb),(c,lc)) -> (length $ nub [a,b,c]) == 3) ts

import Data.List

inf = 300000

solve' :: (Int, Int, Int) -> String -> Int
solve' _ [] = inf
solve' cum (x:xs) = min (score u) nxt
    where nxt = solve' u xs
          u = upd cum x

score :: (Int, Int, Int) -> Int
score (a, b, c) = 1 + (maximum [a, b, c])

upd :: (Int, Int, Int) -> Char -> (Int, Int, Int)
upd (_, l2, l3) '1' = (0, l2 + 1, l3 + 1)
upd (l1, _, l3) '2' = (l1 + 1, 0, l3 + 1)
upd (l1, l2, _) '3' = (l1 + 1, l2 + 1, 0)

main :: IO ()
main = interact solve
    where solve = (intercalate "\n")
                  . (map show)
                  . (map $ \x -> if x >= inf then 0 else x)
                  . (map (solve' (inf, inf, inf)))
                  . (drop 1) . words

import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    replicateM_ n routine

routine = do
    s <- getLine
    print $ solve s

solve :: String -> Int
solve s
    | null total_ans = 0
    | otherwise = minimum $ map (\((a, la), (b, lb), (c, lc)) -> lb+2) total_ans
    where
        grouped_list = map (\x -> (head x, length x)) $ group s
        pre_now_next = zip3 grouped_list (tail grouped_list) (tail $ tail $ grouped_list)
        total_ans = filter (\((a, la), (b, lb), (c, lc)) -> length (nub [a, b, c]) == 3) pre_now_next

import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    replicateM_ n routine

routine = do
    s <- getLine
    print $ solve s

solve :: String -> Int
solve s
    | null total_ans = 0
    | otherwise = minimum $ map (\((a, la), (b, lb), (c, lc)) -> lb+2) total_ans
    where
        -- group_list = [(char, how_many)]
        grouped_list = map (\x -> (head x, length x)) $ group s
        -- pre_now_next = [(i-1, length), (i, length), (i+1, length)]
        pre_now_next = zip3 grouped_list (tail grouped_list) (tail $ tail $ grouped_list)
        -- total_ans = i-1 != i 's pair
        total_ans = filter (\((a, la), (b, lb), (c, lc)) -> length (nub [a, b, c]) == 3) pre_now_next

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

prefixSum :: [Int] -> UArray Int Int
prefixSum lst = Ar.listArray (0,length lst) $ 0:go 0 lst
    where
        go aux (n:rest) = (aux+n): go (aux+n) rest

rangeQuery :: String -> Char -> Int -> Int -> Int
rangeQuery s = runner
    where
        runner ch start end
            | ch == '1' = prefix1 Ar.! end - (prefix1 Ar.! (start-1))
            | ch == '2' = prefix2 Ar.! end - (prefix2 Ar.! (start-1))
            | ch == '3' = prefix3 Ar.! end - (prefix3 Ar.! (start-1))
        charMapper c x
            | c == x    = 1
            | otherwise = 0
        prefix1 = prefixSum $ map (charMapper '1') s
        prefix2 = prefixSum $ map (charMapper '2') s
        prefix3 = prefixSum $ map (charMapper '3') s

validRange :: (Char -> Int -> Int -> Int) -> (Int, Int) -> Bool
validRange rqRunner (start, end) = validForChar '1' && validForChar '2' && validForChar '3'
    where
        validForChar c = 0 < rqRunner c start end
{-
solve :: String -> Int
solve s = minimum $ map (\(a,b) -> b-a) allValidRanges
    where
        rqRunner = rangeQuery s
        allPossibleRanges = (1,length s) : possibleRanges '1' ++ possibleRanges '2' ++ possibleRanges '3'
        allValidRanges = filter (validRange rqRunner) allPossibleRanges
        possibleRanges c = zip ind $ map pred $ tail ind
            where
                ind = map fst $ filter (\(i,x) -> x == c) $ zip [1..] s
-}

scan :: UArray Int Char -> (Int, Int) -> (Int, Int, Int) -> Int
scan arr (start, end) cnt@(cnt1, cnt2, cnt3)
    | valid cnt = min (cnt1+cnt2+cnt3) $ scan arr (start+1, end) $ sub1 (arr Ar.! start) cnt
    | otherwise = if finished then 5000000 else scan arr (start, end+1) $ add1 (arr Ar.! (end+1)) cnt
    where
        finished = end == snd (Ar.bounds arr)
        valid (cnt1, cnt2, cnt3) = cnt1 > 0 && cnt2 >0 && cnt3 > 0
        add n '1' (cnt1, cnt2, cnt3) = (cnt1+n, cnt2, cnt3)
        add n '2' (cnt1, cnt2, cnt3) = (cnt1, cnt2+n, cnt3)
        add n '3' (cnt1, cnt2, cnt3) = (cnt1, cnt2, cnt3+n)
        add1 = add 1
        sub1 = add (-1)

solve :: String -> Int
solve s =
    case scan (Ar.listArray (1,length s) s) (1,1) init of
        5000000 -> 0
        ans -> ans
    where
        init =
            case s of
                '1':_ -> (1,0,0)
                '2':_ -> (0,1,0)
                '3':_ -> (0,0,1)

test :: String -> Int
test s = scan (Ar.listArray (1,length s) s) (1,1) init
    where
        init =
            case s of
                '1':_ -> (1,0,0)
                '2':_ -> (0,1,0)
                '3':_ -> (0,0,1)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

minSize :: String -> (Int, Int, Int, Int)
minSize "" = (10000000, 10000000, 10000000, 10000000)
minSize (c:rest) =
    case c of
        '1' -> (0, f2+1, f3+1, min ans (2 + max f2 f3))
        '2' -> (f1+1, 0, f3+1, min ans (2 + max f1 f3))
        '3' -> (f1+1, f2+1, 0, min ans (2 + max f1 f2))
    where
        (f1,f2,f3, ans) = minSize rest

solve :: String -> Int
solve s
    | ans > 1000000 = 0
    | otherwise     = ans
    where
        (_,_,_,ans) = minSize s

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import Control.Monad
import Data.List

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

routine :: IO ()
routine = do
  s <- getLine
  print $ solve s

solve :: String -> Int
solve s
  | null fs = 0
  | otherwise = minimum $ map (\((a,la),(b,lb),(c,lc)) -> lb + 2 ) fs

  where
    ps = map (\x -> (x,length x)) $ group s
    ts = zip3 ps (tail ps) (tail $ tail $ ps)
    fs = filter (\((a,la),(b,lb),(c,lc)) -> (length $ nub [a,b,c]) == 3) ts

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import Data.Ord (comparing)
import qualified Data.Maybe as Mb

type Long = Int

minSize :: String -> (Int, Int, Int, Int)
minSize "" = (10000000, 10000000, 10000000, 10000000)
minSize (c:rest) =
    case c of
        '1' -> (0, f2+1, f3+1, 1 + min ans (max f2 f3))
        '2' -> (f1+1, 0, f3+1, 1 + min ans (max f1 f3))
        '3' -> (f1+1, f2+1, 0, 1 + min ans (max f1 f2))
    where
        (f1,f2,f3, ans) = minSize rest

solve :: String -> Int
solve s
    | ans > 1000000 = 0
    | otherwise     = ans
    where
        (_,_,_,ans) = minSize s

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    s <- getLine
    print $ solve s
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine


One day mum asked Petya to sort his toys and get rid of some of them. Petya found a whole box of toy spiders. They were quite dear to him and the boy didn't want to throw them away. Petya conjured a cunning plan: he will glue all the spiders together and attach them to the ceiling. Besides, Petya knows that the lower the spiders will hang, the more mum is going to like it and then she won't throw his favourite toys away. Help Petya carry out the plan.A spider consists of k beads tied together by k - 1 threads. Each thread connects two different beads, at that any pair of beads that make up a spider is either directly connected by a thread, or is connected via some chain of threads and beads.Petya may glue spiders together directly gluing their beads. The length of each thread equals 1. The sizes of the beads can be neglected. That's why we can consider that gluing spiders happens by identifying some of the beads (see the picture). Besides, the construction resulting from the gluing process should also represent a spider, that is, it should have the given features. After Petya glues all spiders together, he measures the length of the resulting toy. The distance between a pair of beads is identified as the total length of the threads that connect these two beads. The length of the resulting construction is the largest distance between all pairs of beads. Petya wants to make the spider whose length is as much as possible.    The picture two shows two spiders from the second sample. We can glue to the bead number 2 of the first spider the bead number 1 of the second spider. The threads in the spiders that form the sequence of threads of maximum lengths are highlighted on the picture.

The first input file line contains one integer n (1 ≤ n ≤ 100) — the number of spiders. Next n lines contain the descriptions of each spider: integer ni (2 ≤ ni ≤ 100) — the number of beads, then ni - 1 pairs of numbers denoting the numbers of the beads connected by threads. The beads that make up each spider are numbered from 1 to ni.

Print a single number — the length of the required construction.

import Data.List
import Data.Graph
import Data.Tree

makeG (a:lst) = buildG (1, a) . pair $ lst
	where pair [] = []; pair (a:b:cs) = (a,b) : (b,a) : pair cs

main = do
	input <- fmap lines $ readFile "input.txt"
	let n = read . head $ input
	let trees = map (makeG . map read . words) . take n . tail $ input
	writeFile "output.txt" . (++"\n") . show . sum . (map (\g -> maximum [ length . head . map levels $ dfs g [i] | i <- vertices g ] - 1)) $ trees


It has finally been decided to build a roof over the football field in School 179. Its construction will require placing $$$n$$$ consecutive vertical pillars. Furthermore, the headmaster wants the heights of all the pillars to form a permutation $$$p$$$ of integers from $$$0$$$ to $$$n - 1$$$, where $$$p_i$$$ is the height of the $$$i$$$-th pillar from the left $$$(1 \le i \le n)$$$.As the chief, you know that the cost of construction of consecutive pillars is equal to the maximum value of the bitwise XOR of heights of all pairs of adjacent pillars. In other words, the cost of construction is equal to $$$\max\limits_{1 \le i \le n - 1}{p_i \oplus p_{i + 1}}$$$, where $$$\oplus$$$ denotes the bitwise XOR operation.Find any sequence of pillar heights $$$p$$$ of length $$$n$$$ with the smallest construction cost.In this problem, a permutation is an array consisting of $$$n$$$ distinct integers from $$$0$$$ to $$$n - 1$$$ in arbitrary order. For example, $$$[2,3,1,0,4]$$$ is a permutation, but $$$[1,0,1]$$$ is not a permutation ($$$1$$$ appears twice in the array) and $$$[1,0,3]$$$ is also not a permutation ($$$n=3$$$, but $$$3$$$ is in the array).

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The only line for each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of pillars for the construction of the roof. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print $$$n$$$ integers $$$p_1$$$, $$$p_2$$$, $$$\ldots$$$, $$$p_n$$$ — the sequence of pillar heights with the smallest construction cost. If there are multiple answers, print any of them.

NoteFor $$$n = 2$$$ there are $$$2$$$ sequences of pillar heights:   $$$[0, 1]$$$ — cost of construction is $$$0 \oplus 1 = 1$$$.  $$$[1, 0]$$$ — cost of construction is $$$1 \oplus 0 = 1$$$. For $$$n = 3$$$ there are $$$6$$$ sequences of pillar heights:   $$$[0, 1, 2]$$$ — cost of construction is $$$\max(0 \oplus 1, 1 \oplus 2) = \max(1, 3) = 3$$$.  $$$[0, 2, 1]$$$ — cost of construction is $$$\max(0 \oplus 2, 2 \oplus 1) = \max(2, 3) = 3$$$.  $$$[1, 0, 2]$$$ — cost of construction is $$$\max(1 \oplus 0, 0 \oplus 2) = \max(1, 2) = 2$$$.  $$$[1, 2, 0]$$$ — cost of construction is $$$\max(1 \oplus 2, 2 \oplus 0) = \max(3, 2) = 3$$$.  $$$[2, 0, 1]$$$ — cost of construction is $$$\max(2 \oplus 0, 0 \oplus 1) = \max(2, 1) = 2$$$.  $$$[2, 1, 0]$$$ — cost of construction is $$$\max(2 \oplus 1, 1 \oplus 0) = \max(3, 1) = 3$$$.

import Control.Monad (forM)
import Data.ByteString (intersperse)

solve t = do
  n <- readLn
  let h = foldl (\b x -> if b * 2 <= n - 1 then b * 2 else b) 1 [1..n]
      one = unwords [ show x | x <- [h - 1, h - 2..0]]
      two = unwords [ show x | x <- [h..n - 1]]
  putStrLn $ one ++ " " ++ two

main = do
 tlen <- readLn :: IO Int
 forM [0..(tlen - 1)] (\t -> do solve t)