Emuskald needs a fence around his farm, but he is too lazy to build it himself. So he purchased a fence-building robot.He wants the fence to be a regular polygon. The robot builds the fence along a single path, but it can only make fence corners at a single angle a.Will the robot be able to build the fence Emuskald wants? In other words, is there a regular polygon which angles are equal to a?

The first line of input contains an integer t (0 < t < 180) — the number of tests. Each of the following t lines contains a single integer a (0 < a < 180) — the angle the robot can make corners at measured in degrees.

For each test, output on a single line "YES" (without quotes), if the robot can build a fence Emuskald wants, and "NO" (without quotes), if it is impossible.

NoteIn the first test case, it is impossible to build the fence, since there is no regular polygon with angle .In the second test case, the fence is a regular triangle, and in the last test case — a square.

main=interact$unlines.map (f.read).tail.words
f n
	| n >= 180 = "NO"
	| mod 360 (180-n) == 0 = "YES"
	| otherwise = "NO"

isPolyAngle :: Int -> Bool
isPolyAngle a = mod 360 b == 0
    where b = 180 - a

boolMap :: Bool -> String
boolMap True  = "YES"
boolMap False = "NO"

printList :: [String] -> IO()
printList (a:b) = do
    putStrLn a
    printList b
printList _ = do
    putStr ""

main :: IO()
main = do
    str <- getContents
    let a = map read (words str) :: [Int]
    printList (map (boolMap . isPolyAngle) (tail a))

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

yesno lst oo
  | (null lst) = reverse oo
  | (mod 360 (180 - (head lst))) == 0 = yesno (tail lst) ("YES" : oo)
  | otherwise = yesno (tail lst) ("NO" : oo)

main = do
  ff <- getLine
  let aa = (read ff)::Int
      hh = replicate aa (getLine)
  uu <- sequence hh

  let tests = conv uu []
      ans = yesno tests []

  mapM_ putStrLn ans

  -- putStrLn (show ans)

main = interact $
    unlines . map (s . read) . tail . words
    where
        s n | 360 `mod` (180-n) == 0 = "YES"
            | otherwise = "NO"

main = do
  getLine
  xs <- fmap (map read . lines) getContents

  let
    solve 60 = True
    solve x = 360 `mod` (180-x) == 0

  putStrLn $ unlines $ map (\x -> if x then "YES" else "NO") $ map solve xs

import Control.Monad

main :: IO ()
main = do
    n <- getLine >>= return .read
    replicateM_ n solve

solve :: IO ()
solve = do
    a <- getLine >>= return . read
    putStrLn $ if 360 `mod` (180 - a) == 0 then "YES" else "NO"

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = readLn >>= \ n -> (solve =<< forM [1 .. n] ( \i -> fst.fromJust.C.readInt <$>C.getLine))
solve xs = forM_ xs $ \i-> if 360 `mod` (180-i) == 0 then putStrLn "YES" else putStrLn "NO"

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

main' :: IO ()
main'  =  do
    a  <-  readLn
    putStrLn $ (360 `mod` (180 - a) == 0) ? "YES" $ "NO"

main :: IO ()
main  =  do
    n  <-  readLn
    sequence_ (replicate n main')

main = interact $ unlines . f . lines
f (x:xs) = map (g . read) xs
g x | rem 360 (180-x) == 0 = "YES"
    | otherwise            = "NO"

an = 0 : [180-(360 `div` i) | i <- [1..360]]
main = interact $ unlines . f . lines
f (x:xs) = map (g . read) xs
g x | elem x an && (rem 360 (180-x) == 0) = "YES"
    | otherwise                           = "NO"

import Control.Monad

good :: Int -> Bool
good a = any (\n -> a * n == 180 * (n - 2)) [3..1000]

main = do
    n <- read `fmap` getLine
    a <- sequence $ take n $ repeat $ read `fmap` getLine
    forM a $ \i ->
        putStrLn (if good i
                        then "YES"
                        else "NO")

import Control.Monad (replicateM)

main :: IO ()
main = do
  test_number <- readLn :: IO Int
  angles <-  replicateM test_number readLn :: IO [Int]
  mapM_ (putStrLn . to_string . check) angles
 where
  check :: Int -> Bool
  check x = 360 `mod` (180 - x) == 0
  to_string True = "YES"
  to_string _ = "NO"

import Control.Applicative
import Data.List

lis = [div ((i-2)*180) i  | i<-[3..1000], mod ((i-2)*180) i==0 ]
process s | elem s lis = "YES"
          | otherwise = "NO"

main = do
  getLine
  s<-    map read  <$> lines  <$> getContents ::IO [Int]
  mapM_ putStrLn   $  map process s

main :: IO ()
main = getContents >>= mapM_ (putStrLn . yesno . solve . read) . tail . lines

solve :: Int -> Bool
solve a = 360 `mod` (180 - a) == 0

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

main = interact $ unlines . map (solve . read) . tail . words
solve n | 360 `mod` (180-n) == 0 = "YES"
        | otherwise = "NO"

yes_or_no x = if (360 `mod` (180-x) == 0) && (360 `div` (180-x) > 2) then "YES" else "NO"
mkOut = do
    x <- getLine
    putStrLn(yes_or_no(read x))

n_times x | x > 0 = do mkOut;
                       n_times(x-1)
          | otherwise = putStr ""
main = do
  n_input <- getLine
  n_times(read n_input)

fit a = 360 `mod` (180 - a) == 0

loop 0 = return ()
loop n = do
    a <- getLine
    putStrLn $ if fit (read a :: Int) then "YES" else "NO"
    loop (n-1)

main = do
    n <- getLine
    loop (read n :: Int)

import Control.Applicative
import Control.Monad

ans= [div x n | n<-[3..1000],let x = 180 *(n-2) , (div x n)*n ==x ]

check a | elem a ans = "YES"
	| otherwise = "NO"

main= do
	 getLine
	 s<-map read. words <$> getContents::IO [Int]
	 mapM_ putStrLn $ map check s

import Control.Monad

check a
  | 360 `mod` (180-a) == 0 = True
  | otherwise = False

solve a
  | check a == True = "YES"
  | otherwise = "NO"

solveCase = do
  input <- getLine
  let a = read input :: Int
  putStrLn(solve a)

main = do
  caseNumStr <- getLine
  let t = read caseNumStr :: Int
  replicateM_ t solveCase

main = do
  m <- readLn
  n <- sequence $ replicate m getLine
  let n2 = map read n
  mapM_ putStrLn $ map pol n2
pol :: Int -> String
pol x = if (x `elem` [quot (180 * n) (n+2) | n <- filter (\x -> mod 360 (x+2) == 0) [1..360]]) then "YES" else "NO"

go x
  | k == 0    = "YES"
  | otherwise = "NO"
  where k = mod 360 (180 - x)
solve :: Int -> IO ()
solve 0 = return ()
solve n = do
  readLn >>= putStrLn. go
  solve $ n - 1
main = do
  n <- readLn :: IO Int
  solve n

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = getContents >>= mapM_ putStrLn. map (\x -> if 360 `mod` (180-x) == 0 then "YES" else "NO"). map (\x -> read x :: Int). tail. words

process :: Int -> Bool
process a = 360 `mod` (180-a) == 0

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    as <- fmap (map readInt.words) getContents
    mapM_ putStrLn . map (\a -> ["NO","YES"] !! fromEnum (process a)) $ as

main = interact f
    where f = unlines . map (isFancy.read) . tail . lines

isFancy x = if (360 `mod` (180 - x)) == 0 then "YES" else "NO"

import Data.List as List
import Data.Maybe as Maybe

getStringAfterChar :: Char -> String -> String
getStringAfterChar c str = drop ((Maybe.fromJust $ c `elemIndex` str) + 1) str

isAppropriate :: Int -> Int -> Bool
isAppropriate n angle = 180 * (n - 2) == angle * n

repeatX :: Int -> IO ()
repeatX x
    | x > 0 = do
    	solveCase
    	repeatX $ x - 1
    | otherwise = return ()

solveCase :: IO ()
solveCase = do
	line <- getLine
	let intAngle = read line :: Int
	let floatAngle = fromIntegral intAngle
	let sideNum = round $ 2 / (1 - (floatAngle / 180))
	let result = if isAppropriate sideNum intAngle
		then "YES"
		else "NO"
	putStrLn result

main = do
	line <- getLine
	let testNumber = read line :: Int
	repeatX testNumber

main=interact$unlines.map (f.read).tail.words
f n
	| n >= 180 = "No"
	| mod 360 (180-n) == 0 = "Yes"
	| otherwise = "No"

isPolyAngle :: Int -> Bool
isPolyAngle a = mod 360 b == 0
    where b = 180 - a

boolMap :: Bool -> String
boolMap True  = "YES"
boolMap False = "NO"

printList :: [String] -> IO()
printList (a:b) = do
    putStrLn a
    printList b
printList _ = do
    putStr ""

main :: IO()
main = do
    str <- getContents
    let a = map read (words str) :: [Int]
    printList (map (show . boolMap . isPolyAngle) (tail a))

yes_or_no x = if (360 `mod` (180-x) == 0) && (360 `div` (180-x) > 2) then "YES" else "NO"
mkOut = do
    x <- getLine
    putStrLn(show(yes_or_no(read x)))

n_times x | x > 0 = do mkOut;
                       n_times(x-1)
          | otherwise = putStr ""
main = do
  n_input <- getLine
  n_times(read n_input)

fit a = 360 `mod` (180 - a) == 0

loop 0 = return ()
loop n = do
    a <- getLine
    putStrLn $ if fit (read a :: Int) then "YES" else "NO"

main = do
    n <- getLine
    loop (read n :: Int)

import Control.Monad

check a
  | 360 `mod` (180-a) == 0 = True
  | otherwise = False

solve a
  | check a == True = "YES"
  | otherwise = "No"

solveCase = do
  input <- getLine
  let a = read input :: Int
  putStrLn(solve a)

main = do
  caseNumStr <- getLine
  let t = read caseNumStr :: Int
  replicateM_ t solveCase

main = do
  m <- readLn
  n <- sequence $ replicate m getLine
  let n2 = map read n
  mapM_ putStrLn $ map pol n2
pol :: Int -> String
pol x = if (x `elem` [quot (180 * n) (n+2) | n <- filter (\x -> mod 360 x == 0) [1..360]]) then "YES" else "NO"


You are given $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$. You choose any subset of the given numbers (possibly, none or all numbers) and negate these numbers (i. e. change $$$x \to (-x)$$$). What is the maximum number of different values in the array you can achieve?

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$): the number of test cases. The next lines contain the description of the $$$t$$$ test cases, two lines per a test case. In the first line you are given one integer $$$n$$$ ($$$1 \leq n \leq 100$$$): the number of integers in the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-100 \leq a_i \leq 100$$$).

