Iahub likes chess very much. He even invented a new chess piece named Coder. A Coder can move (and attack) one square horizontally or vertically. More precisely, if the Coder is located at position (x, y), he can move to (or attack) positions (x + 1, y), (x–1, y), (x, y + 1) and (x, y–1).Iahub wants to know how many Coders can be placed on an n × n chessboard, so that no Coder attacks any other Coder.

The first line contains an integer n (1 ≤ n ≤ 1000).

On the first line print an integer, the maximum number of Coders that can be placed on the chessboard. On each of the next n lines print n characters, describing the configuration of the Coders. For an empty cell print an '.', and for a Coder print a 'C'. If there are multiple correct answers, you can print any.

main = fmap f readLn >>= mapM putStrLn
f x = show (div (x * x + 1) 2) : g [g "C.", g ".C"]
  where g xs = take x $ concat $ repeat xs

main = readLn >>= mapM putStrLn . f
f x = show (div (x * x + 1) 2) : g [g "C.", g ".C"]
  where g xs = take x $ cycle xs

import Control.Monad (forM_)

main = do
  n <- fmap read getLine
  let total = case n `divMod` 2 of
                (q,0) -> n*q
                (q,1) -> (q+1) + q*n
  let row1 = take n $ cycle "C."
      row2 = take n $ cycle ".C"
      rows = take n $ cycle [row1,row2]
  print total
  forM_ rows $ putStrLn

import Data.List
import qualified Data.Map as Map

main = do
    n <- fmap (read) getLine :: IO Int
    let table = take n $ cycle [ take n $ cycle [1, 0], take n $ cycle [0, 1] ]
    print $ sum $ fmap sum table
    mapM_ (putStrLn . (fmap ((Map.fromList [(0, '.'), (1, 'C')]) Map.!))) table

module Main where

import Data.List
-- https://codeforces.com/problemset/problem/384/A
main :: IO ()
main = do
    n <- getLine >>= pure . (read :: String -> Int)
    let res = solve n
    putStrLn . show . length . filter (=='C') $ res
    putStrLn res
    pure ()

solve :: Int -> String
solve n =
    let n' = (n+1) `div` 2
        cs = f "." . intercalate "." . take n' $ (repeat "C")
        dot = f "C" . intercalate "C" . take n' $ (repeat ".")
    in intercalate "\n" . take n $ cycle [cs, dot]
    where
        f s = if even n then ( <> s )
                else ( <> mempty )

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

solve :: Int -> [String]
solve n = show ((n * n + 1) `div` 2) : take n (cycle [ take n $ cycle "C.", take n $ cycle ".C" ])

main = do
  n <- readLn
  print $ (n^2 + 1) `div` 2
  mapM_ putStrLn $ take n $ map (take n . flip drop (cycle "C.")) (cycle [0,1])

import Control.Applicative
import Data.List

main=do
	n<-    read   <$> getLine:: IO  Int
	let s1 = take n $ cycle ['C','.']
	let s2 = take n $ cycle ['.','C']
	print $ (+) (if odd n then 1 else 0) $ div (n*n) 2
	putStrLn $ intercalate "\n" $ take n $ cycle [s1,s2]

process :: Int -> (Int,[[Char]])
process n = (nc,map (\i -> take n (f (odd i))) [1..n])
    where
        nc = (n^2-1)`div`2+1
        f :: Bool -> [Char]
        f b = map (\x -> if x then 'C' else '.') $ iterate not b

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    let (nc,board) = process n
    print nc
    mapM_ putStrLn board

sol :: Int -> [Char]
sol n = take ((n+1)*n) (cycle ((take n (cycle "C.") ++ ['\n']) ++ (take n (cycle ".C") ++ ['\n'])))

main = do
        input <- getLine
        let n = read input
        putStrLn $ show $ (ceiling ((fromIntegral n^2) / 2))
        putStrLn $ sol n

main = getLine>>=(\x->putStr(solve (read x)))
solve n = res n ++ "\n" ++ (unlines (tb n))
res n = show ((n*n)`div`2+n`mod`2)
tb n = take n (concat (map (map (take n)) (replicate 1000 [concat (replicate 1000 "C."),concat (replicate 1000 ".C")])))

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

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

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

main = do
  n <- readLn

  let
    ls = [[if even i == even j then 'C' else '.' | j <- [1..n]] | i <- [1..n]]

  print $ length $ filter (== 'C') $ concat ls
  putStrLn $ unlines ls

main = fmap (\x -> show (div (x * x + 1) 2) : f 1 x) readLn >>= mapM putStrLn
f a b = if a > b then [] else map (\x -> if even (a + x) then 'C' else '.') [1..b] : f (a + 1) b

main = fmap (\x -> show (length (filter odd [1..x]) ^ 2 + (length (filter even [1..x]) ^ 2)) : f 1 x) readLn >>= mapM putStrLn
f a b = if a > b then [] else map (\x -> if even (a + x) then 'C' else '.') [1..b] : f (a + 1) b

module Main where

import Data.List
-- https://codeforces.com/problemset/problem/384/A
main :: IO ()
main = do
    n <- getLine >>= pure . (read :: String -> Int)
    putStrLn $ solve n
    pure ()

solve :: Int -> String
solve n =
    let n' = (n+1) `div` 2
        cs = f "." . intercalate "." . take n' $ (repeat "C")
        dot = f "C" . intercalate "C" . take n' $ (repeat ".")
    in intercalate "\n" . take n $ cycle [cs, dot]
    where
        f s = if even n then ( <> s )
                else ( <> mempty )

import Control.Applicative
import Data.List

main=do
	n<-    read   <$> getLine:: IO  Int
	let s1 = take n $ cycle ['C','.']
	let s2 = take n $ cycle ['.','C']
	putStrLn $ intercalate "\n" $ take n $ cycle [s1,s2]

import Control.Applicative
import Data.List

main=do
	n<-    read   <$> getLine:: IO  Int
	let s1 = take n $ cycle ['C','.']
	let s2 = take n $ cycle ['.','C']
	print n
	putStrLn $ intercalate "\n" $ take n $ cycle [s1,s2]

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

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

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

main = do
  n <- readLn

  let
    ls = [[if even i == even j then 'C' else '.' | j <- [1..n]] | i <- [1..n]]

  print $ length $ filter (== '.') $ concat ls
  putStrLn $ unlines ls

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

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

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

main = do
  n <- readLn

  let
    ls = [[if even i == even j then 'C' else '.' | j <- [1..n]] | i <- [1..n]]

  putStrLn $ unlines ls

main = fmap (\x -> show (x * x + 1 `div` 2) : f 1 x) readLn >>= mapM putStrLn
f a b = if a > b then [] else map (\x -> if even (a + x) then 'C' else '.') [1..b] : f (a + 1) b

main = fmap f readLn >>= mapM putStrLn
f x = show (div (x * x + 1) 2) : g [g "C.", g ".C"]
  where g xs = take 5 $ concat $ repeat xs

main = fmap (f 1) readLn >>= mapM putStrLn
f a b = if a > b then [] else map (\x -> if x == a then 'C' else '.') [1..b] : f (a + 1) b


You are given two arrays $$$a$$$ and $$$b$$$, both of length $$$n$$$. All elements of both arrays are from $$$0$$$ to $$$n-1$$$.You can reorder elements of the array $$$b$$$ (if you want, you may leave the order of elements as it is). After that, let array $$$c$$$ be the array of length $$$n$$$, the $$$i$$$-th element of this array is $$$c_i = (a_i + b_i) \% n$$$, where $$$x \% y$$$ is $$$x$$$ modulo $$$y$$$.Your task is to reorder elements of the array $$$b$$$ to obtain the lexicographically minimum possible array $$$c$$$.Array $$$x$$$ of length $$$n$$$ is lexicographically less than array $$$y$$$ of length $$$n$$$, if there exists such $$$i$$$ ($$$1 \le i \le n$$$), that $$$x_i < y_i$$$, and for any $$$j$$$ ($$$1 \le j < i$$$) $$$x_j = y_j$$$.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$, $$$b$$$ and $$$c$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i < n$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. The third line of the input contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$0 \le b_i < n$$$), where $$$b_i$$$ is the $$$i$$$-th element of $$$b$$$.

Print the lexicographically minimum possible array $$$c$$$. Recall that your task is to reorder elements of the array $$$b$$$ and obtain the lexicographically minimum possible array $$$c$$$, where the $$$i$$$-th element of $$$c$$$ is $$$c_i = (a_i + b_i) \% n$$$.

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import qualified Data.IntMap.Strict as IM
import Data.List
import Data.Maybe

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

type M = IM.IntMap Int
decr :: Int -> M -> M
decr x = IM.update f x
  where
    f 1 = Nothing
    f c = Just $! pred c

solve :: [Int] -> Builder
solve (n:a) = (mconcat $ intersperse (char7 ' ') d) <> char7 '\n'
  where
    (b, t) = splitAt n a
    c = IM.fromListWith (+) $ (`zip` (replicate n 1)) $ take n t
    loop :: [Int] -> M -> [Int] -> [Int]
    loop [] _ r = reverse r
    loop (x:xs) m r
      | isJust z = next (fst $! fromJust z) r
      | True = next z2 r
      where
        z = IM.lookupGE (mod (n - x) n) m
        z2 = fst $ IM.findMin m
        next :: Int -> [Int] -> [Int]
        next !v r = loop xs (decr v m) (v: r)
    d = map intDec $ zipWith (\ !x !y -> mod (x + y) n) b $ loop b c []

main :: IO ()
main = hPutBuilder stdout . solve . map ru . C.words =<< C.getContents


This is an interactive problem!Ehab plays a game with Laggy. Ehab has 2 hidden integers $$$(a,b)$$$. Laggy can ask a pair of integers $$$(c,d)$$$ and Ehab will reply with:  1 if $$$a \oplus c>b \oplus d$$$.  0 if $$$a \oplus c=b \oplus d$$$.  -1 if $$$a \oplus c<b \oplus d$$$. Operation $$$a \oplus b$$$ is the bitwise-xor operation of two numbers $$$a$$$ and $$$b$$$.Laggy should guess $$$(a,b)$$$ with at most 62 questions. You'll play this game. You're Laggy and the interactor is Ehab.It's guaranteed that $$$0 \le a,b<2^{30}$$$.

To print the answer, print "! a b" (without quotes). Don't forget to flush the output after printing the answer.