For each test case, print one integer: the maximum number of different elements in the array that you can achieve negating numbers in the array.

NoteIn the first example we can, for example, negate the first and the last numbers, achieving the array $$$[-1, 1, 2, -2]$$$ with four different values.In the second example all three numbers are already different.In the third example negation does not change anything.

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as M
import Data.ByteString.Builder
import System.IO

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

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

update :: Num a => a -> Maybe a -> Maybe a
update delta value = case value of
  Nothing -> Just delta
  Just x -> Just (x + delta)

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    _ <- getInts
    as <- getInts
    let counts = foldl' (flip $ M.alter $ update 1) M.empty $ map abs as
        result = M.foldl' (\total count -> total + min 2 count) 0 $ M.adjust (const 1) 0 counts
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    a <- map abs <$> getInts n
    let
      cts :: UArray Int Int
      cts = accumArray (+) 0 (0, maximum a) $ zip a (repeat 1)
      cts' = cts // [(0, min 1 (cts ! 0))]
      ans = foldl' (\acc x -> acc + min x 2) 0 $ elems cts'
    pure $ putInts [ans]

type SP = State [P.ByteString]

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

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

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

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

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as M
import Data.ByteString.Builder
import System.IO

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

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

update :: Num a => a -> Maybe a -> Maybe a
update delta value = case value of
  Nothing -> Just delta
  Just x -> Just (x + delta)

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    _ <- getInts
    as <- getInts
    let counts = foldl' (flip $ M.alter $ update 1) M.empty as
        result = M.foldl' (\total count -> total + min 2 count) 0 $ M.adjust (const 1) 0 counts
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output


While Patrick was gone shopping, Spongebob decided to play a little trick on his friend. The naughty Sponge browsed through Patrick's personal stuff and found a sequence a1, a2, ..., am of length m, consisting of integers from 1 to n, not necessarily distinct. Then he picked some sequence f1, f2, ..., fn of length n and for each number ai got number bi = fai. To finish the prank he erased the initial sequence ai.It's hard to express how sad Patrick was when he returned home from shopping! We will just say that Spongebob immediately got really sorry about what he has done and he is now trying to restore the original sequence. Help him do this or determine that this is impossible.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 100 000) — the lengths of sequences fi and bi respectively. The second line contains n integers, determining sequence f1, f2, ..., fn (1 ≤ fi ≤ n). The last line contains m integers, determining sequence b1, b2, ..., bm (1 ≤ bi ≤ n).

Print "Possible" if there is exactly one sequence ai, such that bi = fai for all i from 1 to m. Then print m integers a1, a2, ..., am. If there are multiple suitable sequences ai, print "Ambiguity". If Spongebob has made a mistake in his calculations and no suitable sequence ai exists, print "Impossible".

NoteIn the first sample 3 is replaced by 1 and vice versa, while 2 never changes. The answer exists and is unique.In the second sample all numbers are replaced by 1, so it is impossible to unambiguously restore the original sequence.In the third sample fi ≠ 3 for all i, so no sequence ai transforms into such bi and we can say for sure that Spongebob has made a mistake.

import Control.Applicative
import Data.Array.IArray
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    (n : _ : rest) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let (f, b) = splitAt n rest
    let invf = accumArray (flip (:)) [] (1, n) $ zip f [1 ..]
    either putStrLn ((putStrLn "Possible" >>) . putStrLn . concat . intersperse " " . map show) $ solve b invf

solve :: [Int] -> Array Int [Int] -> Either String [Int]
solve [] _ = Right []
solve (b : bs) invf =
    case invf ! b of
        [a] -> solve bs invf >>= Right . (a :)
        []  -> Left "Impossible"
        _   -> solve bs invf >>= (const $ Left "Ambiguity")

import Control.Applicative
import Data.Array.IArray
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
    (n : _ : rest) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
    let (f, b) = splitAt n rest
    let invf = accumArray (flip (:)) [] (1, n) $ zip f [1 ..]
    either putStrLn ((putStrLn "Possible" >>) . putStrLn . concat . intersperse " " . map show) $ solve b invf

solve :: [Int] -> Array Int [Int] -> Either String [Int]
solve [] _ = Right []
solve (b : bs) invf =
    case invf ! b of
        [a] -> solve bs invf >>= Right . (a :)
        []  -> Left "Impossible"
        _   -> solve bs invf >> Left "Ambiguity"

{-
Codeforces Round #332

Problem 599 B. Spongebob and Joke

@author yamaton
@date 2015-12-01
-}

import Control.Applicative
import Control.Monad
-- import Text.Printf (printf)
import Data.Maybe (fromJust)
-- import qualified Data.Binary as Bin
import qualified Data.ByteString.Char8 as B
-- import qualified Data.ByteString.Lazy as BL
-- import qualified System.IO as IO
import qualified Data.Map.Strict as M
import qualified Data.Set as S

solve :: [Int] -> [Int] -> (String, [Int])
solve fs bs
  | any (`S.notMember` setFs) bs        = ("Impossible", [])
  | length ys /= S.size (S.fromList ys) = ("Ambiguity", [])
  | otherwise                           = ("Possible", recovered)
  where
    setFs = S.fromList fs
    setBs = S.fromList bs
    ys = filter (`S.member` setBs) fs
    invFsPairs = map (\(i, f) -> (f, i)) $ filter (\(_, f) -> f `S.member` setBs) (zip [1..] fs)
    invFsDict = M.fromList invFsPairs
    recovered = map (\i -> fromJust (M.lookup i invFsDict)) bs

main :: IO ()
main = do
    _ <- B.getLine
    fs <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    bs <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    let (msg, lst) = solve fs bs
    putStrLn msg
    if (null lst)
      then return ()
      -- else (B.putStrLn . B.unwords . map (BL.toStrict . Bin.encode)) lst
      else (putStrLn . unwords . map show) lst
    --
    -- IO.hPutStrLn IO.stderr $ printf "xs = %s" (show xs)
    -- IO.hPutStrLn IO.stderr $ printf "result = %d" msg

{-
Codeforces Round #332

Problem 599 B. Spongebob and Joke

@author yamaton
@date 2015-12-01
-}

import Control.Applicative
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (fromJust)
import qualified Data.Binary as Bin
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import qualified System.IO as IO
import qualified Data.Map.Strict as M
import qualified Data.Set as S

solve :: [Int] -> [Int] -> (String, [Int])
solve fs bs
  | any (`S.notMember` setFs) bs        = ("Impossible", [])
  | length ys /= S.size (S.fromList ys) = ("Ambiguity", [])
  | otherwise                           = ("Possible", recovered)
  where
    setFs = S.fromList fs
    setBs = S.fromList bs
    ys = filter (`S.member` setBs) fs
    invFsPairs = map (\(i, f) -> (f, i)) $ filter (\(_, f) -> f `S.member` setBs) (zip [1..] fs)
    invFsDict = M.fromList invFsPairs
    recovered = map (\i -> fromJust (M.lookup i invFsDict)) bs

main :: IO ()
main = do
    _ <- B.getLine
    fs <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    bs <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
    let (msg, lst) = solve fs bs
    putStrLn msg
    if (null lst)
      then return ()
      -- else (B.putStrLn . B.unwords . map (BL.toStrict . Bin.encode)) lst
      else (putStrLn . unwords . map show) lst
    --
    -- IO.hPutStrLn IO.stderr $ printf "xs = %s" (show xs)
    -- IO.hPutStrLn IO.stderr $ printf "result = %d" msg

{-
Codeforces Round #332

Problem 599 B. Spongebob and Joke

@author yamaton
@date 2015-12-01
-}

import Control.Applicative
import Control.Monad
-- import Text.Printf
-- import System.IO (hPutStrLn, stderr)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe (fromJust)

solve :: [Int] -> [Int] -> (String, [Int])
solve fs bs
  | any (`S.notMember` setFs) bs        = ("Impossible", [])
  | length ys /= S.size (S.fromList ys) = ("Ambiguity", [])
  | otherwise                           = ("Possible", recovered)
  where
    setFs = S.fromList fs
    setBs = S.fromList bs
    ys = filter (`S.member` setBs) fs
    invFsPairs = map (\(i, f) -> (f, i)) $ filter (\(_, f) -> f `S.member` setBs) (zip [1..] fs)
    invFsDict = M.fromList invFsPairs
    recovered = map (\i -> fromJust (M.lookup i invFsDict)) bs

main :: IO ()
main = do
    [n, m] <- (map read . words) <$> getLine :: IO [Int]
    fs <- (map read . words) <$> getLine :: IO [Int]
    bs <- (map read . words) <$> getLine :: IO [Int]
    let (msg, lst) = solve fs bs
    putStrLn msg
    if (null lst)
      then return ()
      else ((putStrLn . unwords . map show) lst)
    --
    -- hPutStrLn stderr $ printf "xs = %s" (show xs)
    -- hPutStrLn stderr $ printf "result = %d" msg


One day Alex decided to remember childhood when computers were not too powerful and lots of people played only default games. Alex enjoyed playing Minesweeper that time. He imagined that he saved world from bombs planted by terrorists, but he rarely won.Alex has grown up since then, so he easily wins the most difficult levels. This quickly bored him, and he thought: what if the computer gave him invalid fields in the childhood and Alex could not win because of it?He needs your help to check it.A Minesweeper field is a rectangle $$$n \times m$$$, where each cell is either empty, or contains a digit from $$$1$$$ to $$$8$$$, or a bomb. The field is valid if for each cell:   if there is a digit $$$k$$$ in the cell, then exactly $$$k$$$ neighboring cells have bombs.  if the cell is empty, then all neighboring cells have no bombs. Two cells are neighbors if they have a common side or a corner (i. e. a cell has at most $$$8$$$ neighboring cells).

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 100$$$) — the sizes of the field. The next $$$n$$$ lines contain the description of the field. Each line contains $$$m$$$ characters, each of them is "." (if this cell is empty), "*" (if there is bomb in this cell), or a digit from $$$1$$$ to $$$8$$$, inclusive.

Print "YES", if the field is valid and "NO" otherwise. You can choose the case (lower or upper) for each letter arbitrarily.

NoteIn the second example the answer is "NO" because, if the positions of the bombs are preserved, the first line of the field should be *2*1.You can read more about Minesweeper in Wikipedia's article.

{-# Language BangPatterns, ViewPatterns #-}
import Control.DeepSeq
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map as Map

main = do
    [n, m] <- fmap (map readInt . words) $ getLine
    board <- fmap (parseInput n m) $ getContents
    putStrLn $ solve n m board

solve n m board
    | result == True = "YES"
    | result == False = "NO"
    where
        result = and $ map (uncurry isGood) $ zip expected actual

        expected = map neighbors $ Map.keys board
        actual = Map.elems board
        isGood a '*' = True
        isGood a '.' = a == '0'
        isGood a b = a == b

        neighbors (a,b) = intToDigit $ length $ do
            x <- [a-1..a+1]
            y <- [b-1..b+1]
            guard $ (x,y) /= (a,b)
            guard $ (fromMaybe '0' $ Map.lookup (x,y) board) == '*'
            return 1

parseInput n m x = Map.fromList $ concat $ map (uncurry zip) $ zip grid $ lines x
    where
        grid = [[(x,y) | y <- [1..m]] | x <- [1..n]]

readInt x = (read x) :: Int

import Data.List
import Data.List.Split
import Data.Char

type Grid a = [[a]]

main :: IO ()
main = do
    content <- getContents
    let ls = lines content
        n_m :: [Int]
        n_m = map read $ splitOn " " $ head ls
        grid = tail ls
        grid_sum = gridSum grid
        resultPair = zipWith zip grid_sum grid
        pass = all checkValid resultPair
    --putStrLn.unlines $ map (concat.(map show)) $ grid_sum
    if pass then
        putStrLn "YES"
    else
        putStrLn "NO"

checkValid :: [(Int,Char)] -> Bool
checkValid = all pairValid
pairValid :: (Int,Char) -> Bool
pairValid (0,'.') = True
pairValid (_,'*') = True
pairValid (x,y) = x + (ord '0') == ord y

gridSum grid =
    let x = length grid
        y = length $ head grid
        boardCore =(map.map) (\ch -> if ch== '*' then 1::Int else 0::Int) grid
        boardShifts = [gridShift boardCore p | p <- nearCoords]
        zeroGrid = take (x+2) . repeat $ take (y+2) . repeat $ (0::Int)
        boardSum = init.tail $ foldr ((zipWith.zipWith) (+)) zeroGrid boardShifts
    in map (init.tail) boardSum

nearCoords :: [(Int,Int)]
nearCoords = [(1,0)
             ,(1,1)
             ,(0,1)
             ,(-1,1)
             ,(-1,0)
             ,(-1,-1)
             ,(0,-1)
             ,(1,-1)
             ]

gridShift :: Grid Int -> (Int, Int) -> Grid Int
gridShift grid _ | length grid == 0 = []
gridShift _ (x,y) | not.elem (x,y) $ nearCoords = []
gridShift gridCore (x,y) =
    let --oldx = length grid
        oldy = length.head $ gridCore
        rowUp = 1 + x
        rowDown = 1 - x
        colLeft = 1 + y
        colRight = 1 - y
        row_Up = take rowUp . repeat $ take (oldy + 2) . repeat $ (0::Int)
        row_Down = take rowDown . repeat $ take (oldy + 2) . repeat $ (0::Int)
        col_Left = take colLeft $ repeat (0::Int)
        col_Right = take colRight $ repeat (0::Int)
    in  row_Up
        ++  (map (\line -> col_Left ++ line ++ col_Right) gridCore)
        ++ row_Down

import Data.Char
import Data.List
import Data.Array

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

gets :: (Int, Int) -> IO [String]
gets (n, m) = mapM _getLine [0 .. n - 1]
  where
    _getLine :: Int -> IO String
    _getLine a = getLine

filterStar :: [String] -> [String]
filterStar = map (map replace)
  where
    replace '*' = '*'
    replace  _  = '.'

count :: Char -> [Char] -> Int
count a b = sum $ map check b
  where
    check x
      | x == a    = 1
      | otherwise = 0

toChar :: Int -> Char
toChar 0 = '.'
toChar a = chr (ord '0' + a)

calculate :: (Int, Int) -> [String] -> [String]
calculate (n, m) a =
  map update [0 .. n - 1]
  where
    update i = map (w i) [0 .. m - 1]
    w i j
      | index (i, j) == '*' = '*'
      | otherwise = toChar $ count '*' (map index [(i + x, j + y) | x <- [-1 .. 1], y <- [-1 .. 1]])
    index (u, v)
      | u == -1 || u == n = ' '
      | v == -1 || v == m = ' '
      | otherwise = a !! u !! v

infix 4 <?>
(<?>) :: a -> a -> Bool -> a
a <?> b = \i -> if i then a
                     else b

main :: IO ()
main = do
  firstLine <- getLine
  let [n, m] = numbers firstLine
  res <- gets (n, m)
  putStrLn $ ("YES" <?> "NO") $ (== res) $ calculate (n, m) $ filterStar res

import Data.Char
import Data.List
import Data.Array

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

gets :: Int -> IO [String]
gets n = mapM (\i -> getLine) [0 .. n - 1]

count :: Char -> [Char] -> Int
count a b = sum $ map check b
  where
    check x
      | x == a    = 1
      | otherwise = 0

toChar :: Int -> Char
toChar 0 = '.'
toChar a = chr (ord '0' + a)

calculate :: (Int, Int) -> [String] -> [String]
calculate (n, m) a =
  map update [0 .. n - 1]
  where
    update i = map (w i) [0 .. m - 1]
    w i j
      | index (i, j) == '*' = '*'
      | otherwise = toChar $ count '*' (map index [(i + x, j + y) | x <- [-1 .. 1], y <- [-1 .. 1]])
    index (u, v)
      | u == -1 || u == n = ' '
      | v == -1 || v == m = ' '
      | otherwise = a !! u !! v

infix 4 ??
(??) :: a -> a -> Bool -> a
a ?? b = \i -> if i then a
                     else b

main :: IO ()
main = do
  firstLine <- getLine
  let [n, m] = numbers firstLine
  input <- gets n
  putStrLn . ("YES" ?? "NO") . (== input) . calculate (n, m) $ input

{-# Language BangPatterns, ViewPatterns #-}
import Control.DeepSeq
import Control.Monad
import Control.Applicative
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map as Map

main = do
    [n, m] <- fmap (map readInt . words) $ getLine
    board <- fmap (parseInput n m) $ getContents
    putStrLn $ solve n m board

solve n m board
    | result == True = "YES"
    | result == False = "NO"
    where
        result = and $ isGood <$> expected <*> actual

        expected = map neighbors $ Map.keys board
        actual = Map.elems board
        isGood a '*' = True
        isGood a '.' = a == '0'
        isGood a b = a == b

        neighbors (a,b) = intToDigit $ length $ do
            x <- [a-1..a+1]
            y <- [b-1..b+1]
            guard $ (fromMaybe '0' $ Map.lookup (x,y) board) == '*'
            return 1

parseInput n m x = Map.fromList $ concat $ map (uncurry zip) $ zip grid $ lines x
    where
        grid = [[(x,y) | y <- [1..m]] | x <- [1..n]]

readInt x = (read x) :: Int

import Data.List
import Data.List.Split
import Data.Char

type Grid a = [[a]]

main :: IO ()
main = do
    content <- getContents
    let ls = lines content
        n_m :: [Int]
        n_m = map read $ splitOn " " $ head ls
        grid = tail ls
        grid_sum = gridSum grid
        resultPair = zipWith zip grid_sum grid
        pass = all checkValid resultPair
    putStrLn.unlines $ map (concat.(map show)) $ grid_sum
    if pass then
        putStrLn "YES"
    else
        putStrLn "NO"

checkValid :: [(Int,Char)] -> Bool
checkValid = all pairValid
pairValid :: (Int,Char) -> Bool
pairValid (0,'.') = True
pairValid (_,'*') = True
pairValid (x,y) = x + (ord '0') == ord y

gridSum grid =
    let x = length grid
        y = length $ head grid
        boardCore =(map.map) (\ch -> if ch== '*' then 1::Int else 0::Int) grid
        boardShifts = [gridShift boardCore p | p <- nearCoords]
        zeroGrid = take (x+2) . repeat $ take (y+2) . repeat $ (0::Int)
        boardSum = init.tail $ foldr ((zipWith.zipWith) (+)) zeroGrid boardShifts
    in map (init.tail) boardSum

nearCoords :: [(Int,Int)]
nearCoords = [(1,0)
             ,(1,1)
             ,(0,1)
             ,(-1,1)
             ,(-1,0)
             ,(-1,-1)
             ,(0,-1)
             ,(1,-1)
             ]

gridShift :: Grid Int -> (Int, Int) -> Grid Int
gridShift grid _ | length grid == 0 = []
gridShift _ (x,y) | not.elem (x,y) $ nearCoords = []
gridShift gridCore (x,y) =
    let --oldx = length grid
        oldy = length.head $ gridCore
        rowUp = 1 + x
        rowDown = 1 - x
        colLeft = 1 + y
        colRight = 1 - y
        row_Up = take rowUp . repeat $ take (oldy + 2) . repeat $ (0::Int)
        row_Down = take rowDown . repeat $ take (oldy + 2) . repeat $ (0::Int)
        col_Left = take colLeft $ repeat (0::Int)
        col_Right = take colRight $ repeat (0::Int)
    in  row_Up
        ++  (map (\line -> col_Left ++ line ++ col_Right) gridCore)
        ++ row_Down

import Data.Char
import Data.List
import Data.Array

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

gets :: (Int, Int) -> IO [String]
gets (n, m) = mapM _getLine [0 .. n - 1]
  where
    _getLine :: Int -> IO String
    _getLine a = getLine

filterStar :: [String] -> [String]
filterStar = map (map replace)
  where
    replace '*' = '*'
    replace  _  = '.'

count :: Char -> [Char] -> Int
count a b = sum $ map check b
  where
    check x
      | x == a    = 1
      | otherwise = 0

toChar :: Int -> Char
toChar a = chr (ord '0' + a)

calculate :: (Int, Int) -> [String] -> [String]
calculate (n, m) a =
  map update [0 .. n - 1]
  where
    update i = map (w i) [0 .. m - 1]
    w i j
      | index (i, j) == '*' = '*'
      | otherwise = toChar $ count '*' (map index [(i + x, j + y) | x <- [-1 .. 1], y <- [-1 .. 1]])
    index (u, v)
      | u == -1 || u == n = ' '
      | v == -1 || v == m = ' '
      | otherwise = a !! u !! v

infix 4 <?>
(<?>) :: a -> a -> Bool -> a
a <?> b = \i -> if i then a
                     else b

main :: IO ()
main = do
  firstLine <- getLine
  let [n, m] = numbers firstLine
  res <- gets (n, m)
  putStrLn $ ("YES" <?> "NO") $ (== res) $ calculate (n, m) $ filterStar res


A bitstring is a string that contains only the characters 0 and 1.Koyomi Kanou is working hard towards her dream of becoming a writer. To practice, she decided to participate in the Binary Novel Writing Contest. The writing prompt for the contest consists of three bitstrings of length $$$2n$$$. A valid novel for the contest is a bitstring of length at most $$$3n$$$ that contains at least two of the three given strings as subsequences.Koyomi has just received the three prompt strings from the contest organizers. Help her write a valid novel for the contest.A string $$$a$$$ is a subsequence of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero) characters.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). Each of the following three lines contains a bitstring of length $$$2n$$$. It is guaranteed that these three strings are pairwise distinct. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$10^5$$$.