NoteIn the sample:The hidden numbers are $$$a=3$$$ and $$$b=1$$$.In the first query: $$$3 \oplus 2 = 1$$$ and $$$1 \oplus 1 = 0$$$, so the answer is 1.In the second query: $$$3 \oplus 1 = 2$$$ and $$$1 \oplus 2 = 3$$$, so the answer is -1.In the third query: $$$3 \oplus 2 = 1$$$ and $$$1 \oplus 0 = 1$$$, so the answer is 0.Then, we printed the answer.

import System.IO
import Data.List
import Data.Bits

toint s = (read s) :: Int

doit::Int->Int->Int->Int->[Int]->String
doit d t a b s =
  if t == t then
    if d < 0 then
      "! "++show(a)++" "++show(b)++"\n"
    else
      if t == 0 then
        let w = head s in
        let aa = if w == 1 then a else (xor a $ shift 1 d) in
        let bb = if w == 1 then b else (xor b $ shift 1 d) in
        "? "++show(xor a $ shift 1 d)++" "++show(b)++"\n"++(doit (d-1) 0 aa bb $ tail s)
      else
        let q = "? "++show(xor a $ shift 1 d)++" "++show(xor b $ shift 1 d)++"\n" in
        let w = head s in
        q++(if w == t then (doeq d t a b $ tail s) else (doneq d t a b $ tail s))
  else
    "pingo"

doeq d t a b s =
  if t == t then
    let q = "? "++show(xor a $ shift 1 d)++" "++show(b)++"\n" in
    let w = head s in
    let aa = if w == 1 then a else (xor a $ shift 1 d) in
    let bb = if w == 1 then b else (xor b $ shift 1 d) in
    q++(doit (d-1) t aa bb $ tail s)
  else
    "pingo"

doneq d t a b s =
  if t == t then
    let aa = if t == 1 then (xor a $ shift 1 d) else a in
    let bb = if t == 1 then b else (xor b $ shift 1 d) in
    let q = "? "++show(aa)++" "++show(bb)++"\n" in
    let w = head s in
    q++(doit (d-1) w aa bb $ tail s)
  else
    "pingo"

solve::String -> String
solve ss =
  let s = map toint $ words ss in
  let t = head s in
  "? 0 0\n"++(doit 29 t 0 0 $ tail s)

main = do
  hSetBuffering stdout LineBuffering
  interact $ solve

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import System.IO

main :: IO ()
main = do
  (x, y) <- first
  putStrLn $ ("! "++) $ shows x $ ' ' : show y

putQuery :: Int -> Int -> IO Ordering
putQuery c d = do
  putStrLn $ ("? "++) $ shows c $ ' ' : show d
  hFlush stdout
  (`compare` (0::Int)) . read <$> getLine

first :: IO (Int, Int)
first =  (putQuery 0 0 >>=) $ neqLoop (bit 29) 0 0

neqLoop :: Int -> Int -> Int -> Ordering -> IO (Int, Int)
neqLoop 0 !a !b !ord = return (a,b)
neqLoop !lev !a !b EQ = eqLoop lev a b
neqLoop !lev !a !b !ord = do
  flippedOrd <- putQuery (a .|. lev) (b .|. lev)
  if ord == flippedOrd then do
    thisBit <- putQuery a (b .|. lev)
    let (newA, newB) = case thisBit of
                         LT -> (a,b)
                         _  -> (a .|. lev, b .|. lev)
    neqLoop (lev `shiftR` 1) newA newB ord
  else do
    let (newA, newB) = case ord of
                         GT -> (a .|. lev, b)
                         _  -> (a, b .|. lev)
    newOrd <- putQuery newA newB
    neqLoop (lev `shiftR` 1) newA newB newOrd

eqLoop :: Int -> Int -> Int -> IO (Int, Int)
eqLoop 0 !a !b = return (a, b)
eqLoop !lev !a !b = do
  ord <- putQuery a (b .|. lev)
  case ord of
    LT -> eqLoop (lev `shiftR` 1) a b
    _  -> eqLoop (lev `shiftR` 1) (a .|. lev) (b .|. lev)

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import System.IO

main :: IO ()
main = do
  (x, y) <- first
  putStrLn $ ("! "++) $ shows x $ ' ' : show y

putQuery :: Int -> Int -> IO Ordering
putQuery c d = do
  putStrLn $ ("? "++) $ shows c $ ' ' : show d
  hFlush stdout
  (`compare` (0::Int)) . read <$> getLine

first :: IO (Int, Int)
first =  (putQuery 0 0 >>=) $ neqLoop (bit 29) 0 0 (bit 30 - 1)

neqLoop :: Int -> Int -> Int -> Int -> Ordering -> IO (Int, Int)
neqLoop 0 !a !b !unk !ord = eqLoop (bit 29) a b unk
neqLoop !lev !a !b !unk EQ = eqLoop (bit 29) a b unk
neqLoop !lev !a !b !unk !ord = do
  flippedOrd <- putQuery (a .|. lev) (b .|. lev)
  if ord == flippedOrd then
    neqLoop (lev `shiftR` 1) a b unk ord
  else do
    let (newA, newB) = case ord of
                         GT -> (a .|. lev, b)
                         _  -> (a, b .|. lev)
    newOrd <- putQuery newA newB
    neqLoop (lev `shiftR` 1) newA newB (unk .&. complement lev) newOrd

eqLoop :: Int -> Int -> Int -> Int -> IO (Int, Int)
eqLoop 0 !a !b !unk = return (a, b)
eqLoop !lev !a !b !unk | lev .&. unk == 0
  = eqLoop (lev `shiftR` 1) a b unk