For each test case, print a single line containing a bitstring of length at most $$$3n$$$ that has at least two of the given bitstrings as subsequences. It can be proven that under the constraints of the problem, such a bitstring always exists. If there are multiple possible answers, you may output any of them.

NoteIn the first test case, the bitstrings 00 and 01 are subsequences of the output string: 010 and 010. Note that 11 is not a subsequence of the output string, but this is not required.In the second test case all three input strings are subsequences of the output string: 011001010, 011001010 and 011001010.

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x

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

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

mergeWith :: Char -> (B8.ByteString, B8.ByteString) -> B8.ByteString
mergeWith c (a, b) =
        B8.pack $ traceMerge' (trim' $ B8.unpack a) (trim' $ B8.unpack b)
    where
        trim' :: String -> String
        trim' = filter (not . isSpace)

        traceMerge' :: String -> String -> String
        traceMerge' a b = r --debug r ("merge' " ++ show a ++ ", " ++ show b ++ " -> " ++ show r)
            where r = merge' a b

        merge' :: String -> String -> String
        merge' [] b = b
        merge' a [] = a
        merge' a@(ca : restA) b@(cb : restB)
            | ca == cb   = ca : traceMerge' restA restB
            | ca == c    = cb : traceMerge' a restB
            | cb == c    = ca : traceMerge' restA b

solve :: Int -> [B8.ByteString] -> B8.ByteString
solve n ss =
    if length with0 >= 2
        then mergeWith '0' (with0 !! 0, with0 !! 1)
        else mergeWith '1' (with1 !! 0, with1 !! 1)
    where
        with0 = filter (\s -> B8.count '0' s >= n) ss
        with1 = filter (\s -> B8.count '1' s >= n) ss

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        n <- B8.getLine <&> readIntB8
        ss <- forM [1..3] . const $ B8.getLine
        let answer = solve n ss
        B8.putStrLn answer

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    ss <- replicateM 3 $ (take (2 * n) . C.unpack) <$> C.getLine
    let cs = [let (as, bs) = partition (== '0') str in (length as, length bs) | str <- ss]
        tt = length [() | (c0, c1) <- cs, c0 <= c1] >= 2
        cmp ((c0, c1), _) ((c0', c1'), _) = if tt then compare c0 c0' else compare c1 c1'
        (s1 : s2 : _) = map snd $ sortBy cmp $ filter (\((c0, c1), _) -> (c0 <= c1) == tt) $ zip cs ss
        (cc, ct) = (if tt then id else swap) ('0', '1')
        calc [] = []
        calc (_ : xs) = let (ls, rs) = span (== cc) xs in length ls : calc rs
        func xs [] = concat [ct : replicate x cc | x <- xs]
        func (x : xs) (y : ys) = ct : replicate (max x y) cc ++ func xs ys
        result = tail $ func (calc (ct : s1)) (calc (ct : s2))
    C.putStrLn $ C.pack result

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import Debug.Trace (trace, traceM, traceShowM)
debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x

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

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

mergeWith :: Char -> (B8.ByteString, B8.ByteString) -> B8.ByteString
mergeWith c (a, b) =
        B8.pack $ traceMerge' (B8.unpack a) (B8.unpack b)
    where
        traceMerge' :: String -> String -> String
        traceMerge' a b = r --debug r ("merge' " ++ show a ++ ", " ++ show b ++ " -> " ++ show r)
            where r = merge' a b

        merge' :: String -> String -> String
        merge' [] b = b
        merge' a [] = a
        merge' a@(ca : restA) b@(cb : restB)
            | ca == cb   = ca : traceMerge' restA restB
            | ca == c    = cb : traceMerge' a restB
            | cb == c    = ca : traceMerge' restA b

solve :: Int -> [B8.ByteString] -> B8.ByteString
solve n ss =
    if length with0 >= 2
        then mergeWith '0' (with0 !! 0, with0 !! 1)
        else mergeWith '1' (with1 !! 0, with1 !! 1)
    where
        with0 = filter (\s -> B8.count '0' s >= n) ss
        with1 = filter (\s -> B8.count '1' s >= n) ss

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1..t] $ \_ -> do
        n <- B8.getLine <&> readIntB8
        ss <- forM [1..3] $ const B8.getLine
        let answer = solve n ss
        B8.putStrLn answer


You are given an array $$$a$$$ of $$$n$$$ elements. Your can perform the following operation no more than $$$n$$$ times: Select three indices $$$x,y,z$$$ $$$(1 \leq x < y < z \leq n)$$$ and replace $$$a_x$$$ with $$$a_y - a_z$$$. After the operation, $$$|a_x|$$$ need to be less than $$$10^{18}$$$.Your goal is to make the resulting array non-decreasing. If there are multiple solutions, you can output any. If it is impossible to achieve, you should report it as well.

Each test contains multiple test cases. The first line will contain a single integer $$$t$$$ $$$(1 \leq t \leq 10000)$$$ — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ $$$(3 \leq n \leq 2 \cdot 10^5)$$$ — the size of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots ,a_n$$$ $$$(-10^9 \leq a_i \leq 10^9)$$$, the elements of $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print $$$-1$$$ in a single line if there is no solution. Otherwise in the first line you should print a single integer $$$m$$$ $$$(0 \leq m \leq n)$$$ — number of operations you performed. Then the $$$i$$$-th of the following $$$m$$$ lines should contain three integers $$$x,y,z$$$ $$$(1 \leq x < y < z \leq n)$$$— description of the $$$i$$$-th operation. If there are multiple solutions, you can output any. Note that you don't have to minimize the number of operations in this task.

NoteIn the first example, the array becomes $$$[-6,-4,2,-1,2]$$$ after the first operation,$$$[-6,-4,-3,-1,2]$$$ after the second operation.In the second example, it is impossible to make the array sorted after any sequence of operations.In the third example, the array is already sorted, so we don't need to perform any operations.

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      [y, z] = drop (n-2) a
      isIncr = and $ zipWith (<=) a (tail a)
    pure $ if  isIncr
      then  putInts [0]
      else  if  y > z || z < 0
      then  putInts [-1]
      else  putInts [n-2] <> foldMap putInts [[i, n-1, n] | i <- [1 .. n-2]]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      [y, z] = drop (n-2) a
      isIncr = and $ zipWith (<=) a (tail a)
    pure $ if  y > z || (z < 0 && not isIncr)
      then  putInts [-1]
      else  putInts [n-2] <> foldMap putInts [[i, n-1, n] | i <- [1 .. n-2]]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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


There is a long plate s containing n digits. Iahub wants to delete some digits (possibly none, but he is not allowed to delete all the digits) to form his "magic number" on the plate, a number that is divisible by 5. Note that, the resulting number may contain leading zeros.Now Iahub wants to count the number of ways he can obtain magic number, modulo 1000000007 (109 + 7). Two ways are different, if the set of deleted positions in s differs.Look at the input part of the statement, s is given in a special form.

In the first line you're given a string a (1 ≤ |a| ≤ 105), containing digits only. In the second line you're given an integer k (1 ≤ k ≤ 109). The plate s is formed by concatenating k copies of a together. That is n = |a|·k.

Print a single integer — the required number of ways modulo 1000000007 (109 + 7).

NoteIn the first case, there are four possible ways to make a number that is divisible by 5: 5, 15, 25 and 125.In the second case, remember to concatenate the copies of a. The actual plate is 1399013990.In the third case, except deleting all digits, any choice will do. Therefore there are 26 - 1 = 63 possible ways to delete digits.

import Data.Char
import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as C

newtype MInt = MInt Int64

m :: Int64
m = 1000000007

instance Show MInt where
  show (MInt a) = show a

instance Num MInt where
  (+) (MInt a) (MInt b) = MInt $ let c = a + b in if c >= m then c - m else c
  (-) (MInt a) (MInt b) = MInt $ let c = a - b in if c < 0 then c + m else c
  (*) (MInt a) (MInt b) = MInt $ a * b `rem` m
  abs                   = id
  signum (MInt a)       = MInt $ signum a
  fromInteger a         = MInt $ fromInteger $ a `mod` toInteger m

powSum :: (Num a, Integral b) => a -> b -> a
powSum a b
  | b == 0    = 0
  | odd b     = 1 + a * powSum a (b - 1)
  | otherwise = let b' = b `quot` 2 in (1 + a ^ b') * powSum a b'

main :: IO ()
main = do
  s <- fmap (C.filter isDigit) C.getLine
  k <- fmap (fst . fromJust . C.readInt) C.getLine
  let x = sum [b | (a, b) <- zip (C.unpack s) $ iterate (*2) 1, a == '0' || a == '5']
      y = powSum (2^C.length s) k
  print $ (x * y :: MInt)

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

newtype IntMod = IntMod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (IntMod x) = show x

instance Num IntMod where
  (IntMod x) + (IntMod y) = case x + y of
                              xy | xy < MOD -> IntMod xy
                                 | otherwise -> IntMod $ xy - MOD
  (IntMod x) - (IntMod y) = case x - y of
                              xy | xy >= 0 -> IntMod xy
                                 | otherwise -> IntMod $ xy + MOD
  (IntMod x) * (IntMod y) = IntMod $ x * y `rem` MOD
  abs _ = undefined
  signum _ = undefined
  fromInteger x = IntMod $ fromInteger x

instance Fractional IntMod where
  (IntMod x) / (IntMod y) = IntMod $ x * fst (extGcd y MOD) `mod` MOD
  fromRational q = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (0 :: IntMod) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

modulus :: Int64
modulus = 1000000007

newtype IntMod = Mod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (Mod x) = show x

instance Num IntMod where
  (Mod x) + (Mod y) = case x + y of
                        xy | xy < modulus -> Mod xy
                           | otherwise    -> Mod $ xy - modulus
  (Mod x) - (Mod y) = case x - y of
                        xy | xy >= 0   -> Mod xy
                           | otherwise -> Mod $ xy + modulus
  (Mod x) * (Mod y) = Mod $ x * y `rem` modulus
  abs _ = undefined
  signum _ = undefined
  fromInteger x = Mod $ fromInteger x `mod` modulus

instance Fractional IntMod where
  (Mod x) / (Mod y) = Mod $ x * fst (extGcd y modulus) `mod` modulus
  fromRational _ = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (Mod 0) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

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

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

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

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

type IntMod = Int

infixr 8  ^%
infixl 7  *%, /%
infixl 6  +%, -%