eqLoop !lev !a !b !unk = do
  ord <- putQuery a (b .|. lev)
  case ord of
    LT -> eqLoop (lev `shiftR` 1) a b unk
    _  -> eqLoop (lev `shiftR` 1) (a .|. lev) (b .|. lev) unk

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
{-
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import System.IO

main :: IO ()
main = do
  (x, y) <- first
  putStrLn $ ("! "++) $ shows x $ ' ' : show y

putQuery :: Int -> Int -> IO Ordering
putQuery c d = do
  putStrLn $ ("? "++) $ shows c $ ' ' : show d
  hFlush stdout
  (`compare` (0::Int)) . read <$> getLine

data Status = Status { level :: {-# UNPACK #-} !Int,
                       bitsA :: {-# UNPACK #-} !Int,
                       bitsB :: {-# UNPACK #-} !Int,
                       unknown :: {-# UNPACK #-} !Int }

first :: IO (Int, Int)
first =  (putQuery 0 0 >>=) $ neqLoop $ Status (bit 29) 0 0 (bit 30 - 1)

neqLoop :: Status -> Ordering -> IO (Int, Int)
neqLoop st@Status{ level = 0 } !ord = eqLoop st{ level = bit 29 }
neqLoop !st EQ = eqLoop st{ level = bit 29 }
neqLoop !st !ord = do
  flippedOrd <- putQuery (bitsA st .|. level st) (bitsB st .|. level st)
  if ord == flippedOrd then
    neqLoop st{level = level st `shiftR` 1} ord
  else do
    let (newA, newB) = case ord of
                         GT -> (bitsA st .|. level st, bitsB st)
                         _  -> (bitsA st, bitsB st .|. level st)
        !newSt = Status { level = level st `shiftR` 1,
                          bitsA = newA,
                          bitsB = newB,
                          unknown = unknown st `xor` level st}
    newOrd <- putQuery newA newB
    neqLoop newSt newOrd

eqLoop :: Status -> IO (Int, Int)
eqLoop st@Status{ level = 0 } = return (bitsA st, bitsB st)
eqLoop st | level st .&. unknown st == 0
  = eqLoop st{level = level st `shiftR` 1}
eqLoop !st = do
  ord <- putQuery (bitsA st) (bitsB st .|. level st)
  case ord of
    LT -> eqLoop st{ level = level st `shiftR` 1 }
    _  -> eqLoop st{ bitsA = bitsA st .|. level st,
                     bitsB = bitsB st .|. level st,
                     level = level st `shiftR` 1}

import System.IO
import Data.List
import Data.Bits

toint s = (read s) :: Int

doit::Int->Int->Int->Int->[Int]->String
doit d t a b s =
  if t == t then
    if d < 0 then
      "! "++show(a)++" "++show(b)++"\n"
    else
      if t == 0 then
        let w = head s in
        let aa = if w == 1 then a else (xor a $ shift 1 d) in
        "? "++show(xor a $ shift 1 d)++" "++show(b)++"\n"++(doit (d-1) 0 aa aa $ tail s)
      else
        let q = "? "++show(xor a $ shift 1 d)++" "++show(xor b $ shift 1 d)++"\n" in
        let w = head s in
        q++(if w == t then (doeq d t a b $ tail s) else (doneq d t a b $ tail s))
  else
    "pingo"

doeq d t a b s =
  if t == t then
    let q = "? "++show(xor a $ shift 1 d)++" "++show(b)++"\n" in
    let w = head s in
    let aa = if w == 1 then a else (xor a $ shift 1 d) in
    let bb = if w == 1 then b else (xor b $ shift 1 d) in
    q++(doit (d-1) t aa bb $ tail s)
  else
    "pingo"

doneq d t a b s =
  if t == t then
    let aa = if t == 1 then (xor a $ shift 1 d) else a in
    let bb = if t == 1 then b else (xor b $ shift 1 d) in
    let q = "? "++show(aa)++" "++show(bb)++"\n" in
    let w = head s in
    q++(doit (d-1) w aa bb $ tail s)
  else
    "pingo"

solve::String -> String
solve ss =
  let s = map toint $ words ss in
  let t = head s in
  "? 0 0\n"++(doit 29 t 0 0 $ tail s)

main = do
  hSetBuffering stdout LineBuffering
  interact $ solve


Three companies decided to order a billboard with pictures of their logos. A billboard is a big square board. A logo of each company is a rectangle of a non-zero area. Advertisers will put up the ad only if it is possible to place all three logos on the billboard so that they do not overlap and the billboard has no empty space left. When you put a logo on the billboard, you should rotate it so that the sides were parallel to the sides of the billboard.Your task is to determine if it is possible to put the logos of all the three companies on some square billboard without breaking any of the described rules.

The first line of the input contains six positive integers x1, y1, x2, y2, x3, y3 (1 ≤ x1, y1, x2, y2, x3, y3 ≤ 100), where xi and yi determine the length and width of the logo of the i-th company respectively.

If it is impossible to place all the three logos on a square shield, print a single integer "-1" (without the quotes). If it is possible, print in the first line the length of a side of square n, where you can place all the three logos. Each of the next n lines should contain n uppercase English letters "A", "B" or "C". The sets of the same letters should form solid rectangles, provided that:   the sizes of the rectangle composed from letters "A" should be equal to the sizes of the logo of the first company,  the sizes of the rectangle composed from letters "B" should be equal to the sizes of the logo of the second company,  the sizes of the rectangle composed from letters "C" should be equal to the sizes of the logo of the third company,  Note that the logos of the companies can be rotated for printing on the billboard. The billboard mustn't have any empty space. If a square billboard can be filled with the logos in multiple ways, you are allowed to print any of them. See the samples to better understand the statement.

6
BBBBBB
BBBBBB
AAAACC
AAAACC
AAAACC
AAAACC

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

import Control.Applicative
import Control.DeepSeq (deepseq)
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
-- import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
-- import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.STRef
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
-- import Data.HashMap.Strict (HashMap)
-- import qualified Data.HashMap.Strict as HashMap
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO
import System.Random

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

main = do
  [x1, y1, x2, y2, x3, y3] <- map read . words <$> getLine

  let
    options a [] = [a]
    options a b = concat $ map f b
      where
        f p@(x, y, i) = options (a ++ [(x, y, i)]) (b \\ [p]) ++ options (a ++ [(y, x, i)]) (b \\ [p])

    rs = catMaybes $ map try $ options [] [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
      where
        try [(x1, y1, i1), (x2, y2, i2), (x3, y3, i3)]
          | x1 == x2 && x2 == x3 && y1+y2+y3 == x1 =
            Just $ replicate y1 (replicate x1 i1) ++ replicate y2 (replicate x1 i2) ++ replicate y3 (replicate x1 i3)
          | x2 == x3 && x1+x2 == y1 && x1+x2 == y2+y3 =
            Just $ replicate y2 (replicate x1 i1 ++ replicate x2 i2) ++ replicate y3 (replicate x1 i1 ++ replicate x3 i3)
          | otherwise = Nothing

  if null rs
    then
      print (-1)
    else do
      print $ length $ head rs
      putStr $ unlines $ head rs

import Data.Maybe
import Data.List ((\\), find)
import Debug.Trace (trace)

main = do
	[x1, y1, x2, y2, x3, y3] <- (map read . words) `fmap` getLine

	let
		try [(x, y, c)] = [[(x, y, c)], [(y, x, c)]]
		try bs = concatMap next bs
			where
				next b@(x, y, c) =
						(map ((x, y, c) :) bs') ++ (map ((y, x, c) :) bs')
					where
						bs' = try $ bs \\ [b]

		check [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			x1 == x2 && x2 == x3 && y1 + y2 + y3 == x1 || x1 == x2 && y1 + y2 == y3 && x1 + x3 == y3

		opts = try [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
		ans = find check opts

		printAns [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			if x1 == x2 && x2 == x3 && y1 + y2 + y3 == x1 then do
				print x1
				putStr $ unlines $ replicate y1 $ replicate x1 c1
				putStr $ unlines $ replicate y2 $ replicate x1 c2
				putStr $ unlines $ replicate y3 $ replicate x1 c3
			else  do
				print y3
				putStr $ unlines $ replicate y1 $ replicate x1 c1 ++ replicate x3 c3
				putStr $ unlines $ replicate y2 $ replicate x2 c2 ++ replicate x3 c3

	if isNothing ans
		then print (-1)
		else printAns $ fromJust ans

import Data.List
hanten::[(Int,Int,Char)] -> [[(Int,Int,Char)]]
hanten [a0,a1,a2] = [a0,a1,a2]:[fp a0,a1,a2]:[a0,fp a1,a2]:[a0,a1,fp a2]:[fp a0,fp a1,a2]:[a0,fp a1,fp a2]:[fp a0,a1,fp a2]:[fp a0,fp a1,fp a2]:[]
fp::(Int,Int,Char) -> (Int,Int,Char)
fp (a,b,c) = (b,a,c)
perm:: [(Int,Int,Char)] -> [[(Int,Int,Char)]]
perm a = permutations a
isOk:: [(Int,Int,Char)] -> Int
isOk [(x0,y0,_),(x1,y1,_),(x2,y2,_)] | (x0 == x1+x2) && (y1 == y2) && (x0 == y0 + y1) = 1
                               | (x0 == x1) && (x1 == x2) && (x0 == y0+y1+y2)= 2
                               | otherwise = 0
takeIsOk ::[[(Int,Int,Char)]] -> ([(Int,Int,Char)],Int)
takeIsOk [] = ([],0)
takeIsOk (a:as) | io > 0 = (a,io)
                | otherwise = takeIsOk as
   where io = isOk a
toString::([(Int,Int,Char)],Int) -> String
toString ([],0) = "-1"
toString (a@[(x0,y0,_),(x1,y1,_),(x2,y2,_)],1) = toString0 getC1 a 0 0 x0 (y0+y1)
toString (a@[(x0,y0,_),(x1,y1,_),(x2,y2,_)],2) = toString0 getC2 a 0 0 x0 (y0+y1+y2)
toString0::([(Int,Int,Char)] -> Int -> Int -> Char) -> [(Int,Int,Char)]-> Int -> Int -> Int -> Int  -> String
toString0 getC a@[(x0,y0,_),(x1,y1,_),(x2,y2,_)] i j si sj
                                                | i == si = []
                                                | j == sj -1 = [getC a i j]++"\n"++(toString0 getC a (i+1) 0 si sj)
                                                | otherwise = (getC a i j):(toString0 getC a i (j+1) si sj)
getC1::[(Int,Int,Char)] -> Int -> Int -> Char
getC1 a@[(x0,y0,c0),(x1,y1,c1),(x2,y2,c2)] i j | i < y0 = c0
                                               | i >= y0 && j < x1 = c1
                                               | otherwise = c2
getC2::[(Int,Int,Char)] -> Int -> Int -> Char
getC2 a@[(x0,y0,c0),(x1,y1,c1),(x2,y2,c2)] i j | i < y0 = c0
                                               | i < y0+y1 = c1
                                               | otherwise = c2

main = do
  w0 <- getLine
  let [x0,y0,x1,y1,x2,y2] = [read n::Int| n<-(words w0)]
  let a = [[(x0,y0,'A'),(x1,y1,'B'),(x2,y2,'C')]]
  let allPattern = concatMap perm $ concatMap hanten a
  let ok = takeIsOk allPattern
  let t = snd ok
  if t == 0
    then putStrLn "-1"
    else do
          let ([(xn0,yn0,_),(xn1,yn1,_),(xn2,yn2,_)],_) = ok
          putStr ((show xn0) ++ "\n"++ (toString ok))

import Control.Monad
import Data.List
import qualified Data.Array as Array
import qualified Data.Array.ST as ST

place :: (Num a, Array.Ix a, Ord a, Enum a) => [(a, a, c)] -> Array.Array (a, a) c
place xs =
    let m = maximum $ map (\(l, r, c) -> max l r) xs
        xs' = fit (m, m) xs
    in if length xs' == length xs then ST.runSTArray $ produce xs' m
    else Array.array ((0, 0), (-1, -1)) []
        where produce vs sz = do
                    ar <- ST.newArray ((0, 0), (sz-1, sz-1)) (third $ head vs)
                    foldM_ (\p (l, r, v) -> do writeBlock ar p (l, r) v; return $ advance p (l, r) sz) (0, 0) vs
                    return ar
              writeBlock ar (r, c) (rows, columns) value =
                  mapM_ (\(or, oc) -> ST.writeArray ar (r+or, c+oc) value) [(i, j) | i <- [0..rows-1], j <- [0..columns-1]]

advance (r, c) (br, bc) sz =
    if (c+bc) == sz then (r+br, c)
    else (r, c+bc)

fit target values = fit' target [] [] values
    where fit' target rs ns [] | fst target == 0 || snd target == 0 = reverse rs
            | otherwise = []
          fit' target@(l, r) rs ns (x@(l', r', c):xs) =
              if l == l' && r >= r' then fit' (l', r-r') (x:rs) [] (ns ++ xs)
              else if l == r' && r >= l' then fit' (r', r-l') ((r', l', c):rs) [] (ns ++ xs)
              else if r == l' && l >= r' then fit' (l-r', l') ((r', l', c):rs) [] (ns ++ xs)
              else if r == r' && l >= l' then fit' (l-l', r') ((l', r', c):rs) [] (ns ++ xs)
              else fit' target rs (x:ns) xs

second (_, v, _) = v
third (_, _, v) = v

main = do
    inp <- getContents
    let values = map read $ words inp :: [Int]
        d = zip3 (snd $ unzip $ filter (\v -> odd $ fst v) $ zip [0..] values)
            (snd $ unzip $ filter (\v -> even $ fst v) $ zip [0..] values) ['A', 'B', 'C']
        r = map (map snd) $ groupBy (\((l, _), _) ((r, _), _) -> l == r) (Array.assocs $ place d)
    if length r /= 0 then do
        putStrLn $ show $ length r
        putStrLn $ unlines $ r
    else
        putStrLn "-1"

import Data.Maybe
import Data.List ((\\), find)
import Debug.Trace (trace)

main = do
	[x1, y1, x2, y2, x3, y3] <- (map read . words) `fmap` getLine

	let
		try [(x, y, c)] = [[(x, y, c)], [(y, x, c)]]
		try bs = concatMap next bs
			where
				next b@(x, y, c) =
						(map ((x, y, c) :) bs') ++ (map ((y, x, c) :) bs')
					where
						bs' = try $ bs \\ [b]

		check [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			x1 == x2 && x3 == x3 && y1 + y2 + y3 == x1 || x1 == x2 && y1 + y2 == y3 && x1 + x3 == y3

		opts = try [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
		ans = find check opts

		printAns [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			if x1 == x2 && x2 == x3 then do
				print x1
				putStr $ unlines $ replicate y1 $ replicate x1 c1
				putStr $ unlines $ replicate y2 $ replicate x1 c2
				putStr $ unlines $ replicate y3 $ replicate x1 c3
			else if x1 == x2 && y1 + y2 == y3 then do
				print y3
				putStr $ unlines $ replicate y1 $ replicate x1 c1 ++ replicate x3 c3
				putStr $ unlines $ replicate y2 $ replicate x2 c2 ++ replicate x3 c3
			else
				return ()

	if isNothing ans
		then print (-1)
		else printAns $ fromJust ans

import Data.Maybe
import Data.List ((\\), find)
import Debug.Trace (trace)

main = do
	[x1, y1, x2, y2, x3, y3] <- (map read . words) `fmap` getLine

	let
		try [(x, y, c)] = [[(x, y, c)], [(y, x, c)]]
		try bs = concatMap next bs
			where
				next b@(x, y, c) =
						(map ((x, y, c) :) bs') ++ (map ((y, x, c) :) bs')
					where
						bs' = try $ bs \\ [b]

		check [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			x1 == x2 && x2 == x3 && y1 + y2 + y3 == x1 || x1 == x2 && y1 + y2 == y3 && x1 + x3 == y3

		opts = try [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
		ans = find check opts

		printAns [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			if x1 == x2 && x2 == x3 then do
				print x1
				putStr $ unlines $ replicate y1 $ replicate x1 c1
				putStr $ unlines $ replicate y2 $ replicate x1 c2
				putStr $ unlines $ replicate y3 $ replicate x1 c3
			else if x1 == x2 && y1 + y2 == y3 then do
				print y3
				putStr $ unlines $ replicate y1 $ replicate x1 c1 ++ replicate x3 c3
				putStr $ unlines $ replicate y2 $ replicate x2 c2 ++ replicate x3 c3
			else
				return ()

	if isNothing ans
		then print (-1)
		else printAns $ fromJust ans

import Data.Maybe
import Data.List ((\\), find)
import Debug.Trace (trace)

main = do
	[x1, y1, x2, y2, x3, y3] <- (map read . words) `fmap` getLine

	let
		try [(x, y, c)] = [[(x, y, c)], [(y, x, c)]]
		try bs = concatMap next bs
			where
				next b@(x, y, c) =
						(map ((x, y, c) :) bs') ++ (map ((y, x, c) :) bs')
					where
						bs' = try $ bs \\ [b]

		check [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			x1 == x2 && x3 == x3 || x1 == x2 && y1 + y2 == y3

		opts = try [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
		ans = find check opts

		printAns [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			if x1 == x2 && x2 == x3 then do
				putStr $ unlines $ replicate y1 $ replicate x1 'A'
				putStr $ unlines $ replicate y2 $ replicate x1 'B'
				putStr $ unlines $ replicate y3 $ replicate x1 'C'
			else if x1 == x2 && y1 + y2 == y3 then do
				putStr $ unlines $ replicate y1 $ replicate x1 'A' ++ replicate x3 'C'
				putStr $ unlines $ replicate y2 $ replicate x2 'B' ++ replicate x3 'C'
			else
				return ()

	if isNothing ans
		then print (-1)
		else printAns $ fromJust ans

import Data.Maybe
import Data.List ((\\), find)
import Debug.Trace (trace)

main = do
	[x1, y1, x2, y2, x3, y3] <- (map read . words) `fmap` getLine

	let
		try [(x, y, c)] = [[(x, y, c)], [(y, x, c)]]
		try bs = concatMap next bs
			where
				next b@(x, y, c) =
						(map ((x, y, c) :) bs') ++ (map ((y, x, c) :) bs')
					where
						bs' = try $ bs \\ [b]

		check [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			x1 == x2 && x3 == x3 && y1 + y2 + y3 == x1 || x1 == x2 && y1 + y2 == y3 && x1 + x3 == y3

		opts = try [(x1, y1, 'A'), (x2, y2, 'B'), (x3, y3, 'C')]
		ans = find check opts

		printAns [(x1, y1, c1), (x2, y2, c2), (x3, y3, c3)] =
			if x1 == x2 && x2 == x3 then do
				print x1
				putStr $ unlines $ replicate y1 $ replicate x1 'A'
				putStr $ unlines $ replicate y2 $ replicate x1 'B'
				putStr $ unlines $ replicate y3 $ replicate x1 'C'
			else if x1 == x2 && y1 + y2 == y3 then do
				print y3
				putStr $ unlines $ replicate y1 $ replicate x1 'A' ++ replicate x3 'C'
				putStr $ unlines $ replicate y2 $ replicate x2 'B' ++ replicate x3 'C'
			else
				return ()

	if isNothing ans
		then print (-1)
		else printAns $ fromJust ans

import Control.Monad
import Data.List
import qualified Data.Array as Array
import qualified Data.Array.ST as ST

place :: (Num a, Array.Ix a, Ord a, Enum a) => [(a, a, c)] -> Array.Array (a, a) c
place xs =
    let m = maximum $ map (\(l, r, c) -> max l r) xs
        xs' = fit (m, m) xs
    in if length xs' == length xs then ST.runSTArray $ produce xs' m
    else Array.array ((0, 0), (-1, -1)) []
        where produce vs sz = do
                    ar <- ST.newArray ((0, 0), (sz-1, sz-1)) (third $ head vs)
                    foldM_ (\p (l, r, v) -> do writeBlock ar p (l, r) v; return $ advance p (l, r) sz) (0, 0) vs
                    return ar
              writeBlock ar (r, c) (rows, columns) value =
                  mapM_ (\(or, oc) -> ST.writeArray ar (r+or, c+oc) value) [(i, j) | i <- [0..rows-1], j <- [0..columns-1]]

advance (r, c) (br, bc) sz =
    if (c+bc) == sz then (r+br, c)
    else (r, c+bc)

fit target values = fit' target [] values
    where fit' target ns [] = []
          fit' target@(l, r) ns (x@(l', r', c):xs) =
              if l == l' && r >= r' then x:(fit' (l', r-r') [] (ns ++ xs))
              else if l == r' && r >= l' then (r', l', c):(fit' (r', r-l') [] (ns ++ xs))
              else if r == l' && l >= r' then (r', l', c):(fit' (l-r', l') [] (ns ++ xs))
              else if r == r' && l >= l' then (l', r', c):(fit' (l-l', r') [] (ns ++ xs))
              else fit' target (x:ns) xs

second (_, v, _) = v
third (_, _, v) = v

main = do
    inp <- getContents
    let values = map read $ words inp :: [Int]
        d = zip3 (snd $ unzip $ filter (\v -> odd $ fst v) $ zip [0..] values)
            (snd $ unzip $ filter (\v -> even $ fst v) $ zip [0..] values) ['A', 'B', 'C']
        r = map (map snd) $ groupBy (\((l, _), _) ((r, _), _) -> l == r) (Array.assocs $ place d)
    if length r /= 0 then do
        putStrLn $ show $ length r
        putStrLn $ unlines $ r
    else
        putStrLn "-1"


You are given three integers $$$x, y$$$ and $$$n$$$. Your task is to find the maximum integer $$$k$$$ such that $$$0 \le k \le n$$$ that $$$k \bmod x = y$$$, where $$$\bmod$$$ is modulo operation. Many programming languages use percent operator % to implement it.In other words, with given $$$x, y$$$ and $$$n$$$ you need to find the maximum possible integer from $$$0$$$ to $$$n$$$ that has the remainder $$$y$$$ modulo $$$x$$$.You have to answer $$$t$$$ independent test cases. It is guaranteed that such $$$k$$$ exists for each test case.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 5 \cdot 10^4$$$) — the number of test cases. The next $$$t$$$ lines contain test cases. The only line of the test case contains three integers $$$x, y$$$ and $$$n$$$ ($$$2 \le x \le 10^9;~ 0 \le y < x;~ y \le n \le 10^9$$$). It can be shown that such $$$k$$$ always exists under the given constraints.

For each test case, print the answer — maximum non-negative integer $$$k$$$ such that $$$0 \le k \le n$$$ and $$$k \bmod x = y$$$. It is guaranteed that the answer always exists.

NoteIn the first test case of the example, the answer is $$$12339 = 7 \cdot 1762 + 5$$$ (thus, $$$12339 \bmod 7 = 5$$$). It is obvious that there is no greater integer not exceeding $$$12345$$$ which has the remainder $$$5$$$ modulo $$$7$$$.

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x,y,n] <- map read . words <$> getLine
    print $ n - (n - y) `mod` x

main = do
  inputjar <- getLine
  let n = read inputjar :: Int
  solve n

solve :: Int -> IO ()
solve 0 = putStr ""
solve n = do
  input <- getLine
  let list = read ("[" ++ map (\x -> if x == ' ' then ',' else x) input ++ "]") :: [Int]
  solveCase list
  solve (n - 1)

solveCase :: [Int] -> IO ()
solveCase (x : y : n : [])
  | tmp <= n = print tmp
  | otherwise = print $ tmp - x
  where
    tmp = n - (n `mod` x) + y

solve :: [Int] -> Int
solve [x, y, n]
  | (n - n `mod` x + y) <= n = (n - n `mod` x + y)
  | otherwise                = (n - n `mod` x - (x - y))

splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs
  where (as,bs) = splitAt n xs

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

main :: IO ()
main = interact $ unlines . map show . map solve . splitEvery 3 . map read . tail . words

import Control.Monad (replicateM_)

main = readLn >>= flip replicateM_ (getLine >>= print . (\[a,b,c] -> f a b c) . map read . words)

f :: Int -> Int -> Int -> Int
f x y n | n `mod` x >= y = n - ((n `mod` x) - y)
        | otherwise = f x y $ n - (n `mod` x) - 1

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Monad (replicateM_)

main = do
  n <- readLn
  replicateM_ n $ do
    input :: [Word] <- map read  . words <$> getLine
    let x = input !! 0;
        y = input !! 1;
        n = input !! 2;
        i = n - n `mod` x + y; in
      print $ if i > n then i - x else i

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int]  -> Int
solve (x: y: n: []) | r >= y = n - (r-y)
                    | otherwise = n + (y-r) - x where
  r = n `mod` x

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

process x y n | a==y = n
	      | a>y = n-a+y
              | otherwise = n-x-a+y
	where a = mod n x

onecase = do
		[x,y,n]<- map read <$> words <$> getLine ::IO [Integer]
		print $ process x y n

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase


This is an interactive problem.I want to play a game with you...We hid from you a cyclic graph of $$$n$$$ vertices ($$$3 \le n \le 10^{18}$$$). A cyclic graph is an undirected graph of $$$n$$$ vertices that form one cycle. Each vertex belongs to the cycle, i.e. the length of the cycle (the number of edges in it) is exactly $$$n$$$. The order of the vertices in the cycle is arbitrary.You can make queries in the following way: "? a b" where $$$1 \le a, b \le 10^{18}$$$ and $$$a \neq b$$$. In response to the query, the interactor outputs on a separate line the length of random of two paths from vertex $$$a$$$ to vertex $$$b$$$, or -1 if $$$\max(a, b) > n$$$. The interactor chooses one of the two paths with equal probability. The length of the path —is the number of edges in it.You win if you guess the number of vertices in the hidden graph (number $$$n$$$) by making no more than $$$50$$$ queries.Note that the interactor is implemented in such a way that for any ordered pair $$$(a, b)$$$, it always returns the same value for query "? a b", no matter how many such queries. Note that the "? b a" query may be answered differently by the interactor.The vertices in the graph are randomly placed, and their positions are fixed in advance.Hacks are forbidden in this problem. The number of tests the jury has is $$$50$$$.

NoteIn the first example, the graph could look like this  The lengths of the simple paths between all pairs of vertices in this case are $$$1$$$ or $$$2$$$.   The first query finds out that one of the simple paths from vertex $$$1$$$ to vertex $$$2$$$ has a length of $$$1$$$.  With the second query, we find out that one of the simple paths from vertex $$$1$$$ to vertex $$$3$$$ has length $$$2$$$.  In the third query, we find out that vertex $$$4$$$ is not in the graph. Consequently, the size of the graph is $$$3$$$.

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

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

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

import qualified Control.Monad as M
import qualified Control.Monad.State as M
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.IntSet as IS
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char

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

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

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

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

#else

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

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

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

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

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

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

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

{- solution -}

query :: Integer -> Integer -> IO Integer
query a b = do
    printf "? %lld %lld\n" a b
    hFlush stdout
    B8.getLine <&> readIntegerB8

guess :: Integer -> M.MaybeT IO Integer
guess i = do
    x <- M.liftIO $ query 1 i
    y <- M.liftIO $ query i 1
    let guess' x y
            | (x, y) == (-1, -1)  = Just $ i - 1
            | x == y              = Nothing
            | otherwise           = Just $ x + y
    value <- M.MaybeT . return $ guess' x y
    tracingM "value" value
    return value

solve :: M.MaybeT IO Integer
solve = M.msum . flip map [2 .. 24] $ guess

main :: IO ()
main = do
    Just answer <- M.runMaybeT solve
    printf "! %lld\n" answer
    hFlush stdout

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

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

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

import qualified Control.Monad as M
import qualified Control.Monad.State as M
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.IntSet as IS
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char

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

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

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

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

#else

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

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

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

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

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

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

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

{- solution -}

query :: Int -> Int -> IO Int
query a b = do
    printf "? %d %d\n" a b
    hFlush stdout
    B8.getLine <&> readIntB8

guess :: Int -> M.MaybeT IO Int
guess i = do
    x <- M.liftIO $ query 1 i
    y <- M.liftIO $ query i 1
    M.guard $ x == y
    let guess' x y
            | (x, y) == (-1, -1)  = Just $ i - 1
            | x == y              = Nothing
            | otherwise           = Just $ x + y
    M.MaybeT . return $ guess' x y

solve :: M.MaybeT IO Int
solve = do
    guesses <- M.msum . flip map [2 .. 25] $ guess
    return 12

main :: IO ()
main = do
    Just answer <- M.runMaybeT solve
    printf "%d\n" answer
    hFlush stdout


3R2 - Standby for ActionOur dear Cafe's owner, JOE Miller, will soon take part in a new game TV-show "1 vs. $$$n$$$"!The game goes in rounds, where in each round the host asks JOE and his opponents a common question. All participants failing to answer are eliminated. The show ends when only JOE remains (we assume that JOE never answers a question wrong!).For each question JOE answers, if there are $$$s$$$ ($$$s > 0$$$) opponents remaining and $$$t$$$ ($$$0 \le t \le s$$$) of them make a mistake on it, JOE receives $$$\displaystyle\frac{t}{s}$$$ dollars, and consequently there will be $$$s - t$$$ opponents left for the next question.JOE wonders what is the maximum possible reward he can receive in the best possible scenario. Yet he has little time before show starts, so can you help him answering it instead?

The first and single line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$), denoting the number of JOE's opponents in the show.

Print a number denoting the maximum prize (in dollars) JOE could have. Your answer will be considered correct if it's absolute or relative error won't exceed $$$10^{-4}$$$. In other words, if your answer is $$$a$$$ and the jury answer is $$$b$$$, then it must hold that $$$\frac{|a - b|}{max(1, b)} \le 10^{-4}$$$.

NoteIn the second example, the best scenario would be: one contestant fails at the first question, the other fails at the next one. The total reward will be $$$\displaystyle \frac{1}{2} + \frac{1}{1} = 1.5$$$ dollars.

solve :: Integer -> Double
solve n = sum $ map (\x -> 1.0 / (fromInteger x)) [1..n]

main = interact (show . solve . (\x -> read x :: Integer))

import Control.Monad

solve :: Double -> Int -> Double
solve ans 0 = ans
solve ans n = solve (ans + (1 / (fromIntegral n))) (n - 1)

main :: IO ()
main = do
    n <- read <$> getLine
    putStrLn $ show . solve 0.0 $ n

import Control.Monad

solve :: Double -> Double
solve n
    | n > 1 = (1.0 / n) + solve (n - 1)
    | otherwise = 1

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

import Control.Monad

solve :: Double -> Double
solve n = sum $ map (\x -> 1.0 / x) [1..n]

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

module Main where

main :: IO()
main = do
    x <- getLine
    let y = read x :: Int
    let s = sum [1 / fromIntegral(i) | i <- [1..y]]
    print s

solve :: Int -> Double
solve n
  | n == 1 = 1.0
  | otherwise = r + solve n'
    where
      n' = n - 1
      r =  (1.0) / (fromIntegral n)

main = do
  n <- readLn :: IO Int
  print $ solve n

solve :: Int -> Double
solve n
  | n == 1 = 1.0
  | otherwise = r + solve n'
    where
      n' = n - t
      t = (n `div` 2)
      r =  (fromIntegral t) / (fromIntegral n)

main = do
  n <- readLn :: IO Int
  print $ solve n

solve :: Int -> Double
solve n
  | n == 1 = 1.0
  | otherwise = r + solve n'
    where
      n' = n - t
      t = (n `div` 2) + n `mod` 2
      r =  (fromIntegral t) / (fromIntegral n)

main = do
  n <- readLn :: IO Int
  print $ solve n

solve :: Int -> Double
solve n
  | n == 1 = 1.0
  | otherwise = r + solve n'
    where
      n' = n - t
      t = n - 1
      r =  (fromIntegral t) / (fromIntegral n)

main = do
  n <- readLn :: IO Int
  print $ solve n


You are given three strings $$$a$$$, $$$b$$$ and $$$c$$$ of the same length $$$n$$$. The strings consist of lowercase English letters only. The $$$i$$$-th letter of $$$a$$$ is $$$a_i$$$, the $$$i$$$-th letter of $$$b$$$ is $$$b_i$$$, the $$$i$$$-th letter of $$$c$$$ is $$$c_i$$$.For every $$$i$$$ ($$$1 \leq i \leq n$$$) you must swap (i.e. exchange) $$$c_i$$$ with either $$$a_i$$$ or $$$b_i$$$. So in total you'll perform exactly $$$n$$$ swap operations, each of them either $$$c_i \leftrightarrow a_i$$$ or $$$c_i \leftrightarrow b_i$$$ ($$$i$$$ iterates over all integers between $$$1$$$ and $$$n$$$, inclusive).For example, if $$$a$$$ is "code", $$$b$$$ is "true", and $$$c$$$ is "help", you can make $$$c$$$ equal to "crue" taking the $$$1$$$-st and the $$$4$$$-th letters from $$$a$$$ and the others from $$$b$$$. In this way $$$a$$$ becomes "hodp" and $$$b$$$ becomes "tele".Is it possible that after these swaps the string $$$a$$$ becomes exactly the same as the string $$$b$$$?

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$)  — the number of test cases. The description of the test cases follows. The first line of each test case contains a string of lowercase English letters $$$a$$$. The second line of each test case contains a string of lowercase English letters $$$b$$$. The third line of each test case contains a string of lowercase English letters $$$c$$$. It is guaranteed that in each test case these three strings are non-empty and have the same length, which is not exceeding $$$100$$$.

Print $$$t$$$ lines with answers for all test cases. For each test case: If it is possible to make string $$$a$$$ equal to string $$$b$$$ print "YES" (without quotes), otherwise print "NO" (without quotes). You can print either lowercase or uppercase letters in the answers.

4
aaa
bbb
ccc
abc
bca
bca
aabb
bbaa
baba
imi
mii
iim

NoteIn the first test case, it is impossible to do the swaps so that string $$$a$$$ becomes exactly the same as string $$$b$$$.In the second test case, you should swap $$$c_i$$$ with $$$a_i$$$ for all possible $$$i$$$. After the swaps $$$a$$$ becomes "bca", $$$b$$$ becomes "bca" and $$$c$$$ becomes "abc". Here the strings $$$a$$$ and $$$b$$$ are equal.In the third test case, you should swap $$$c_1$$$ with $$$a_1$$$, $$$c_2$$$ with $$$b_2$$$, $$$c_3$$$ with $$$b_3$$$ and $$$c_4$$$ with $$$a_4$$$. Then string $$$a$$$ becomes "baba", string $$$b$$$ becomes "baba" and string $$$c$$$ becomes "abab". Here the strings $$$a$$$ and $$$b$$$ are equal.In the fourth test case, it is impossible to do the swaps so that string $$$a$$$ becomes exactly the same as string $$$b$$$.

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

check a b c = and $ map ( \(a1,b1,c1)-> a1==c1 || b1==c1) x
	where x = zip3 a b c

onecase = do
		[a,b,c]<-replicateM 3 getLine
		putStrLn $ if check a b c then "YES" else "NO"

main= do
		a<- read <$> getLine ::IO Int
	 	replicateM_ a onecase

import Data.List (zip3)

process :: [Char] -> [Char] -> [Char] -> Bool
process as bs cs = all (\(a,b,c) -> a==c || b==c) $ zip3 as bs cs

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    as <- getLine
    bs <- getLine
    cs <- getLine
    if process as bs cs
        then putStrLn "YES"
        else putStrLn "NO"
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

solve :: String -> String -> String -> Bool
solve "" "" "" = True
solve (a:as) (b:bs) (c:cs) = if (c == b || c == a ) then solve as bs cs
                                                    else False

parse :: (String, String, String) -> String
parse (a, b, c)
  | solve a b c = "YES"
  | otherwise = "NO"

takeLines :: [String] -> [(String, String, String)]
takeLines [] = []
takeLines (a:b:c:rest) = (a, b, c):takeLines rest

main :: IO ()
main = interact (unlines . map parse . takeLines . tail . lines)


Nastya just made a huge mistake and dropped a whole package of rice on the floor. Mom will come soon. If she sees this, then Nastya will be punished.In total, Nastya dropped $$$n$$$ grains. Nastya read that each grain weighs some integer number of grams from $$$a - b$$$ to $$$a + b$$$, inclusive (numbers $$$a$$$ and $$$b$$$ are known), and the whole package of $$$n$$$ grains weighs from $$$c - d$$$ to $$$c + d$$$ grams, inclusive (numbers $$$c$$$ and $$$d$$$ are known). The weight of the package is the sum of the weights of all $$$n$$$ grains in it.Help Nastya understand if this information can be correct. In other words, check whether each grain can have such a mass that the $$$i$$$-th grain weighs some integer number $$$x_i$$$ $$$(a - b \leq x_i \leq a + b)$$$, and in total they weigh from $$$c - d$$$ to $$$c + d$$$, inclusive ($$$c - d \leq \sum\limits_{i=1}^{n}{x_i} \leq c + d$$$).

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 1000)$$$  — the number of test cases.  The next $$$t$$$ lines contain descriptions of the test cases, each line contains $$$5$$$ integers: $$$n$$$ $$$(1 \leq n \leq 1000)$$$  — the number of grains that Nastya counted and $$$a, b, c, d$$$ $$$(0 \leq b < a \leq 1000, 0 \leq d < c \leq 1000)$$$  — numbers that determine the possible weight of one grain of rice (from $$$a - b$$$ to $$$a + b$$$) and the possible total weight of the package (from $$$c - d$$$ to $$$c + d$$$).

For each test case given in the input print "Yes", if the information about the weights is not inconsistent, and print "No" if $$$n$$$ grains with masses from $$$a - b$$$ to $$$a + b$$$ cannot make a package with a total mass from $$$c - d$$$ to $$$c + d$$$.

NoteIn the first test case of the example, we can assume that each grain weighs $$$17$$$ grams, and a pack $$$119$$$ grams, then really Nastya could collect the whole pack.In the third test case of the example, we can assume that each grain weighs $$$16$$$ grams, and a pack $$$128$$$ grams, then really Nastya could collect the whole pack.In the fifth test case of the example, we can be assumed that $$$3$$$ grains of rice weigh $$$2$$$, $$$2$$$, and $$$3$$$ grams, and a pack is $$$7$$$ grams, then really Nastya could collect the whole pack.In the second and fourth test cases of the example, we can prove that it is impossible to determine the correct weight of all grains of rice and the weight of the pack so that the weight of the pack is equal to the total weight of all collected grains.

import Control.Arrow

main = interact $
  lines >>> drop 1
  >>> map (words >>> map read)
  >>> process
  >>> map (\b -> if b then "Yes" else "No") >>> unlines

process :: [[Int]] -> [Bool]
process [] = []
process ([n,a,b,c,d]:ps) = (check n a b c d) : process ps

check n a b c d =
  c - d <= n * (a + b) && n * (a - b) <= c + d

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Integer]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

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

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

count :: (Eq a) => a -> [a] -> Int
count x = length . filter (== x)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, a, b, c, d] <- getIntList
        let minW = (a - b) * n
            maxW = (a + b) * n
            minV = (c - d)
            maxV = (c + d)
        putStrLn $ yesOrNo $ not $ or [minW > maxV, maxW < minV]

import Control.Monad

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

routine :: IO ()
routine = do
    [n,a,b,c,d] <- (map read.words) <$> getLine
    let big = (a+b)*n :: Int
        small = (a-b)*n
        in if big < c-d || small > c+d
            then putStrLn "No"
            else putStrLn "Yes"

hasOverlap :: (Int, Int) -> (Int, Int) -> Bool
hasOverlap (a,b) (x,y)
    | a > y     = False
    | b < x     = False
    | otherwise = True

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

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

solve :: String -> String
solve s =
    hasOverlap (n*(a-b), n*(a+b)) (c-d, c+d)
    |> decorate
    where
        (n:a:b:c:d:_) = parse s

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

infixr 0 |>

(|>) :: a -> (a -> b) -> b
(|>) = flip ($)

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

onecase = do
		[n,a,b,c,d]<-map read <$> words <$> getLine ::IO [Integer]
		putStrLn $ if (a+b)*n <(c-d) || (a-b)*n >(c+d) then "No" else "Yes"

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

process :: Int -> Int -> Int -> Int -> Int -> Bool
process n a b c d = (max ln lp) <= (min rn rp)
    where
        ln = n * (a - b)
        rn = n * (a + b)
        lp = c - d
        rp = c + d

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    [n,a,b,c,d] <- fmap (map readInt.words) getLine
    if process n a b c d
        then putStrLn "YES"
        else putStrLn "NO"
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Control.Monad

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

routine :: IO ()
routine = do
    [n,a,b,c,d] <- (map read.words) <$> getLine
    let big = (a+b)*n
        small = (a-b)*n
        in if (big <= c+d && c-d <= big) || (small <= c+d && c-d <= small)
            then putStrLn "Yes"
            else putStrLn "No"

import Control.Monad.ST

main = print "hello"


An IPv6-address is a 128-bit number. For convenience, this number is recorded in blocks of 16 bits in hexadecimal record, the blocks are separated by colons — 8 blocks in total, each block has four hexadecimal digits. Here is an example of the correct record of a IPv6 address: "0124:5678:90ab:cdef:0124:5678:90ab:cdef". We'll call such format of recording an IPv6-address full.Besides the full record of an IPv6 address there is a short record format. The record of an IPv6 address can be shortened by removing one or more leading zeroes at the beginning of each block. However, each block should contain at least one digit in the short format. For example, the leading zeroes can be removed like that: "a56f:00d3:0000:0124:0001:f19a:1000:0000"  →  "a56f:d3:0:0124:01:f19a:1000:00". There are more ways to shorten zeroes in this IPv6 address.Some IPv6 addresses contain long sequences of zeroes. Continuous sequences of 16-bit zero blocks can be shortened to "::". A sequence can consist of one or several consecutive blocks, with all 16 bits equal to 0. You can see examples of zero block shortenings below:  "a56f:00d3:0000:0124:0001:0000:0000:0000"  →  "a56f:00d3:0000:0124:0001::";  "a56f:0000:0000:0124:0001:0000:1234:0ff0"  →  "a56f::0124:0001:0000:1234:0ff0";  "a56f:0000:0000:0000:0001:0000:1234:0ff0"  →  "a56f:0000::0000:0001:0000:1234:0ff0";  "a56f:00d3:0000:0124:0001:0000:0000:0000"  →  "a56f:00d3:0000:0124:0001::0000";  "0000:0000:0000:0000:0000:0000:0000:0000"  →  "::". It is not allowed to shorten zero blocks in the address more than once. This means that the short record can't contain the sequence of characters "::" more than once. Otherwise, it will sometimes be impossible to determine the number of zero blocks, each represented by a double colon.The format of the record of the IPv6 address after removing the leading zeroes and shortening the zero blocks is called short.You've got several short records of IPv6 addresses. Restore their full record.

The first line contains a single integer n — the number of records to restore (1 ≤ n ≤ 100). Each of the following n lines contains a string — the short IPv6 addresses. Each string only consists of string characters "0123456789abcdef:". It is guaranteed that each short address is obtained by the way that is described in the statement from some full IPv6 address.

For each short IPv6 address from the input print its full record on a separate line. Print the full records for the short IPv6 addresses in the order, in which the short records follow in the input.

import Control.Monad
import Data.List

split c = map (takeWhile (/=c) . tail) . filter ((==c) . head) . init . tails . (c:)

main = do
  n <- fmap read getLine
  replicateM_ n $ do
    (a, b) <- fmap (break (=="") . split ':') getLine
    let b' = filter (/="") b
        s = a ++ replicate (8 - length a - length b') "" ++ b'
    putStrLn $ intercalate ":" $ map (until ((>=4) . length) ('0':)) s

expand :: String -> String
expand s
	| p !! 0 == "" && p !! 1 == "" = bindColon (map (grow (10 - (length p))) (tail p))
	| otherwise = bindColon (map (grow (9 - (length p))) p)
		where p = parseColon s

grow :: Int -> String -> String
grow 0 []	= ""
grow n []	= (copyString (n - 1) "0000:") ++ "0000"
grow _ s	= (copyString (4 - (length s)) "0") ++ s

copyString :: Int -> String -> String
copyString 0 s = ""
copyString n s = s ++ (copyString (n - 1) s)

bindColon :: [String] -> String
bindColon (x:(y:xs)) = x ++ ":" ++ (bindColon (y:xs))
bindColon (x:xs)	= x
bindColon _	= ""

parseColon :: String -> [String]
parseColon (a:b)
	| null prev && a == ':'	= [""]
	| null prev && a /= ':'	= [a:""]
	| a == ':'				= "":prev
	| otherwise				= (a:(head prev)):(tail prev)
		where prev = parseColon b
parseColon _ = []

printAns :: [String] -> IO()
printAns (x:xs) = do
	putStrLn x
	printAns xs
printAns _ = do
	putStr ""

main :: IO()
main = do
	str <- getContents
	printAns (map expand (tail (words str)))

import Data.List

main = do
    getLine
    ips <- fmap lines getContents
    mapM_ (putStrLn . resolveIpv6) ips

data Block = Number String | Empty
    deriving Eq

resolveIpv6 ip = let blocks = split ip ""
                     zeros  = 8 - (length $ filter (/= Empty) blocks)
                 in  tail $ showIpv6 zeros blocks
    where
        split "" ""       = []
        split "" b        = [Number $ addZeros $ reverse b]
        split (':':ip) "" = Empty:(split ip "")
        split (':':ip) b  = (Number $ addZeros $ reverse b):(split ip "")
        split (c:ip) b    = split ip $ c:b
        addZeros b = (replicate (4 - length b) '0') ++ b
        showIpv6 _ [] = ""
        showIpv6 exp (Number b:xs) = ":" ++ b ++ (showIpv6 exp xs)
        showIpv6 exp (Empty:xs) = showIpv6 0 $ (replicate exp (Number "0000")) ++ xs

import Control.Monad (liftM)
import Data.List (intercalate, isInfixOf)

solve :: String -> String
solve s  =  intercalate ":" $ solve' "" s
  where
    n  =  length $ filter (== ':') s
    m  =  if isInfixOf "::" s then n else n + 1

    solve' b ""  =  [addZero b]
    solve' b (':' : ':' : s)
      =  addZero b : (replicate (8 - m) "0000") ++ solve' "" s
    solve' b (':' : s)  =  addZero b : solve' "" s
    solve' b (c : s)  =  solve' (b ++ [c]) s

    addZero s  =  replicate (4 - length s) '0' ++ s

main :: IO ()
main  =  do
    n  <-  readLn
    ls  <-  liftM (take n . lines) getContents
    mapM_ (putStrLn . solve) ls

main=interact$unlines.map f.tail.lines
f cs = tail.concatMap ff $ parse cs
   where
     g ':' = ' '
     g c = c
     n = length.words.map g $ cs
     ff "" = [1..8-n]>>":0000"
     ff ds = (':':) $ reverse $ take 4 $ reverse $ "0000"++ds

parse (':':':':rest) = "" : parse rest
parse (':':rest) = xs : parse ys
   where
     (xs,ys) = span (':'/=) rest
parse "" = []
parse cs =  xs : parse ys
   where
     (xs,ys) = span (':'/=) cs

import Data.List

split :: (Eq a) => a -> [a] -> [[a]]
split _ [] = []
split t xs
    | b == []   = [a]
    | otherwise = a : (split t $ tail b)
    where (a, b) = break (== t) xs

foo str = concat $ intersperse ":" $ map (\t -> (replicate (4 - length t) '0') ++ t) $ xs'
    where xs     = split ':' str
          xs'    = if b == [] then a ++ (replicate (8 - length xs) "")
                   else a ++ (replicate (9 - length xs) "") ++ tail b
          (a, b) = break (== "") xs

main = interact $ unlines . map foo . tail . lines

import Data.List

split :: (Eq a) => a -> [a] -> [[a]]
split _ [] = []
split t xs
    | b == []   = [a]
    | otherwise = a : (split t $ tail b)
    where (a, b) = break (== t) xs

foo str = concat $ intersperse ":" $ map (\t -> (replicate (4 - length t) '0') ++ t) $ xs'
    where xs     = split ':' str
          xs'    = a ++ (replicate (8 - length xs) "") ++ b
          (a, b) = break (== "") xs

main = interact $ unlines . map foo . tail . lines


Some dwarves that are finishing the StUDY (State University for Dwarven Youngsters) Bachelor courses, have been told "no genome, no degree". That means that all dwarves should write a thesis on genome. Dwarven genome is far from simple. It is represented by a string that consists of lowercase Latin letters.Dwarf Misha has already chosen the subject for his thesis: determining by two dwarven genomes, whether they belong to the same race. Two dwarves belong to the same race if we can swap two characters in the first dwarf's genome and get the second dwarf's genome as a result. Help Dwarf Misha and find out whether two gnomes belong to the same race or not.

The first line contains the first dwarf's genome: a non-empty string, consisting of lowercase Latin letters. The second line contains the second dwarf's genome: a non-empty string, consisting of lowercase Latin letters. The number of letters in each genome doesn't exceed 105. It is guaranteed that the strings that correspond to the genomes are different. The given genomes may have different length.

Print "YES", if the dwarves belong to the same race. Otherwise, print "NO".

Note  First example: you can simply swap two letters in string "ab". So we get "ba".  Second example: we can't change string "aa" into string "ab", because "aa" does not contain letter "b".

import Data.List

main :: IO()
main = printBool . solve . lines =<< getContents

printBool :: Bool -> IO()
printBool b = putStrLn (if b then "YES" else "NO")

solve :: [String] -> Bool
solve (a:b:_) | (length a) /= (length b) = False
              | otherwise = let (da:db:_) = get_diff a b [[], []]
                            in (length da) == 2 && (sort da) == (sort db)

get_diff :: String -> String -> [[Char]] -> [[Char]]
get_diff []     []     d          = d
get_diff (a:ax) (b:bx) (da:db:dx) | a == b = get_diff ax bx (da:db:dx)
                                  | otherwise = get_diff ax bx ((a:da):(b:db):dx)

solv :: [Char] -> [Char] -> Bool
solv x y = if length x /= length y
              then False
              else let tmp = filter (\(x, y) -> x /= y) $ zip x y in
                       if length tmp /= 2 then False else
                   let [(x1, y1), (x2, y2)] = tmp in
                       (x1 == y2) && (x2 == y1)

main = do
    a <- getLine
    b <- getLine
    putStrLn $ if solv a b then "YES" else "NO"

solve a b
    | length a == length b = let c = zip a b
                                 d = filter (\(x, y) -> x /= y) c
                             in case d of
                                  [(a, b), (c, d)] -> a == d && b == c
                                  otherwise        -> False
    | otherwise            = False

main = do
  a <- getLine
  b <- getLine
  putStrLn $ if solve a b then "YES" else "NO"

{-
import HUnit

testSmallString  =  Test "TestSmallString" $ assertFalse (solve "a" "b")

testInput1  =  Test "TestInput 1" $ assertTrue (solve "ab" "ba")

testInput2  =  Test "TestInput 2" $ assertFalse (solve "aa" "ab")

testDiffLength  =  Test "TestDiffLength" $ assertFalse (solve "ab" "baa")

test  =  mapM_ run
  [
    testSmallString,
    testInput1,
    testInput2,
    testDiffLength
  ]
-}
--------------------------------------------------------------------------------

solve :: String -> String -> Bool
solve a b
  | length a == length b  =  solve' diff
  | otherwise  =  False
  where
    diff  =  getDiff a b
    getDiff [] []  =  []
    getDiff (a:as) (b:bs)
      | a == b  =  getDiff as bs
      | a /= b  =  (a,b) : getDiff as bs
    solve' [(a1, b1), (a2, b2)]  =  a1 == b2 && b1 == a2
    solve' _  =  False

main :: IO ()
main  =  do
    a  <-  getLine
    b  <-  getLine
    putStrLn (if solve a b then "YES" else "NO")

import Data.Char
import Data.List

count :: String -> Char -> Int
count s c = length $ filter (\x -> x == c) s

cs :: String -> String -> Bool
cs s1 s2 = cs' s1 s2 'a' 'z'

cs' :: String -> String -> Char -> Char -> Bool
cs' s1 s2 c to = if c > to then True else
                  if (count s1 c) /= (count s2 c) then False else
                   cs' s1 s2 (toEnum ((fromEnum c) + 1)) to

bad :: String -> String -> Int
bad [] [] = 0
bad [] s = 10
bad s [] = 10
bad s t = (bad (tail s) (tail t)) + (if (head s) == (head t) then 0 else 1)

solve :: String -> String -> String
solve s1 s2 = if ((bad s1 s2) <= 2) && (cs s1 s2) then "YES" else "NO"

main = do s1 <- getLine
          s2 <- getLine
          putStrLn $ solve s1 s2

main=interact$solve.lines

swap (x,y) = (y,x)

solve :: [String] -> String
solve [xs,ys]
  | lx /= ly = "NO"
  | length diff /= 2 = "NO"
  | swap(diff!!0) == diff!!1 = "YES"
  | otherwise = "NO"
  where lx = length xs
        ly = length ys
        diff = filter (\(x,y) -> x/=y) $ zip xs ys

solve :: String -> String -> String
solve [] [] = "NO"
solve gen1 gen2 =
    let
        diffs = filter (\xs -> length xs > 0) $ zipWith (\g1 g2 -> if g1 /= g2 then [g1,g2] else []) gen1 gen2
        lens = length gen1 - length gen2
    in
        if lens /= 0 || length diffs /= 2
        then "NO"
        else
            let
                (a:b:_) = diffs
            in
                if reverse b == a then "YES" else "NO"

main =
    do
        gen1 <- getLine
        gen2 <- getLine
        putStrLn $ solve gen1 gen2

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

process :: [Char] -> [Char] -> [(Char, Char)]
process [] [] = []
process [] (x: xs) = (' ' , x) : process [] xs
process (x: xs) [] = (x, ' ') : process xs []
process (x:xs) (y:ys)
 | x == y = process xs ys
 | otherwise = (x, y) : process xs ys

main :: IO ()
main = do
	w1 <- getLine
	w2 <- getLine
	let
		arr = process w1 w2
	if length arr == 2 && fst (arr !! 0) == snd (arr !! 1) && snd (arr!!0) == fst (arr!!1) then
		putStrLn "YES"
		else
			putStrLn "NO"

pairCmp :: Eq a => (a,a) -> (a,a) -> Bool
pairCmp x y = fst x == snd y && snd x == fst y

isOk :: Eq b => [(a,(b,b))] -> Bool
isOk pairs
    | l == 0    = True
	| l == 2    = x `pairCmp` y
	| otherwise = False
    where
        l = length pairs
        x = snd $ pairs !! 0
        y = snd $ pairs !! 1

equal :: Char -> Char -> (Bool, (Char, Char))
equal x y = (x == y, (x, y))

cmp :: String -> String -> Bool
cmp a b
    | length a == length b = isOk . filter (not . fst) $ zipWith equal a b
    | otherwise            = False

boolToStr :: Bool -> String
boolToStr x = if x then "YES" else "NO"

main = do
	a <- getLine
	b <- getLine
	putStrLn $ boolToStr $ cmp a b

import Data.Tuple

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStrLn $ solve a b

solve :: String -> String -> String
solve xs ys
  | lx /= ly = "NO"
  | length diff /= 2 = "NO"
  | swap(diff !! 0) == diff !! 1 = "YES"
  | otherwise = "NO"
  where
    lx = length xs
    ly = length ys
    diff = filter (\(x, y) -> x/= y) $ zip xs ys

import Data.Function
import Data.List
solve x y =
    (length x == length y) && (verify $ foldl folder [] (zip x y))
    where
      folder acc (a, b) = if a == b
                          then acc
                          else (a,b):acc
      verify [] = True
      verify [(a,b), (c,d)] = (a == d) && (b == c)
      verify _ = False

pprint True = "YES"
pprint False = "NO"

main = do
  foo <- getContents
  let bar = lines foo
  putStrLn . pprint $ solve (bar !! 0) (bar !! 1)

import Data.Tuple

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStrLn $ solve a b

solve :: String -> String -> String
solve xs ys
  | lx /= ly = "NO"
  | length diff /= 2 = "NO"
  | swap(diff !! 0) == diff !! 1 = "YES"
  | otherwise = "NO"
  where
    lx = length xs
    ly = length xs
    diff = filter (\(x, y) -> x/= y) $ zip xs ys

import Data.Function
import Data.List
solve x y =
    (length x == length y) && or [cnt == 0, cnt == 2]
    where
      cnt = sum [if a /= b then 1 else 0 | (a, b) <- zip x y]

pprint True = "YES"
pprint False = "NO"

main = do
  foo <- getContents
  let bar = lines foo
  putStrLn . pprint $ solve (bar !! 0) (bar !! 1)

import Data.Function
import Data.List
solve = ((==) `on` sort)

pprint True = "YES"
pprint False = "NO"

main = do
  foo <- getContents
  let bar = lines foo
  putStrLn . pprint $ solve (bar !! 0) (bar !! 1)

import Data.Function
import Data.List
solve x y =
    or [cnt == 0, cnt == 2]
    where
      cnt = sum [if a /= b then 1 else 0 | (a, b) <- zip x y]

pprint True = "YES"
pprint False = "NO"

main = do
  foo <- getContents
  let bar = lines foo
  putStrLn . pprint $ solve (bar !! 0) (bar !! 1)


Vasya has recently learned at school what a number's divisor is and decided to determine a string's divisor. Here is what he came up with.String a is the divisor of string b if and only if there exists a positive integer x such that if we write out string a consecutively x times, we get string b. For example, string "abab" has two divisors — "ab" and "abab".Now Vasya wants to write a program that calculates the number of common divisors of two strings. Please help him.

The first input line contains a non-empty string s1. The second input line contains a non-empty string s2. Lengths of strings s1 and s2 are positive and do not exceed 105. The strings only consist of lowercase Latin letters.

Print the number of common divisors of strings s1 and s2.

NoteIn first sample the common divisors are strings "abcd" and "abcdabcd".In the second sample the common divisor is a single string "a". String "aa" isn't included in the answer as it isn't a divisor of string "aaa".

import Control.Monad (liftM2)
import Data.List (isPrefixOf)

import Control.Monad (foldM_)
import Data.Ix (Ix)
import Data.Array.MArray (MArray, newArray, readArray, writeArray)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray, (!), bounds, elems, listArray)

(?) True  =  const
(?) _  =  flip const

zFunction :: String -> UArray Int Int
zFunction s'  =  runSTUArray $ do
    z  <-  newArray (1, n) 0
    writeArray z 1 n
    foldM_ (iter z) (1, 1) [2..n]
    return z
  where
    n  =  length s'
    s  =  listArray (1, n) s' :: UArray Int Char
    iter z (l, r) i  =  do
        zil  <-  readArray z (i - l + 1)
        let z0  =  (i > r) ? 0 $ min (r - i + 1) zil

        let zi  =  head $ dropWhile (\j -> i + j <= n && s ! (j + 1) == s ! (i + j)) [z0..]
        writeArray z i zi
        return $ (i + zi - 1 > r) ? (i, i + zi - 1) $ (l, r)

solve :: String -> String -> Int
solve s1 s2
  | s1 `isPrefixOf` s2 || s2 `isPrefixOf` s1  =  length $ filter dividerS [1 .. min n1 n2]
  | otherwise  =  0
  where
    n1  =  length s1
    n2  =  length s2
    z1  =  zFunction s1
    z2  =  zFunction s2
    dividerS  i  =  dividerS1 i && dividerS2 i
    dividerS1 i  =  i == n1
        || n1 `mod` i == 0 && z1 ! (i + 1) == (n1 - i)
    dividerS2 i  =  i == n2
        || n2 `mod` i == 0 && z2 ! (i + 1) == (n2 - i)

main :: IO ()
main  =  do
    liftM2 solve getLine getLine >>= print

import Control.Monad (liftM2)
import Data.List (isPrefixOf)

import Control.Monad (foldM_, when)
import Data.Ix (Ix)
import Data.Array.MArray (MArray, newArray, readArray, writeArray)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray, (!), bounds, elems, listArray)

while :: Monad m => m Bool -> m () -> m ()
while condition action  =  do
    c  <-  condition
    when c $ do
        action
        while condition action

modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f  =  do
    e  <-  readArray a i
    writeArray a i (f e)

zFunction :: String -> UArray Int Int
zFunction s'  =  runSTUArray $ do
    z  <-  newArray (1, n) 0
    writeArray z 1 n
    foldM_ (iter z) (1, 1) [2..n]
    return z
  where
    n  =  length s'
    s  =  listArray (1, n) s' :: UArray Int Char
    iter z (l, r) i  =  do
        when (i <= r) $ do
            zil  <-  readArray z (i-l+1)
            writeArray z i (min zil (r-i+1))
        while (condition z i) $ modifyArray z i (+1)
        zi  <-  readArray z i
        if (i + zi - 1 > r) then
            return (i, i + zi - 1)
        else
            return (l, r)
    condition z i  =  do
        zi  <-  readArray z i
        return (i + zi <= n && s ! (zi + 1) == s ! (i + zi))

solve :: String -> String -> Int
solve s1 s2
  | s1 `isPrefixOf` s2 || s2 `isPrefixOf` s1  =  length $ filter dividerS [1 .. min n1 n2]
  | otherwise  =  0
  where
    n1  =  length s1
    n2  =  length s2
    z1  =  zFunction s1
    z2  =  zFunction s2
    dividerS  i  =  dividerS1 i && dividerS2 i
    dividerS1 i  =  i == n1
        || n1 `mod` i == 0 && z1 ! (i + 1) == (n1 - i)
    dividerS2 i  =  i == n2
        || n2 `mod` i == 0 && z2 ! (i + 1) == (n2 - i)

main :: IO ()
main  =  do
    liftM2 solve getLine getLine >>= print

import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.List
check s l =
  let (s1, s2) = splitAt l s
  in null s2 || (isPrefixOf s1 s2 && check s2 l)
main = do
  s1 <- getLine
  s2 <- getLine
  let g = gcd (length s1) (length s2)
  arr <- newArray (1, g) (-1) :: IO (IOArray Int Int)
  cnt <- newIORef 0
  forM_ [1..g] $ \i -> do
    v <- readArray arr i
    if v == -1 && g `mod` i == 0 && check s1 i && check s2 i && take i s1 == take i s2
       then let g' = g `div` i
            in forM_ [1..g'] $ \j -> writeArray arr (i*j) $ if g' `mod` j == 0 then 1 else 0
       else when (v == -1) $ writeArray arr i 0
    readArray arr i >>= \j -> modifyIORef cnt (+j)
  readIORef cnt >>= print

import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.List
check s l =
  let (s1, s2) = splitAt l s
  in null s2 || (isPrefixOf s1 s2 && check s2 l)
main = do
  s1 <- getLine
  s2 <- getLine
  let g = gcd (length s1) (length s2)
  arr <- newArray (1, g) (-1) :: IO (IOArray Int Int)
  cnt <- newIORef 0
  forM_ [1..g] $ \i -> do
    v <- readArray arr i
    if v == -1 && g `mod` i == 0 && check s1 i && check s2 i && head s1 == head s2
       then let g' = g `div` i
            in forM_ [1..g'] $ \j -> writeArray arr (i*j) $ if g' `mod` j == 0 then 1 else 0
       else when (v == -1) $ writeArray arr i 0
    readArray arr i >>= \j -> modifyIORef cnt (+j)
  readIORef cnt >>= print

import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.List
check s l =
  let (s1, s2) = splitAt l s
  in null s2 || (isPrefixOf s1 s2 && check s2 l)
main = do
  s1 <- getLine
  s2 <- getLine
  let g = gcd (length s1) (length s2)
  arr <- newArray (1, g) (-1) :: IO (IOArray Int Int)
  cnt <- newIORef 0
  forM_ [1..g] $ \i -> do
    v <- readArray arr i
    if v == -1 && g `mod` i == 0 && check s1 i && check s2 i
       then let g' = g `div` i
            in forM_ [1..g'] $ \j -> writeArray arr (i*j) $ if g' `mod` j == 0 then 1 else 0
       else when (v == -1) $ writeArray arr i 0
    readArray arr i >>= \j -> modifyIORef cnt (+j)
  readIORef cnt >>= print

import Control.Monad (liftM2, foldM_, when)
import Data.Ix (Ix)
import Data.Array.MArray (MArray, newArray, readArray, writeArray)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray, (!), bounds, elems, listArray)

while :: Monad m => m Bool -> m () -> m ()
while condition action  =  do
    c  <-  condition
    when c $ do
        action
        while condition action

modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f  =  do
    e  <-  readArray a i
    writeArray a i (f e)

zFunction :: String -> UArray Int Int
zFunction s'  =  runSTUArray $ do
    z  <-  newArray (1, n) 0
    writeArray z 1 n
    foldM_ (iter z) (1, 1) [2..n]
    return z
  where
    n  =  length s'
    s  =  listArray (1, n) s' :: UArray Int Char
    iter z (l, r) i  =  do
        when (i <= r) $ do
            zil  <-  readArray z (i-l+1)
            writeArray z i (min zil (r-i+1))
        while (condition z i) $ modifyArray z i (+1)
        zi  <-  readArray z i
        if (i + zi - 1 > r) then
            return (i, i + zi - 1)
        else
            return (l, r)
    condition z i  =  do
        zi  <-  readArray z i
        return (i + zi <= n && s ! (zi + 1) == s ! (i + zi))

solve :: String -> String -> Int
solve s1 s2  =  length $ filter dividerS [1 .. min n1 n2]
  where
    n1  =  length s1
    n2  =  length s2
    z1  =  zFunction s1
    z2  =  zFunction s2
    dividerS  i  =  dividerS1 i && dividerS2 i
    dividerS1 i  =  i == n1
        || n1 `mod` i == 0 && z1 ! (i + 1) == (n1 - i)
    dividerS2 i  =  i == n2
        || n2 `mod` i == 0 && z2 ! (i + 1) == (n2 - i)

main :: IO ()
main  =  liftM2 solve getLine getLine >>= print

import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.List
check s l =
  let (s1, s2) = splitAt l s
  in null s2 || (isPrefixOf s1 s2 && check s2 l)
main = do
  s1 <- getLine
  s2 <- getLine
  let g = gcd (length s1) (length s2)
  arr <- newArray (1, g) (-1) :: IO (IOArray Int Int)
  cnt <- newIORef 0
  forM_ [1..g] $ \i -> do
    v <- readArray arr i
    if v == -1 && g `mod` i == 0 && check s1 i && check s2 i
       then forM_ [1..(g `div` i)] $ \j -> writeArray arr (i*j) 1
       else when (v == -1) $ writeArray arr i 0
    readArray arr i >>= \j -> modifyIORef cnt (+j)
  readIORef cnt >>= print