(+%) :: IntMod -> IntMod -> IntMod
x +% y = case x+y of
           xy | xy < MOD -> xy
              | otherwise -> xy - MOD
{-# INLINE (+%) #-}

(-%) :: IntMod -> IntMod -> IntMod
x -% y = case x-y of
           xy | xy >= 0   -> xy
              | otherwise -> xy + MOD
{-# INLINE (-%) #-}

(*%) :: IntMod -> IntMod -> IntMod
x *% y = fromInteger $ toInteger x * toInteger y `rem` MOD
{-# INLINE (*%) #-}

(/%) :: IntMod -> IntMod -> IntMod
x /% y = x *% (fst (extGcd y MOD) `mod` MOD)
{-# INLINE (/%) #-}

(^%) :: IntMod -> IntMod -> IntMod
x ^% 0 = 1
x ^% y = f (toInteger x) y
   where
     f !x !y
       | even y    = f (x * x `rem` MOD) (y .>>. 1)
       | y == 1    = fromIntegral $ x `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) x
     g !x !y !z
       | even y    = g (x * x `rem` MOD) (y .>>. 1) z
       | y == 1    = fromIntegral $ x * z `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) (x * z `rem` MOD)

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+%) 0 (map (2^%) xs) *% (((2^%l)^%k-%1)/%(2^%l-%1))

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

modulus :: Int64
modulus = 1000000007
{-# INLINE modulus #-}

newtype IntMod = Mod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (Mod x) = show x

instance Num IntMod where
  (Mod x) + (Mod y) = case x + y of
                        xy | xy < modulus -> Mod xy
                           | otherwise    -> Mod $ xy - modulus
  (Mod x) - (Mod y) = case x - y of
                        xy | xy >= 0   -> Mod xy
                           | otherwise -> Mod $ xy + modulus
  (Mod x) * (Mod y) = Mod $ x * y `rem` modulus
  abs _ = undefined
  signum _ = undefined
  fromInteger x = Mod $ fromInteger x `mod` modulus

instance Fractional IntMod where
  (Mod x) / (Mod y) = Mod $ x * fst (extGcd y modulus) `mod` modulus
  fromRational _ = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (Mod 0) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

import GHC.Int (Int64(..))
import GHC.IntWord64 (timesInt64#, remInt64#)

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

modulus :: Int64
modulus = 1000000007
{-# INLINE modulus #-}

newtype IntMod = Mod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (Mod x) = show x

instance Num IntMod where
  (Mod x) + (Mod y) = case x + y of
                        xy | xy < modulus -> Mod xy
                           | otherwise    -> Mod $ xy - modulus
  (Mod x) - (Mod y) = case x - y of
                        xy | xy >= 0   -> Mod xy
                           | otherwise -> Mod $ xy + modulus
  (Mod (I64# x#)) * (Mod (I64# y#)) = case modulus of
                                        (I64# m#) -> Mod $ I64# (x# `timesInt64#` y# `remInt64#` m#)
  abs _ = undefined
  signum _ = undefined
  fromInteger x = Mod $ fromInteger x `mod` modulus

instance Fractional IntMod where
  (Mod x) / (Mod y) = Mod $ x * fst (extGcd y modulus) `mod` modulus
  fromRational _ = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (Mod 0) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

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

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

type IntMod = Int64

infixr 8  ^%
infixl 7  *%, /%
infixl 6  +%, -%

(+%) :: IntMod -> IntMod -> IntMod
x +% y = case x+y of
           xy | xy < MOD -> xy
              | otherwise -> xy - MOD
{-# INLINE (+%) #-}

(-%) :: IntMod -> IntMod -> IntMod
x -% y = case x-y of
           xy | xy >= 0   -> xy
              | otherwise -> xy + MOD
{-# INLINE (-%) #-}

(*%) :: IntMod -> IntMod -> IntMod
x *% y = x * y `rem` MOD
{-# INLINE (*%) #-}

(/%) :: IntMod -> IntMod -> IntMod
x /% y = x *% (fst (extGcd y MOD) `mod` MOD)
{-# INLINE (/%) #-}

(^%) :: IntMod -> Int -> IntMod
x ^% 0 = 1
x ^% y = f (toInteger x) y
   where
     f !x !y
       | even y    = f (x * x `rem` MOD) (y .>>. 1)
       | y == 1    = fromIntegral $ x `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) x
     g !x !y !z
       | even y    = g (x * x `rem` MOD) (y .>>. 1) z
       | y == 1    = fromIntegral $ x * z `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) (x * z `rem` MOD)

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+%) 0 (map (2^%) xs) *% (((2^%l)^%k-%1)/%(2^%l-%1))

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int
import Unsafe.Coerce

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

newtype IntMod = IntMod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (IntMod x) = show x

instance Num IntMod where
  (IntMod x) + (IntMod y) = case x + y of
                              xy | xy < MOD  -> unsafeCoerce xy
                                 | otherwise -> unsafeCoerce $ xy - MOD
  (IntMod x) - (IntMod y) = case x - y of
                              xy | xy >= 0   -> unsafeCoerce xy
                                 | otherwise -> unsafeCoerce $ xy + MOD
  (IntMod x) * (IntMod y) = unsafeCoerce $ x * y `rem` MOD
  abs _ = undefined
  signum _ = undefined
  fromInteger x = IntMod $ fromInteger x `mod` MOD

instance Fractional IntMod where
  (IntMod x) / (IntMod y) = unsafeCoerce $ x * fst (extGcd y MOD) `mod` MOD
  fromRational _ = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (IntMod 0) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Maybe
import Data.Int (Int64)
import Debug.Trace
import qualified Data.ByteString.Char8 as C

readInt :: Integral a => C.ByteString -> a
readInt = fromIntegral . fst . fromJust . C.readInt

getInts :: IO [Int64]
getInts = map readInt . C.words <$> C.getLine

getInt :: IO Int64
getInt = readInt <$> C.getLine

newtype Mint = Mint Int64

mymod :: Int64
mymod = 1000000007

instance Show Mint where
  show (Mint a) = show a

instance Num Mint where
  (+) (Mint a) (Mint b) = Mint $ let c = a + b in if c >= mymod then c - mymod else c
  (-) (Mint a) (Mint b) = Mint $ let c = a - b in if c < 0 then c + mymod else c
  (*) (Mint a) (Mint b) = Mint $ a * b `rem` mymod
  abs                   = id
  signum (Mint a)       = Mint $ signum a
  fromInteger a         = Mint $ fromInteger $ a `mod` toInteger mymod

myDiv :: Mint -> Mint -> Mint
myDiv (Mint a) (Mint b) = Mint $ (if odd a then (a-1) else a) `div` b

powMod :: Mint -> Mint -> Mint
powMod _ (Mint 0) = Mint 1
powMod p n@(Mint t)
  | odd t = p * tmp
  | otherwise = tmp
  where
  tmp = powMod (p * p) (n `myDiv` (Mint 2))

main :: IO ()
main = do
  n <- getLine
  k <- getInt
  let len = fromIntegral $ length n
      n' = [(Mint i) | (i,x) <- zip [0..] n, x == '5' || x == '0']
      d = powMod (Mint 2) $ Mint len
      x = (powMod d (Mint k)) - (Mint 1)
      x' = x * (powMod (d-(Mint 1)) $ Mint $ mymod - 2)
  --putStrLn $ show n''
  print $ x' * foldl (\t x -> t + (powMod (Mint 2) x)) (Mint 0) n'

module Main where

ch2int c
    | c == '1' = 1
    | c == '2' = 2
    | c == '3' = 3
    | c == '4' = 4
    | c == '5' = 5
    | c == '6' = 6
    | c == '7' = 7
    | c == '8' = 8
    | c == '9' = 9
    | otherwise = 0

str2int [] = 0
str2int s = (str2int (init s)) * 10 + (ch2int (last s))

mod_exp a n m = exp n
    where exp n = if n == 0
            then 1
            else
                let b = exp (div n 2)
                    c = mod (b * b) m
                in  if mod n 2 == 0
                    then c
                    else mod (a * c) m

pow_sum a n m = ps n
    where ps n = if n == 0
            then 1
            else if mod n 2 == 0
                 then mod (1 + a * ps (n - 1)) m
                 else let k = div n 2
                      in  mod ((1 + (mod_exp a (k + 1) m)) * (ps k)) m

sub [] = [[]]
sub (x:y) =
    let w = sub y
    in  w ++ [x:z | z <- w]
-- magic seq = length [s | s <- sub seq, length s > 0, last s == '5' || last s == '0']

magic seq =
    mod (sum (map f (zip seq [0..]))) 1000000007
        where f (c, i) = if c == '0' || c == '5'
                then mod_exp 2 i 1000000007
                else 0

solve str k =
    mod ((pow_sum a (k - 1) 1000000007) * q) 1000000007
        where
            n = length str
            q = (magic str)
            a = mod (mod_exp 2 n 1000000007) 1000000007

main = do
    str <- getLine
    line <- getLine
    print $ solve str (str2int line)

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Bits
import Data.Int

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

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Int64 -> Int64 -> (Int64, Int64) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

newtype IntMod = IntMod Int64 deriving (Eq, Ord)

instance Show IntMod where
  show (IntMod x) = show x

instance Num IntMod where
  (IntMod x) + (IntMod y) = case x + y of
                              xy | xy < MOD -> IntMod xy
                                 | otherwise -> IntMod $ xy - MOD
  (IntMod x) - (IntMod y) = case x - y of
                              xy | xy >= 0 -> IntMod xy
                                 | otherwise -> IntMod $ xy + MOD
  (IntMod x) * (IntMod y) = IntMod $ x * y `rem` MOD
  abs _ = undefined
  signum _ = undefined
  fromInteger x = IntMod $ fromInteger x

instance Fractional IntMod where
  (IntMod x) / (IntMod y) = IntMod $ x * (fst (extGcd y MOD) `mod` MOD)
  fromRational q = undefined

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+) (0 :: IntMod) (map (2^) xs) * (((2^l)^k-1)/(2^l-1))

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

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

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

infixl 8 .<<. , .>>.
(.<<.), (.>>.) :: (Bits a, Num a) => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR
{-# INLINE (.<<.) #-}
{-# INLINE (.>>.) #-}

extGcd :: (Integral a) => a -> a -> (a, a)
extGcd !a !b
  | b == 0    = (1, 0)
  | otherwise = (t, s - a `div` b * t)
   where
     (!s, !t) = extGcd b $ a `mod` b
{-# SPECIALISE extGcd :: Int -> Int -> (Int, Int) #-}
{-# SPECIALISE extGcd :: Integer -> Integer -> (Integer, Integer) #-}

#define MOD 1000000007

type IntMod = Int

infixr 8  ^%
infixl 7  *%, /%
infixl 6  +%, -%

(+%) :: IntMod -> IntMod -> IntMod
x +% y = case x+y of
           xy | xy < MOD -> xy
              | otherwise -> xy - MOD
{-# INLINE (+%) #-}

(-%) :: IntMod -> IntMod -> IntMod
x -% y = case x-y of
           xy | xy >= 0   -> xy
              | otherwise -> xy + MOD
{-# INLINE (-%) #-}

(*%) :: IntMod -> IntMod -> IntMod
x *% y = fromInteger $ toInteger x * toInteger y `rem` MOD
{-# INLINE (*%) #-}

(/%) :: IntMod -> IntMod -> IntMod
x /% y = x *% (fst (extGcd y MOD) `mod` MOD)
{-# INLINE (/%) #-}

(^%) :: IntMod -> IntMod -> IntMod
x ^% 0 = 1
x ^% y = f (toInteger x) y
   where
     f !x !y
       | even y    = f (x * x `rem` MOD) (y .>>. 1)
       | y == 1    = fromIntegral $ x `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) x
     g !x !y !z
       | even y    = g (x * x `rem` MOD) (y .>>. 1) z
       | y == 1    = fromIntegral $ x * z `rem` MOD
       | otherwise = g (x * x `rem` MOD) ((y-1) .>>. 1) (x * z `rem` MOD)

main :: IO ()
main = do
  [bs,kbs] <- B.lines <$> B.getContents
  let xs = B.findIndices (\c->c=='0'||c=='5') bs
      k = readInt kbs
      l = B.length bs - 1
  print $ foldl' (+%) 0 (map (2^%) xs) *% ((2^%(k*%l)-%1)/%(2^%l-%1))

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Maybe
import Data.Int (Int64)
import Debug.Trace
import qualified Data.ByteString.Char8 as C

readInt :: Integral a => C.ByteString -> a
readInt = fromIntegral . fst . fromJust . C.readInt

getInts :: IO [Int64]
getInts = map readInt . C.words <$> C.getLine

getInt :: IO Int64
getInt = readInt <$> C.getLine

newtype Mint = Mint Int64

mymod :: Int64
mymod = 1000000007

instance Show Mint where
  show (Mint a) = show a

instance Num Mint where
  (+) (Mint a) (Mint b) = Mint $ let c = a + b in if c >= mymod then c - mymod else c
  (-) (Mint a) (Mint b) = Mint $ let c = a - b in if c < 0 then c + mymod else c
  (*) (Mint a) (Mint b) = Mint $ a * b `rem` mymod
  abs                   = id
  signum (Mint a)       = Mint $ signum a
  fromInteger a         = Mint $ fromInteger $ a `mod` toInteger mymod

myDiv :: Mint -> Mint -> Mint
myDiv (Mint a) (Mint b) = Mint $ a `div` b

powMod :: Mint -> Mint -> Mint
powMod _ (Mint 0) = Mint 1
powMod p n@(Mint t)
  | odd t = p * tmp
  | otherwise = tmp
  where
  tmp = powMod (p * p) (n `myDiv` (Mint 2))

calc :: Mint -> (Mint, (Mint, Mint)) -> Mint
calc s (x,(l,k)) =
  --trace (show x ++ " " ++ show l ++ " " ++ show k ++ " " ++ show t ++ " " ++ show p ++ " " ++ show d ++ " " ++ show t') $
  s + p - t
  where
  t = powMod (Mint 2) x
  p = powMod (Mint 2) (x + l * k)

main :: IO ()
main = do
  n <- getLine
  k <- getInt
  let len = fromIntegral $ length n
      n' = [(Mint i,(Mint len, Mint k)) | (i,x) <- zip [0..] n, x == '5' || x == '0']
      chu' = powMod (Mint 2) $ Mint len
      chu = powMod (chu' - (Mint 1)) $ Mint $ mymod - 2
  --putStrLn $ show n''
  print $ chu * (foldl calc (Mint 0) n')

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Maybe
import Data.Int (Int64)
import Debug.Trace
import qualified Data.ByteString.Char8 as C

readInt :: Integral a => C.ByteString -> a
readInt = fromIntegral . fst . fromJust . C.readInt

getInts :: IO [Int64]
getInts = map readInt . C.words <$> C.getLine

getInt :: IO Int64
getInt = readInt <$> C.getLine

mymod :: Int64
mymod = 1000000007

powMod :: Int64 -> Int64 -> Int64
powMod _ 0 = 1
powMod p n
  | odd n = (p * tmp) `rem` mymod
  | otherwise = tmp
  where
  tmp = powMod ((p*p) `rem` mymod) ((if odd n then n-1 else n) `div` 2)

calc :: (Int64, (Int64, Int64)) -> Int64
calc (x,(l,k)) =
  --trace (show x ++ " " ++ show l ++ " " ++ show k ++ " " ++ show t ++ " " ++ show p ++ " " ++ show d ++ " " ++ show t') $
  (((p + mymod - t) `rem` mymod) * t') `rem` mymod
  where
  t = powMod 2 x
  d = powMod 2 l
  p = powMod 2 $ x + l * k
  t' = powMod (d - 1) $ mymod - 2

main :: IO ()
main = do
  --n <- (\x -> [digitToInt c | c <- x]) <$> C.getLine
  n <- getLine
  k <- getInt
  let len = fromIntegral $ length n
      n' = [i | (i,x) <- zip [0..] n, x == '5' || x == '0']
      n'' = zip n' $ replicate (length n') (len,k)
  --putStrLn $ show n''
  print $ sum $ map calc n''

import Data.Int
import Data.Maybe
import qualified Data.ByteString.Char8 as C

newtype MInt = MInt Int64

m :: Int64
m = 1000000007

instance Show MInt where
  show (MInt a) = show a

instance Num MInt where
  (+) (MInt a) (MInt b) = MInt $ let c = a + b in if c >= m then c - m else c
  (-) (MInt a) (MInt b) = MInt $ let c = a - b in if c < 0 then c + m else c
  (*) (MInt a) (MInt b) = MInt $ a * b `rem` m
  abs                   = id
  signum (MInt a)       = MInt $ signum a
  fromInteger a         = MInt $ fromInteger $ a `mod` toInteger m

main :: IO ()
main = do
  s <- C.getLine
  k <- fmap (fst . fromJust . C.readInt) C.getLine
  let x = sum [b | (a, b) <- zip (C.unpack s) $ iterate (*2) 1, a == '0' || a == '5']
      y = sum $ take k $ iterate (*2^C.length s) 1
  print $ (x * y :: MInt)


Every day Ruslan tried to count sheep to fall asleep, but this didn't help. Now he has found a more interesting thing to do. First, he thinks of some set of circles on a plane, and then tries to choose a beautiful set of points, such that there is at least one point from the set inside or on the border of each of the imagined circles.Yesterday Ruslan tried to solve this problem for the case when the set of points is considered beautiful if it is given as (xt = f(t), yt = g(t)), where argument t takes all integer values from 0 to 50. Moreover, f(t) and g(t) should be correct functions.Assume that w(t) and h(t) are some correct functions, and c is an integer ranging from 0 to 50. The function s(t) is correct if it's obtained by one of the following rules:  s(t) = abs(w(t)), where abs(x) means taking the absolute value of a number x, i.e. |x|; s(t) = (w(t) + h(t)); s(t) = (w(t) - h(t)); s(t) = (w(t) * h(t)), where  *  means multiplication, i.e. (w(t)·h(t)); s(t) = c; s(t) = t;Yesterday Ruslan thought on and on, but he could not cope with the task. Now he asks you to write a program that computes the appropriate f(t) and g(t) for any set of at most 50 circles.In each of the functions f(t) and g(t) you are allowed to use no more than 50 multiplications. The length of any function should not exceed 100·n characters. The function should not contain spaces.Ruslan can't keep big numbers in his memory, so you should choose f(t) and g(t), such that for all integer t from 0 to 50 value of f(t) and g(t) and all the intermediate calculations won't exceed 109 by their absolute value.

The first line of the input contains number n (1 ≤ n ≤ 50) — the number of circles Ruslan thinks of. Next follow n lines, each of them containing three integers xi, yi and ri (0 ≤ xi, yi ≤ 50, 2 ≤ ri ≤ 50) — the coordinates of the center and the raduis of the i-th circle.

In the first line print a correct function f(t). In the second line print a correct function g(t). The set of the points (xt = f(t), yt = g(t)) (0 ≤ t ≤ 50) must satisfy the condition, that there is at least one point inside or on the border of each of the circles, Ruslan thinks of at the beginning.

NoteCorrect functions: 10 (1+2) ((t-3)+(t*4)) abs((t-10)) (abs((((23-t)*(t*t))+((45+12)*(t*t))))*((5*t)+((12*t)-13))) abs((t-(abs((t*31))+14))))Incorrect functions: 3+5+7 (not enough brackets, it should be ((3+5)+7) or (3+(5+7)))  abs(t-3) (not enough brackets, it should be abs((t-3)) 2+(2-3 (one bracket too many) 1(t+5) (no arithmetic operation between 1 and the bracket) 5000*5000 (the number exceeds the maximum)  The picture shows one of the possible solutions

type Input  = [[Integer]]
type Output = [Exp]

parse :: String -> Input
parse = toList . unzip . map pair . tail . lines
    where pair l        = let [x, y, _] = map read . words $ l in (x, y)
          toList (a, b) = [a, b]

data Exp = Abs      Exp
         | Add      Exp Exp
         | Subtract Exp Exp
         | Multiply Exp Exp
         | Constant Integer
         | Variable

instance Show Exp where
    show g = go g ""
        where go :: Exp -> String -> String
              go (Abs      e)   = ("abs(" ++) . go e . (")" ++)
              go (Add      e f) = ("(" ++) . go e . ("+" ++) . go f . (")" ++)
              go (Subtract e f) = ("(" ++) . go e . ("-" ++) . go f . (")" ++)
              go (Multiply e f) = ("(" ++) . go e . ("*" ++) . go f . (")" ++)
              go (Constant c)   = (show c ++)
              go (Variable)     = ("t" ++)

instance Num Exp where
    abs         = Abs
    (+)         = Add
    (-)         = Subtract
    (*)         = Multiply
    fromInteger = Constant
    signum      = undefined

at :: Integer -> Exp
at x = 2 - abs (d (x - 1) - d (x + 1))
    where d :: Integer -> Exp
          d a
            | a >= 0    = abs (Variable - fromInteger   a)
            | otherwise = abs (Variable + fromInteger (-a))

solve :: Input -> Output
solve = map solve1
    where solve1 :: [Integer] -> Exp
          solve1 = sum . zipWith (*) (map at [0..]) . map (fromInteger . (`div` 2))

format :: Output -> String
format = unlines . map show

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

type Input  = [[Integer]]
type Output = [Exp]

parse :: String -> Input
parse = toList . unzip . map pair . tail . lines
    where pair l        = let [x, y, _] = map read . words $ l in (x, y)
          toList (a, b) = [a, b]

data Exp = Abs      Exp
         | Add      Exp Exp
         | Subtract Exp Exp
         | Multiply Exp Exp
         | Constant Integer
         | Variable

instance Show Exp where
    show = go
        where go :: Exp -> String
              go (Abs      e)   = "abs(" ++ go e ++ ")"
              go (Add      e f) = "(" ++ go e ++ "+" ++ go f ++ ")"
              go (Subtract e f) = "(" ++ go e ++ "-" ++ go f ++ ")"
              go (Multiply e f) = "(" ++ go e ++ "*" ++ go f ++ ")"
              go (Constant c)   = show c
              go Variable       = "t"

instance Num Exp where
    abs         = Abs
    (+)         = Add
    (-)         = Subtract
    (*)         = Multiply
    fromInteger = Constant
    signum      = undefined

at :: Integer -> Exp
at x = 2 - abs (d (x - 1) - d (x + 1))
    where d :: Integer -> Exp
          d a
            | a >= 0    = abs (Variable - fromInteger   a)
            | otherwise = abs (Variable + fromInteger (-a))

solve :: Input -> Output
solve = map solve1
    where solve1 :: [Integer] -> Exp
          solve1 = sum . zipWith (*) (map at [0..]) . map (fromInteger . (`div` 2))

format :: Output -> String
format = unlines . map show

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import Control.Arrow ((&&&))
import Data.List (intercalate)

data Circle = Circle { circleX :: Int, circleY :: Int }

type Input  = [Circle]
type Output = (String, String)

parse :: String -> Input
parse = map circle . tail . lines
    where circle l = let [x, y, _] = map read . words $ l in Circle x y

solve1 :: [Int] -> String
solve1 = intercalate "+" . zipWith f [0..]
    where f :: Int -> Int -> String
          f i x = concat ["(", g i, "*", show (x `div` 2), ")"]
          g :: Int -> String
          g i   = concat ["(2-abs((", a (i - 1), "-", a (i + 1), ")))"]
          a :: Int -> String
          a i
            | i < 0     = concat ["abs((t+", show (-i), "))"]
            | otherwise = concat ["abs((t-", show i, "))"]

solve :: Input -> Output
solve = (solve1 . map circleX) &&& (solve1 . map circleY)

format :: Output -> String
format (f, g) = unlines [f, g]

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import Control.Arrow ((&&&))
import Data.List (intercalate)

data Circle = Circle { circleX :: Int, circleY :: Int }

type Input  = [Circle]
type Output = (String, String)

parse :: String -> Input
parse = map circle . tail . lines
    where circle l = let [x, y, _] = map read . words $ l in Circle x y

fit :: Int -> Int
fit x
    | even x    = x
    | otherwise = x + 1

solve1 :: [Int] -> String
solve1 = intercalate "+" . zipWith f [0..]
    where f :: Int -> Int -> String
          f i x = concat ["(", g i, "*", show . fit $ x, ")"]
          g :: Int -> String
          g i   = concat ["abs((", a (i - 1), "-", a (i + 1), "))"]
          a :: Int -> String
          a i   = concat ["abs((t-", show i, "))"]

solve :: Input -> Output
solve = (solve1 . map circleX) &&& (solve1 . map circleY)

format :: Output -> String
format (f, g) = unlines [f, g]

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

type Input  = [[Integer]]
type Output = [Exp]

parse :: String -> Input
parse = toList . unzip . map pair . tail . lines
    where pair l        = let [x, y, _] = map read . words $ l in (x, y)
          toList (a, b) = [a, b]

data Exp = Abs      Exp
         | Add      Exp Exp
         | Subtract Exp Exp
         | Multiply Exp Exp
         | Constant Integer
         | Variable

instance Show Exp where
    show g = go g ""
        where go :: Exp -> String -> String
              go (Abs      e)   = ("abs(" ++) . go e . (")" ++)
              go (Add      e f) = ("(" ++) . go e . ("+" ++) . go f . (")" ++)
              go (Subtract e f) = ("(" ++) . go e . ("-" ++) . go f . (")" ++)
              go (Multiply e f) = ("(" ++) . go e . ("*" ++) . go f . (")" ++)
              go (Constant c)   = (show c ++)
              go (Variable)     = ("t" ++)

instance Num Exp where
    abs         = Abs
    (+)         = Add
    (-)         = Subtract
    (*)         = Multiply
    fromInteger = Constant
    signum      = undefined

at :: Integer -> Exp
at x = 2 - abs (d (x - 1) - d (x + 1))
    where d :: Integer -> Exp
          d a
            | a >= 0    = abs (Variable - fromInteger a)
            | otherwise = abs (Variable + fromInteger a)

solve :: Input -> Output
solve = map solve1
    where solve1 :: [Integer] -> Exp
          solve1 = sum . zipWith (*) (map at [0..]) . map (fromInteger . (`div` 2))

format :: Output -> String
format = unlines . map show

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

type Input  = [[Integer]]
type Output = [Exp]

parse :: String -> Input
parse = toList . unzip . map pair . tail . lines
    where pair l        = let [x, y, _] = map read . words $ l in (x, y)
          toList (a, b) = [a, b]

data Exp = Abs      Exp
         | Add      Exp Exp
         | Subtract Exp Exp
         | Multiply Exp Exp
         | Constant Integer
         | Variable

instance Show Exp where
    show g = go g ""
        where go :: Exp -> String -> String
              go (Abs      e)   = ("abs(" ++) . go e . (")" ++)
              go (Add      e f) = ("(" ++) . go e . ("+" ++) . go f . (")" ++)
              go (Subtract e f) = ("(" ++) . go e . ("-" ++) . go f . (")" ++)
              go (Multiply e f) = ("(" ++) . go e . ("*" ++) . go f . (")" ++)
              go (Constant c)   = (show c ++)
              go (Variable)     = ("t" ++)

instance Num Exp where
    abs         = Abs
    (+)         = Add
    (-)         = Subtract
    (*)         = Multiply
    fromInteger = Constant
    signum      = undefined

at :: Integer -> Exp
at x = 2 - abs (d (x - 1) - d (x + 1))
    where d :: Integer -> Exp
          d a
            | a >= 0    = abs (Variable - fromInteger a)
            | otherwise = abs (Variable + fromInteger a)

solve :: Input -> Output
solve = map solve1
    where solve1 :: [Integer] -> Exp
          solve1 = sum . zipWith (*) (map at [0..]) . map fromInteger

format :: Output -> String
format = unlines . map show

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import Control.Arrow ((&&&))
import Data.List (intercalate)

data Circle = Circle { circleX :: Int, circleY :: Int }

type Input  = [Circle]
type Output = (String, String)

parse :: String -> Input
parse = map circle . tail . lines
    where circle l = let [x, y, _] = map read . words $ l in Circle x y

solve1 :: [Int] -> String
solve1 = intercalate "+" . zipWith f [0..]
    where f :: Int -> Int -> String
          f i x = concat ["(", g i, "*", show (x `div` 2), ")"]
          g :: Int -> String
          g i   = concat ["abs((", a (i - 1), "-", a (i + 1), "))"]
          a :: Int -> String
          a i
            | i < 0     = concat ["abs((t+", show (-i), "))"]
            | otherwise = concat ["abs((t-", show i, "))"]

solve :: Input -> Output
solve = (solve1 . map circleX) &&& (solve1 . map circleY)

format :: Output -> String
format (f, g) = unlines [f, g]

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents


Monocarp is a little boy who lives in Byteland and he loves programming.Recently, he found a permutation of length $$$n$$$. He has to come up with a mystic permutation. It has to be a new permutation such that it differs from the old one in each position.More formally, if the old permutation is $$$p_1,p_2,\ldots,p_n$$$ and the new one is $$$q_1,q_2,\ldots,q_n$$$ it must hold that $$$$$$p_1\neq q_1, p_2\neq q_2, \ldots ,p_n\neq q_n.$$$$$$Monocarp is afraid of lexicographically large permutations. Can you please help him to find the lexicographically minimal mystic permutation?

There are several test cases in the input data. The first line contains a single integer $$$t$$$ ($$$1\leq t\leq 200$$$) — the number of test cases. This is followed by the test cases description. The first line of each test case contains a positive integer $$$n$$$ ($$$1\leq n\leq 1000$$$) — the length of the permutation. The second line of each test case contains $$$n$$$ distinct positive integers $$$p_1, p_2, \ldots, p_n$$$ ($$$1 \leq p_i \leq n$$$). It's guaranteed that $$$p$$$ is a permutation, i. e. $$$p_i \neq p_j$$$ for all $$$i \neq j$$$.  It is guaranteed that the sum of $$$n$$$ does not exceed $$$1000$$$ over all test cases.

For each test case, output $$$n$$$ positive integers — the lexicographically minimal mystic permutations. If such a permutation does not exist, output $$$-1$$$ instead.

NoteIn the first test case possible permutations that are mystic are $$$[2,3,1]$$$ and $$$[3,1,2]$$$. Lexicographically smaller of the two is $$$[2,3,1]$$$.In the second test case, $$$[1,2,3,4,5]$$$ is the lexicographically minimal permutation and it is also mystic.In third test case possible mystic permutations are $$$[1,2,4,3]$$$, $$$[1,4,2,3]$$$, $$$[1,4,3,2]$$$, $$$[3,1,4,2]$$$, $$$[3,2,4,1]$$$, $$$[3,4,2,1]$$$, $$$[4,1,2,3]$$$, $$$[4,1,3,2]$$$ and $$$[4,3,2,1]$$$. The smallest one is $$$[1,2,4,3]$$$.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Maybe [Int]
solve n _ | n <= 1 = Nothing
solve n ps = solve' ps (sort ps)
    where
        solve' :: [Int] -> [Int] -> Maybe [Int]
        solve' [] [] = Just []
        solve' [p] [sP]
            | p == sP = Nothing
            | otherwise = Just [sP]
        solve' [pa, pb] [sPa, sPb]
            | pa == sPa || pb == sPb = Just [sPb, sPa]
            | otherwise = Just [sPa, sPb]
        solve' (pa:otherP) (sPa:sPb:otherSp)
            | pa == sPa = (sPb :) <$> solve' otherP (sPa:otherSp)
            | otherwise = (sPa :) <$> solve' otherP (sPb:otherSp)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n] <- B8.getLine <&> readIntB8s
        ps <- B8.getLine <&> readIntB8s
        let answer = solve n ps
        case answer of
            Nothing -> printf "-1"
            Just ps -> do
                forM_ ps $ printf "%d "
        putStrLn ""


Codehorses has just hosted the second Codehorses Cup. This year, the same as the previous one, organizers are giving T-shirts for the winners.The valid sizes of T-shirts are either "M" or from $$$0$$$ to $$$3$$$ "X" followed by "S" or "L". For example, sizes "M", "XXS", "L", "XXXL" are valid and "XM", "Z", "XXXXL" are not.There are $$$n$$$ winners to the cup for both the previous year and the current year. Ksenia has a list with the T-shirt sizes printed for the last year cup and is yet to send the new list to the printing office. Organizers want to distribute the prizes as soon as possible, so now Ksenia is required not to write the whole list from the scratch but just make some changes to the list of the previous year. In one second she can choose arbitrary position in any word and replace its character with some uppercase Latin letter. Ksenia can't remove or add letters in any of the words.What is the minimal number of seconds Ksenia is required to spend to change the last year list to the current one?The lists are unordered. That means, two lists are considered equal if and only if the number of occurrences of any string is the same in both lists.

The first line contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of T-shirts. The $$$i$$$-th of the next $$$n$$$ lines contains $$$a_i$$$ — the size of the $$$i$$$-th T-shirt of the list for the previous year. The $$$i$$$-th of the next $$$n$$$ lines contains $$$b_i$$$ — the size of the $$$i$$$-th T-shirt of the list for the current year. It is guaranteed that all the sizes in the input are valid. It is also guaranteed that Ksenia can produce list $$$b$$$ from the list $$$a$$$.

Print the minimal number of seconds Ksenia is required to spend to change the last year list to the current one. If the lists are already equal, print 0.

NoteIn the first example Ksenia can replace "M" with "S" and "S" in one of the occurrences of "XS" with "L".In the second example Ksenia should replace "L" in "XXXL" with "S".In the third example lists are equal.

module Main where

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import Data.Tuple
import Control.Monad
import Control.Applicative
import qualified Data.Set as Set
import qualified Data.Map.Lazy as Map

main :: IO()
main =
  print =<< (Map.foldl' (+) 0) <$>
    liftM2 (foldl' $
      flip $ Map.update (\ x -> if x > 1 then Just (x - 1) else Nothing))
      (Map.fromList . map (liftA2 (,) head length) . group . sort <$>
        (read <$> getLine >>= flip replicateM getLine))
      (words <$> getContents)

module Main where
import Control.Monad
import Data.List
main = do
  nIO <- getLine
  let n = read nIO :: Int
  old <- replicateM n getLine
  new <- replicateM n getLine
  let (ans, _) = foldl (\(cnt, rr) el -> if el `elem` (new \\ rr) then (cnt, el:rr) else (cnt+1, rr)) (0, []) old
  print ans

module Main where

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import Data.Tuple
import Control.Monad
import Control.Applicative
import qualified Data.Set as Set

main :: IO()
main = do
  n <- (read :: String -> Int) <$> getLine
  a <- f n
  b <- f n
  print . length . filter (uncurry (/=)) $ on zip sort a b
  where f = sequence . flip replicate getLine

module Main where

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import Data.Tuple
import Control.Monad
import Control.Applicative
import qualified Data.Set as Set

main :: IO()
main = do
  n <- (read :: String -> Int) <$> getLine
  a <- f n
  b <- f n
  print . sum . map (uncurry (((length . filter (uncurry (/=))).) . zip)) $ on zip sort a b
  where f = sequence . flip replicate getLine