import Data.List
-- import Debug.Trace
-- the lines function is usefull

-- snake a b lst line
--   | line == a = trace ("one" ++ (show lst)) (lst ++ replicate b '#')
--   | line == 1 = trace ("two" ++ (show lst)) snake a b (lst ++ replicate b '#') (line + 1)
--   | (mod line 2) == 1 = trace ("dkjfdk" ++ (show lst)) snake a b (lst ++ replicate b '#') (line + 1)
--   | (mod line 4) == 2 = trace ("three" ++ (show lst)) snake a b (lst ++ (concat [replicate (b-1) '.', ['#']])) (line + 1)
--   | (mod line 4) == 0 = trace ("four" ++ (show lst)) snake a b (lst ++ (concat [['#'], replicate (b-1) '.'])) (line + 1)
--   | otherwise = trace ("oh" ++ (show line)) lst

snake a b lst line
  | line == a = (lst ++ replicate b '#')
  | line == 1 = snake a b (lst ++ replicate b '#') (line + 1)
  | (mod line 2) == 1 = snake a b (lst ++ replicate b '#') (line + 1)
  | (mod line 4) == 2 = snake a b (lst ++ (concat [replicate (b-1) '.', ['#']])) (line + 1)
  | (mod line 4) == 0 = snake a b (lst ++ (concat [['#'], replicate (b-1) '.'])) (line + 1)
  | otherwise = lst

-- when you get the error: Non-exhaustive patterns in function snake
-- it means that you didn't account for all of the conditional cases
-- in the function

newlst old b nw
  | (null old) = nw
  | otherwise = newlst (drop b old) b (nw ++ [take b old])

main = do
  ss <- getLine
  let aa = (read (head (words ss)))::Int
      bb = (read (last (words ss)))::Int

      ans = snake aa bb [] 1
      -- page 164
  -- mapM print ans
  let actually = newlst ans bb []
  putStrLn (unlines actually)
  -- mapM print ans

module Main (main)
    where

import Data.Bits (xor)

interleave :: [String] -> [String] -> [String]
interleave [s] _ = [s]
interleave (x:xs) (y:ys) = x:y:interleave xs ys

main :: IO ()
main = putStr . unlines . compose . map read . words =<< getLine
    where compose [n,m] = interleave (full n m) (alt m (1::Int))
          full n m = replicate ((n + 1) `div` 2) $ replicate m '#'
          alt m c = turn m c:alt m (c `xor` 1)
          turn m 1 = replicate (m - 1) '.' ++ "#"
          turn m 0 = '#':replicate (m - 1) '.'

main = do
    l <- getLine
    let (n:m:_) = map read $ words l :: [Int]
    putStr $ unlines $ reverse $ func n m

func :: Int -> Int -> [String]
func 0 m = []
func n m = (if odd n then
        replicate m '#'
    else
        if (n `mod` 4) == 0 then
           "#" ++ (replicate (m-1) '.')
        else
            (replicate (m-1) '.') ++ "#") : (func (n-1) m)

full m = (replicate m '#') ++ "\n"
left m = "#"++ (replicate (m-1) '.') ++ "\n"
rigth m = (replicate (m-1) '.') ++ "#" ++"\n"

solve2 n m f | n==0 = ""
             | n==1 = full m
             | f==0 = full m ++ rigth m ++  solve2 (n-2) m 1
             | f==1 = full m ++ left m ++ solve2 (n-2) m 0

main = do
	l <-getLine
	let [n,m] = words l
	putStr $ solve2 (read n) (read m) 0

module Main where

solve :: Char -> [Int] -> [String]
solve z [x, y]
  | x == 0             = []
  | odd x              = bodyN y : solve z [(x-1), y]
  | even x && z == 'R' = bodyR y : solve 'L' [(x-1), y]
  | even x && z == 'L' = bodyL y : solve 'R' [(x-1), y]
    where bodyN n = take n ['#', '#'..]
          bodyR n = (take (n-1) ['.', '.'..]) ++ "#"
          bodyL n = '#' : (take (n-1) ['.', '.'..])

main :: IO ()
main = getLine >>= return . unlines . solve 'R' . (map read) . words >>= putStr

main = do

  [n, m] <- fmap (map read . words) getLine

  let
    a = [[f x y | y <- [1..m]] | x <- [1..n]]
    f x y
      | odd x = '#'
      | odd (x `div` 2) && y == m = '#'
      | even (x `div` 2) && y == 1 = '#'
      | otherwise = '.'

  putStr $ unlines a

import Data.Functor

getInts :: IO [Int]
getInts = map read <$> words <$> getContents

main = getInts >>= mapM putStrLn . solve

solve :: [Int] -> [String]
solve (n:m:[]) = solve' n m 1

solve' n m i
    | i > n = []
    | mod i 2 == 1 = replicate m '#' : la
    | mod i 4 == 2 = (replicate (m-1) '.' ++ "#") : la
    | mod i 4 == 0 = ("#" ++ replicate (m-1) '.') : la
    where la = solve' n m (i+1)

snake :: Int -> Int -> String
snake x y =
	unlines $ fmap (snakeString y) [1..x]
	where
		snakeString :: Int -> Int -> String
		snakeString width row
			| odd row = take width (repeat '#')
			| even row && row `mod` 4 == 2 = (take (width - 1) (repeat '.')) ++ "#"
			| even row && row `mod` 4 == 0  = "#" ++ (take (width - 1) (repeat '.'))

main = do
	[x, y] <- fmap (fmap read . words) getLine
	putStrLn $ snake x y

data Dir = L|R
solve 0 _ _ =[]
solve n m dir
	|odd n=(replicate m '#'):solve (n-1) m (newDir dir)
	|otherwise = (line dir):(solve (n-1) m dir)
	where
		newDir L = R
		newDir R = L
		line L = '#':replicate (m-1) '.'
		line R = (replicate (m-1) '.')++"#"
main=do
	a<-getLine
	let (n:m:_)=map (\x->read x::Int) (words a)
	putStrLn $ unlines $ solve n m L

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ unlines.solve. map read. words. head . lines
solve :: [Int]->[String]
solve [x,y] = take x $ cycle [replicate y '#', replicate (y-1) '.' ++ "#", replicate y '#',"#" ++replicate (y-1) '.']

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import qualified Data.List as List
import qualified Data.Set  as Set
import qualified Data.Char as Char

strip :: String -> String
strip = lstrip . rstrip
   where
     lstrip = dropWhile Char.isSpace
     rstrip = reverse . lstrip . reverse

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

--------------------------------------------------------------------------------

solve n m = foldl (++) "" $ List.intersperse "\n" (doit 0)
  where
    long = List.replicate m '#'
    ev   = '#' : List.replicate (m-1) '.'
    od   = reverse ev
    doit :: Int -> [String]
    doit k | k == (n-1)                   = [long]
           | k `mod` 2 == 0               = long : (doit (k+1))
           | ((k-1) `div` 2) `mod` 2 == 0 = od   : (doit (k+1))
           | otherwise                    = ev   : (doit (k+1))

main :: IO ()
main = do
  [n,m] <- (map read . words) <$> getLine
  putStrLn $ solve n m

generateLine :: Int -> Int -> String
generateLine n m
    | n `mod` 2 == 0 = take m $ repeat '#'
    | n `mod` 4 == 1 = (take (m - 1) $ repeat '.') ++ ['#']
    | otherwise      = '#':(take (m - 1) $ repeat '.')

generateGraph :: Int -> Int -> String
generateGraph n m = unlines $ map (`generateLine` m) (take n [0..])

main = do
    line <- getLine
    let n::Int
        m::Int
        [n, m] = map read $ words line
    putStr $ generateGraph n m

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

solve :: Int -> Int -> [String]
solve n m = take n $ cycle [replicate m '#',
                            replicate (m - 1) '.' ++ ['#'],
                            replicate m '#',
                            '#' : replicate (m - 1) '.']

main :: IO ()
main = do
    [n, m] <- getIntList
    mapM_ putStrLn $ solve n m

import Control.Applicative
import Data.List
import Data.Char

process m n d | m>=n = process (m-n+1) n (d+n)
              | otherwise = d+m

main=do

   [n,m]<- map read <$> words <$> getLine ::IO [Int]
   let a= (replicate (m-1) '.' )++ ['#']
   let b= reverse a
   let c= replicate m '#'
   putStrLn $  take (n*m+(n-1)) $ unlines  $ cycle [c,a,c,b]

main :: IO ()
main = getLine >>= mapM_ putStrLn . solve . map read . words

solve :: [Int] -> [String]
solve [n, m] = [ snake k | k <- [0..n-1] ]
  where snake k | even k = replicate m '#'
                | k `mod` 4 == 1 = replicate (m - 1) '.' ++ "#"
                | otherwise = '#' : replicate (m - 1) '.'
solve _ = undefined

main = interact $ unlines . solve . map read . words
solve [n,m] = take n $ merge (repeat full) (cycle [right,left]) where
  full = replicate m '#'
  left = '#' : replicate (m-1) '.'
  right = replicate (m-1) '.' ++ "#"
merge (x:xs) ys = x : merge ys xs

-- Vicfred
-- https://codeforces.com/problemset/problem/510/A

draw :: [Int] -> [String]
draw (n:m:_) = take n $ cycle [full, right, full, left]
    where full  = replicate m '#'
          left  = '#':replicate (m-1) '.'
          right = reverse left

solve :: String -> String
solve = unlines . draw . map read . words

main :: IO ()
main = interact $ solve

-- Vicfred
-- https://codeforces.com/problemset/problem/510/A

draw :: [Int] -> [String]
draw (n:m:_) = take n $ cycle [full, right, full, left]
    where full  = replicate m '#'
          left  = '#':replicate (m-1) '.'
          right = reverse left

solve :: String -> [String]
solve = draw . map read . words

main :: IO ()
main = do
    input <- getLine
    mapM_ putStrLn $ solve input

main :: IO ()
main = do
  (n:m:_) <- map read . words <$> getLine
  putStrLn $ unlines $ take n $ snake m
  where
    snake m =
      let full = replicate m '#'
          one = '#' : replicate (m-1) '.'
      in full : reverse one : full : one : snake m

import Data.List

main = do
    inp <- getLine
    let [n,m] = map (read :: String -> Int) (words inp)
    putStr (intercalate "\n" (solve n m 0 0))

solve n m r c
    | (n == r) = [""]
    | ((mod r 2) == 0) = (replicate m '#') : (solve n m (r+1) c)
    | ((mod (floor ((fromIntegral r)/2)) 2) == 0) = ((replicate (m-1) '.') ++ "#") : (solve n m (r+1) c)
    | ((mod (floor ((fromIntegral r)/2)) 2) == 1) = ("#" ++ (replicate (m-1) '.')) : (solve n m (r+1) c)

import Control.Applicative
import Control.Monad
import Data.List

main= do
	[m,n]<- map read. words <$> getLine ::IO [Int]
	let f = replicate n '#'
	let s = (replicate (n-1) '.')++"#"
	let t = reverse s
	mapM_ putStrLn $ take m (cycle [f,s,f,t])

module Main where

main :: IO ()
main = do
  line <- getLine
  let [n, m] = map (\c -> read c :: Int) (words line)
  let full = concat $ replicate m "#"
  let right = concat $ (replicate (m - 1) ".") ++ ["#"]
  let left = concat $ ["#"] ++ (replicate (m - 1) ".")
  let ri = [4 * x + 2 | x <- [0 .. n]]
  let li = [4 * x | x <- [0 .. n]]
  let rs = [right | x <- ri]
  let ls = [left | x <- li]
  let zipped = zip rs ls
  let flatted = concatMap (\(r, l) -> [r, l]) zipped
  let odds = [full | x <- [1 .. n], odd x]
  let cc = (zip odds flatted)
  let total = concatMap (\(r, l) -> [r, l]) cc
  let total' = case (even n) of
        True -> total
        False -> total ++ [full]
  mapM_ putStrLn (take n total')

import Data.List

drawRow :: Int -> Int -> String
drawRow m r
    | odd r = replicate m '#'
    | r `mod` 4 == 0 = '#':replicate (m-1) '.'
    | otherwise = reverse $ '#':replicate (m-1) '.'

draw :: Int -> Int -> [String]
draw n m = map (drawRow m) [1..n]

readInt :: String -> Int
readInt = read

readPair :: String -> (Int,Int)
readPair line = (a,b)
    where [a,b] = map readInt $ words line

main = do
    [n,m] <- fmap (map readInt.words) getLine
    sequence . map putStrLn $ draw n m

import Data.List

main = interact $ sol . map read . words

sol [n, m] = intercalate "\n" $ map gen [1..n]
    where gen r
            | odd r = rp m '#'
            | otherwise = if odd (r `div` 2) then rp (m-1) '.' ++ "#"
                                             else "#" ++ rp (m-1) '.'
          rp = replicate

import Data.List

draw :: [Int] -> [String]
draw (n:m:_) = take n $ cycle [full, right, full, left]
    where full = replicate m '#'
          left = '#': replicate (m - 1) '.'
          right = reverse left

solve :: String -> String
solve = unlines . draw . fmap read . words

main :: IO ()
main= interact $ solve

drawLine :: Int -> Int -> String
drawLine n i
        | even i = replicate n '#'
        | even $ quot i 2 = (replicate (n - 1) '.') ++ "#"
        | otherwise = '#' : (replicate (n - 1) '.')

solve :: String -> String
solve s = unlines $ fmap (drawLine m) [0.. (n -1)]
    where (n:m:_) = fmap read . words $ s

main :: IO ()
main= interact $ solve

duplicate c 0 = []
duplicate c n = c : duplicate c (n - 1)

gen m 0 = duplicate '#' m
gen m 1 = (duplicate '.' (m - 1)) ++ "#"
gen m 2 = gen m 0
gen m 3 = '#' : duplicate '.' (m - 1)

main = do
  input <- getLine
  let n : m : [] = map read $ words input :: [Int]
  doOutput n m 0

doOutput n m c
  | c + 1 == n    = putStrLn $ gen m (c `mod` 4)
  | otherwise = (putStrLn $ gen m (c `mod` 4)) >> doOutput n m (c + 1)

readInt :: String -> Int
readInt = read

line :: Int -> Int -> String
line i m
    | i `mod` 2 == 0 = replicate m '#'
    | i `mod` 4 == 1 = replicate (m-1) '.' ++ "#"
    | otherwise = '#':replicate (m-1) '.'

main :: IO ()
main = do
    x <- getLine
    let mn = map readInt $ words x
    let n = head mn
    let m = head $ tail mn
    let drawLine i = putStrLn $ line i m
    mapM_ drawLine $ take n (iterate (+1) 0)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import qualified Data.List as List
import qualified Data.Set  as Set
import qualified Data.Char as Char

strip :: String -> String
strip = lstrip . rstrip
   where
     lstrip = dropWhile Char.isSpace
     rstrip = reverse . lstrip . reverse

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

--------------------------------------------------------------------------------

solve n m = foldl (++) "" $ List.intersperse "\n" (doit n)
  where
    long = List.replicate m '#'
    ev   = '#' : List.replicate (m-1) '.'
    od   = reverse ev
    doit :: Int -> [String]
    doit k | k == 1                       = [long]
           | k `mod` 2 == 1               = long : (doit (k-1))
           | ((k-1) `div` 2) `mod` 2 == 0 = od   : (doit (k-1))
           | otherwise                    = ev   : (doit (k-1))

main :: IO ()
main = do
  [n,m] <- (map read . words) <$> getLine
  putStrLn $ solve n m

module Main where

main :: IO ()
main = do
  line <- getLine
  let [n, m] = map (\c -> read c :: Int) (words line)
  let full = concat $ replicate m "#"
  let right = concat $ (replicate (m - 1) ".") ++ ["#"]
  let left = concat $ ["#"] ++ (replicate (m - 1) ".")
  let rs = [right | x <- [2 .. n], even (x - 2)]
  let ls = [left | x <- [4 .. n], even (x - 4)]
  let zipped = zip rs ls
  let flatted = concatMap (\(r, l) -> [r, l]) zipped
  let odds = [full | x <- [1 .. n], odd x]
  let total = concatMap (\(r, l) -> [r, l]) (zip odds flatted)
  let total' = case (even n) of
        True -> total
        False -> total ++ [full]
  mapM_ putStrLn (take n total')

drawLine :: Int -> Int -> String
drawLine n i
        | even i = replicate n '#'
        | even $ quot i 2 = (replicate (n - 1) '.') ++ "#"
        | otherwise = '#' : (replicate (n - 1) '.')

solve :: String -> String
solve s = unlines $ fmap (drawLine n) [0.. (m -1)]
    where (n:m:_) = fmap read . words $ s

main :: IO ()
main= interact $ solve


import Control.Arrow ((>>>))
import System.IO

main = do
  hSetBuffering stdout NoBuffering
  interact $
    lines
      >>> (\(nt : ls) -> head (words nt) : ls)
      >>> map read
      >>> solve
      >>> map show
      >>> unlines

data Query = Ask Int Int | Answer Int

instance Show Query where
  show (Ask l r) = "? " ++ show l ++ " " ++ show r
  show (Answer x) = "! " ++ show x

solve :: [Int] -> [Query]
solve (n : k : rs) = go 1 n rs
  where
    go lo hi ~(r : rs)
      | lo == hi = [Answer lo]
      | otherwise = Ask 1 mid : go lo' hi' rs
      where
        mid = (lo + hi) `div` 2
        (lo', hi') = if r + k > mid then (mid + 1, hi) else (lo, mid)

import Control.Arrow ((>>>))
import System.IO

main = do
  hSetBuffering stdout NoBuffering
  interact $
    lines >>> (\(nt:ls) -> head (words nt) : ls) >>> map read >>> solve >>> map show >>> unlines

data Query = Ask Int Int | Answer Int

instance Show Query where
  show (Ask l r) = "? " ++ show l ++ " " ++ show r
  show (Answer x) = "! " ++ show x

solve :: [Int] -> [Query]
solve (n:k:rs) = go 1 n rs
  where
    go lo hi xs
      | lo == hi = [Answer lo]
      | otherwise =
        let mid = (lo + hi) `div` 2
         in Ask 1 mid :
            (let (lo', hi') = (if head xs + k > mid then (mid + 1, hi) else (lo, mid))
              in go lo' hi' (tail xs))

import Control.Arrow
import System.IO

main = do
  hSetBuffering stdout NoBuffering
  interact $
         lines >>> (\(nt:ls) -> (head $ words nt) : ls)
         >>> map read >>> solve >>> map show >>> unlines

data Query = Ask Int Int | Answer Int

instance Show Query where
  show (Ask l r) = "? " ++ show l ++ " " ++ show r
  show (Answer x) = "! " ++ show x

solve :: [Int] -> [Query]
solve (n:k:rs) = go 1 n rs
  where
    go lo hi xs
      | lo == hi = [Answer lo]
      | otherwise = let mid = (lo + hi) `div` 2
                    in (Ask 1 mid) :
                      (if head xs + k > mid then go (mid + 1) hi else go lo mid) (tail xs)

import Control.Arrow
import System.IO

main = do
  hSetBuffering stdout NoBuffering
  hSetBuffering stdin NoBuffering
  interact $
         lines >>> (\(nt:ls) -> (head $ words nt) : ls)
         >>> map read >>> solve >>> map show >>> unlines

data Query = Ask Int Int | Answer Int

instance Show Query where
  show (Ask l r) = "? " ++ show l ++ " " ++ show r
  show (Answer x) = "! " ++ show x

solve :: [Int] -> [Query]
solve (n:k:rs) = go 1 n rs
  where
    go lo hi xs
      | lo == hi = [Answer lo]
      | otherwise = let mid = (lo + hi) `div` 2
                    in (Ask 1 mid) :
                      (if head xs + k > mid then go (mid + 1) hi else go lo mid) (tail xs)


import Data.Word
import qualified Data.IntMap as M

main =
    interact
    $ show
    . snd
    . foldr
        ( \x (m, a) ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [30, 29 ..]])
        ) (M.empty, 0 :: Word64)
    . tail
    . map read
    . words

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

import qualified Data.Map.Strict as Map

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	as <- getList
	let m = foldl' ( \m a -> Map.insertWith (+) a 1 m ) Map.empty as
	print $ sum $ solve m as

solve _ [a] = [0]
solve m (a:as) = res : solve nm as
	where
	nm = Map.adjust pred a m
	f = fromMaybe 0 . flip Map.lookup nm
	res = sum $ map f [ pow 2 k - a | k <- [ 0 .. 32 ] ]

pow _ 0 = 1
pow a k = a * pow a ( k - 1 )

import Data.Word
import qualified Data.IntMap as M

main =
    getContents
    >>= print
    . snd
    . foldr
        ( \x (m, a) ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [31, 30 ..]])
        ) (M.empty :: M.IntMap Word64, 0)
    . tail
    . map read
    . words

import Data.Int
import Data.List
import qualified Data.IntMap as M

main =
    getContents
    >>= print
    . snd
    . foldl'
        ( \(m, a) x ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [31, 30 ..]])
        ) (M.empty :: M.IntMap Int64, 0)
    . tail
    . map read
    . words

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

main =
    getContents
    >>= print
    . snd
    . foldl'
        ( \(m, a) x ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [31, 30 ..]])
        ) (M.empty :: M.Map Int Int64, 0 :: Int64)
    . tail
    . map read
    . words

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.Map as Map

toint :: String -> Integer
toint = read

counter a = foldl' (\s x -> Map.insertWith (+) x 1 s) Map.empty a

main = getLine >> getLine >>= print . solve . map toint . words

solve a = sum [f x p | x <- a, p <- [2 ^ i | i <- [0 .. 30]]] `quot` 2
    where
        cnt = counter a
        get = fromMaybe 0 . flip Map.lookup cnt
        f x p = let y = p - x in if x == y then get y - 1 else get y

import Data.Int
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import Data.Bits

fast_read_Int = fmap (map (fst . fromJust . BS8.readInt) . BS8.words) BS.getLine :: IO [Int]
fast_read_Int64 = fmap (map (fromIntegral . fst . fromJust . BS8.readInteger) . BS8.words) BS.getLine :: IO [Int64]

citesc_nr :: String -> Int64
citesc_nr s = read s

--insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
f :: Map.Map Int64 Int64 -> Int64 -> Map.Map Int64 Int64
f book x = Map.insertWith (+) x 1 book

main = do
    x <- getLine
    let n = citesc_nr x
    array <- fast_read_Int64
    let map_freq = foldl f Map.empty array:: Map.Map Int64 Int64
    print $ solve map_freq array

solve :: Map.Map Int64 Int64 -> [Int64] -> Int64
solve map_frec keys = (sum $ map calc' keys) `div` 2  where
    calc' keys = sum $ map (calc keys) [1..30] :: Int64
    calc x i
        | complement <= 0 = 0
        | complement `Map.notMember` map_frec = 0
        | complement == x = (map_frec Map.! complement) - 1
        | otherwise = map_frec Map.! complement
        where complement = bit i - x

import qualified Data.IntMap as M
import Data.Word
type Bag = M.IntMap Int
powersOfTwo = map (2^) [0..30]
add :: Int -> (Word64, Bag) -> (Word64, Bag)
add x (s, b) = (s + fromIntegral q, M.insertWith (const (+1)) x 1 b)
    where q = sum . map (\k -> M.findWithDefault 0 k b) $ map (subtract x) powersOfTwo
solve :: [Int] -> Word64
solve = fst . foldr add (0, M.empty)
main = getLine >> getLine >>= putStrLn . show . solve . map read . words

import Data.Maybe
--import Data.Array
import Data.Bits
import Data.List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    n <- getInt
    ns <- getInts
    let book = foldl mkBook Map.empty ns :: Map.Map Int Int
    print $ solve book ns

mkBook book x = Map.insertWith (+) x 1 book

solve :: Map.Map Int Int -> [Int] -> Integer
solve book xs = (sum $ map numSoln xs) `div` 2 where
    numSoln x = sum $ map (fromIntegral . calc x) [1..30] :: Integer
    calc x pos
        | goal <= 0 = 0
        | goal `Map.notMember` book = 0
        | goal == x = (book Map.! goal) - 1
        | otherwise = book Map.! goal
        where goal = bit pos - x

import Data.Maybe
import Data.Array
import Data.Bits
import Data.List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    n <- getInt
    ns <- sort `fmap` getInts
    let (is_pow2, not_pow2) = partition pow2 ns
    let len = length is_pow2
    let ns' = listArray (1,n) not_pow2 :: Array Int Int
    print $ ((len * (len - 1)) `div` 2) + length (solve ns' (length not_pow2))

pow2 :: Int -> Bool
pow2 x = (x .&. (x-1)) == 0

solve :: Array Int Int -> Int -> [Int]
solve ns n = filter pow2 [(ns ! i) + (ns ! j) | i <- [1..n], j <- [i+1..n]]

import Data.Maybe
import Data.Array
import Data.Bits
import Data.List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    n <- getInt
    ns <- sort `fmap` getInts
    let (is_pow2, not_pow2) = partition pow2 ns
    let len = length is_pow2
    let ns' = listArray (1,n) not_pow2 :: Array Int Int
    print $ len * (len - 1) + length (solve ns' (length not_pow2))

pow2 :: Int -> Bool
pow2 x = (x .&. (x-1)) == 0

solve :: Array Int Int -> Int -> [Int]
solve ns n = filter pow2 [(ns ! i) + (ns ! j) | i <- [1..n], j <- [i+1..n]]

import Data.Maybe
import Data.Bits
import Data.List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

main = do
    n <- getInt
    ns <- getInts
    let book = foldl mkBook Map.empty ns :: Map.Map Int Int
    print $ solve book ns

mkBook book x = Map.insertWith (+) x 1 book

solve :: Map.Map Int Int -> [Int] -> Int
solve book xs = (sum $ map numSoln xs) `div` 2 where
    numSoln x = sum $ map (calc x) [1..30]
    calc x pos
        | goal <= 0 = 0
        | goal `Map.notMember` book = 0
        | goal == x = (book Map.! goal) - 1
        | otherwise = book Map.! goal
        where goal = bit pos - x

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

import qualified Data.Map.Strict as Map

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	as <- getList
	let m = foldl' ( \m a -> Map.insertWith (+) a 1 m ) Map.empty as
	print $ sum $ solve m as

solve _ [a] = [0]
solve m (a:as) = res : solve nm as
	where
	nm = Map.insertWith (-) a 1 m
	f = fromMaybe 0 . flip Map.lookup nm
	res = sum $ map f [ pow 2 k - a | k <- [ 0 .. 32 ] ]

pow _ 0 = 1
pow a k = a * pow a ( k - 1 )

import qualified Data.Set as S

main = do
    xs <- fmap (tail . map read . words) getContents
    let s = S.fromList xs
    print . (`div` 2) . length $ filter id [y `S.member` s | x <- xs, y <- takeWhile (> 0) [x - 2 ^ k | k <- [0 :: Int ..]]]

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

main =print (maxBound :: Int)
    {-getContents
    >>= print
    . snd
    . foldl'
        ( \(m, a) x ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [31, 30 ..]])
        ) (M.empty :: M.Map Int Int, 0)
    . tail
    . map read
    . words-}

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

main =
    getContents
    >>= print
    . snd
    . foldl'
        ( \(m, a) x ->
            ( M.insertWith (+) x 1 m
            , (+ a) . sum . map (flip (M.findWithDefault 0) m)
            $ takeWhile (> 0) [2 ^ k - x | k <- [31, 30 ..]])
        ) (M.empty :: M.Map Int Int, 0)
    . tail
    . map read
    . words

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.Map as Map

toint :: String -> Int
toint = read

counter a = foldl' (\s x -> Map.insertWith (+) x 1 s) Map.empty a

main = getLine >> getLine >>= print . solve . map toint . words

solve :: [Int] -> Int
solve a = sum [f x p | x <- a, p <- [2 ^ i | i <- [0 .. 30]]] `quot` 2
    where
        cnt = counter a
        get = fromMaybe 0 . flip Map.lookup cnt
        f x p = let y = p - x in if x == y then get y - 1 else get y

import qualified Data.IntMap as M
type Bag = M.IntMap Int
powersOfTwo = map (2^) [0..30]
add :: Int -> (Int, Bag) -> (Int, Bag)
add x (s, b) = (s + q, M.insertWith (const . (+1)) x 1 b)
    where q = sum . map (\k -> M.findWithDefault 0 k b) $ map (subtract x) powersOfTwo
solve :: [Int] -> Int
solve = fst . foldr add (0, M.empty)
main = getLine >> getLine >>= putStrLn . show . solve . map read . words

import qualified Data.IntMap as M
type Bag = M.IntMap Int
powersOfTwo = map (2^) [0..30]
add :: Int -> (Int, Bag) -> (Int, Bag)
add x (s, b) = (s + q, M.insertWith (const (+1)) x 1 b)
    where q = sum . map (\k -> M.findWithDefault 0 k b) $ map (subtract x) powersOfTwo
solve :: [Int] -> Int
solve = fst . foldr add (0, M.empty)
main = getLine >> getLine >>= putStrLn . show . solve . map read . words


import qualified Data.Map as M
import Data.Map((!))

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

result :: [String] -> [String]
result list
	| i0 == i1 && i0 > 0 = add0 (i0-1, j0) $ add0 (i0-1, j1) list
	| i0 == 0 && i1 == 0 = add0 (1, j0) $ add0 (1, j1) list
	| j0 == j1 && j0 > 0 = add0 (i1, j0-1) $ add0 (i0, j1-1) list
	| j0 == 0 && j1 == 0 = add0 (i1, 1) $ add0 (i0, 1) list
	| otherwise = add0 (i1, j0) $ add0 (i0, j1) list
	where
		[(i0, j0), (i1, j1)] = foldr aux0 [] $ zip [0..] list
		aux0 (i, str) list = (foldr (aux1 i) list $ zip [0..] str)

		aux1 i (j, c) l = if c == '*' then (i, j):l else l

		add0 (0, j) (x:xs) = (add1 j x) : xs
		add0 (i, j) (x:xs) = x : add0 (i-1, j) xs

		add1 0 (x:xs) = '*' : xs
		add1 j (x:xs) = x : add1 (j-1) xs

showR :: [String] -> String
showR (x:xs) = x ++ "\n" ++ showR xs
showR [] = ""

main = do
	t <- getLine >>= return . read :: IO Int
	let loop1 n = if n == 0 then return [] else do
		l <- getLine
		l' <- loop1 $ n - 1
		return $ l : l'

	let loop0 t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Int
		loop1 n >>= putStr . showR . result
		loop0 $ t - 1

	loop0 t

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import Control.Applicative
import Data.Functor
import Control.Monad
import Data.Foldable

main :: IO ()
main = do
  contents <- getContents
  let inputs = map mungeSquare . mungeInput $ contents
  for_ inputs \input@(size,_,_) ->
    let (rc1', rc2') = f input in
      putStr $ showSquare size rc1' rc2'

mungeInput :: String -> [[String]]
mungeInput = go . tail . lines where
  go (a:rest) = square : go rest' where
    (square, rest') = splitAt (read a) rest
  go _ = []

-- Row/column coordinates
mungeSquare :: [String] -> (Int, (Int, Int), (Int, Int)) -- (size, (r1, c1), (r2, c2))
mungeSquare s = (length s, star1, star2)
  where
    (star1, star2) = case stars of
      [s1, s2] -> (s1, s2)
      _ -> error "No stars found"
    stars = do
      (r, row) <- zip [1..] s
      (c, cell) <- zip [1..] row
      guard (cell == '*')
      pure (r, c)

showSquare :: Int -> (Int, Int) -> (Int, Int) -> String
showSquare size (r1, c1) (r2, c2) = unlines $
  [1 .. size] <&> \r ->
    [1 .. size] <&> \c ->
      if (r == r1 || r == r2) && (c == c1 || c == c2)
        then '*' else '.'

-- (r1, c1) and (r2, c2) are guaranteed to be distinct.
-- (r1, c1) and (r2, c2) are lexicographically ordered.
f :: (Int, (Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int))
f (size, (r1, c1), (r2, c2))
  | r1 /= r2 && c1 /= c2 = ((r1, c1), (r2, c2))

  -- e.g.
  -- . . . .
  -- . * * .
  -- . . . .
  -- . . . .
  | r1 == r2 = if
    | r1 == 1 -> ((r1, c1), (2, c2))
    | r1 > 1 -> ((1, c1), (r2, c2))

  -- e.g.
  -- . . . .
  -- . * . .
  -- . * . .
  -- . . . .
  | c1 == c2 = if
    | c1 == 1 -> ((r1, c1), (r2, 2))
    | c1 > 1 -> ((r1, 1), (r2, c2))

{-# LANGUAGE TupleSections #-}
import Data.List
import Control.Monad

posStr n lst = posBuild 0 0 "" []
  where
    posBuild x y line result
      | y == n = reverse result
      | x == n = posBuild 0 (y + 1) "" (reverse line : result)
      | (x, y) `elem` lst = posBuild (x + 1) y ('*' : line) result
      | otherwise = posBuild (x + 1) y ('.' : line) result

posAdd pos@[(x0, y0), (x1, y1)]
  | x0 > x1 && y0 < y1 = pos ++ [(x0, y1), (x1, y0)]
  | x0 == x1 && x0 == 0 = pos ++ [(x0 + 1, y0), (x0 + 1, y1)]
  | y0 == y1 && y0 == 0 = pos ++ [(x0, y0 + 1), (x1, y0 + 1)]
  | x0 == x1 = pos ++ [(x0 - 1, y0), (x0 - 1, y1)]
  | y0 == y1 = pos ++ [(x0, y0 - 1), (x1, y0 - 1)]
  | otherwise = pos ++ [(x0, y1), (x1, y0)]

posParser lst = innerx lst 0 []
  where
    innerx []     _ result = result
    innerx (x0:xs) y result =
      let addResult = map (, y) $ '*' `elemIndices` x0 in
      innerx xs (y + 1) (result ++ addResult)

main = do
  n <- read <$> getLine
  replicateM_ n $ do
    m <- read <$> getLine
    lst <- replicateM m getLine
    mapM_ putStrLn $ posStr m $ posAdd $ posParser lst

import qualified Data.Map as M
import Data.Map((!))

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

result :: [String] -> [String]
result list = add0 (i1, j0) $ add0 (i0, j1) list where
	[(i0, j0), (i1, j1)] = foldr aux0 [] $ zip [0..] list
	aux0 (i, str) list = (foldr (aux1 i) list $ zip [0..] str)

	aux1 i (j, c) l = if c == '*' then (i, j):l else l

	add0 (0, j) (x:xs) = (add1 j x) : xs
	add0 (i, j) (x:xs) = x : add0 (i-1, j) xs

	add1 0 (x:xs) = '*' : xs
	add1 j (x:xs) = x : add1 (j-1) xs

showR :: [String] -> String
showR (x:xs) = x ++ "\n" ++ showR xs
showR [] = ""

main = do
	t <- getLine >>= return . read :: IO Int
	let loop1 n = if n == 0 then return [] else do
		l <- getLine
		l' <- loop1 $ n - 1
		return $ l : l'

	let loop0 t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Int
		loop1 n >>= putStr . showR . result
		loop0 $ t - 1

	loop0 t


solve :: Int -> Int
solve n = 1 + div n 2

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

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

onecase = do
		x<- read <$> getLine ::IO Int
		print$ (+1) $ div x 2
main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  print $ n `div` 2 + 1

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let n = read s :: Integer
        print $ n `div` 2 + 1

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

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

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

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

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

onecase = do
		x<- read <$> getLine ::IO Int
		print$ (+1) $ div (x+1) 2
main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase


-- Bartosz Bednarczyk

import Control.Monad

solve :: [Int] -> [ [Int] ] -> Int
solve xs ys = foldr (+) 0 $ map (\[x,y] -> min (xs !! (x-1)) (xs !! (y-1)) ) ys

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

main = do
  [n, m] <- readInts
  xs <- readInts
  ys <- replicateM (read (show m)) readInts
  putStrLn $ show $ solve xs ys

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

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

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

main = do
  [n, m] <- getInts
  vs <- getInts
  es <- replicateM m getInts

  let vsa = listArray (1, n) vs

  print $ sum $ map (\[u, v] -> min (vsa!u) (vsa!v)) es

convert_edges :: [Integer] -> [(Int, Int)] -> [(Int, Int)]
convert_edges weight edges =
  map (\(u, v) -> if (weight !! u > weight !! v) then (u, v) else (v, u)) edges

solve :: [Integer] -> [(Int, Int)] -> Integer
solve weight edges = iter $ convert_edges weight edges
  where
    iter :: [(Int, Int)] -> Integer
    iter rem
      | null rem = 0
      | otherwise = (weight !! (snd $ head rem)) + (iter $ tail rem)

main = do
  contents <- getContents
  let
    buf = lines contents
    [n, m] = map (read :: String -> Int) $ words $ head buf
    weight = -1:(map (read :: String -> Integer) $ words $ head $ tail buf)
    edges = map ((\[u, v] -> (u, v)) . (map (read :: String -> Int)) . words) (tail $ tail buf)
    in putStrLn $ show $ solve weight edges

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)

import           Prelude hiding (sum)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

main :: IO ()
main = do
  [n, m] <- getInts
  vs <- listArray (1, n) <$> getInts :: IO (UArray Int Int)
  cs <- replicateM m $ do
    [f, t] <- getInts
    return $ min (vs!f) (vs!t)
  print $ sum cs


split :: Int -> (Int, Int, Int)
split 3 = (1, 1, 1)
split x
    | x `mod` 3 == 0 = (1, 1, x - 2)
    | otherwise = (1, 2, x - 3)

main :: IO ()
main = do
    x <- (fmap read getLine) :: IO Int
    let (a, b, c) = split x
    putStrLn $ show a ++ " " ++ show b ++ " " ++ show c

{-# LANGUAGE Safe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Control.Applicative
import Control.Arrow
import Data.List
import Data.Array
import Data.Array.IO.Safe
import Data.Array.ST.Safe
import Data.IORef
import Data.STRef
import Data.Maybe
import Data.Bits
import Data.Ord
import Data.Ratio
import Data.Int
import Data.Char
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as Set
import qualified Data.Sequence as Sq
import Data.Tuple
import Data.Function
import Text.Printf
--import Debug.Trace
import Numeric

readIntBS = fst . fromJust . BS.readInt

infixr 1 ?
(?) :: Bool -> (a,a) -> a
(?) b t = (if b then fst else snd) t

main = do
  n <- readLn :: IO Int

  printf "%d %d %d\n" (1::Int) (1+(if (n-2)`mod`3==0 then 1 else 0) :: Int) (n-2-(if (n-2)`mod`3==0 then 1 else 0))

main = do
       e1<-getLine
       let x=read e1::Integer
           a=1
           b= if (x-2) `mod` 3==0 then 2 else 1
           c=x-a-b
       putStrLn $ show(a)++" "++show(b)++" "++show(c)

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= put

put = putStrLn . unwords . fmap show

sol n
    | n `mod` 3==0  = [1,1,n-2]
    | otherwise     = [1,2,n-3]

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

process n | mod n 3 <2  = do
				putStr "1 1 "
				putStrLn $ show (n-2)
	  | otherwise  = do
				putStr "1 2 "
				putStrLn $ show (n-3)

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

main = do
    n <- readLn :: IO Integer
    putStrLn $ solve n

solve :: Integer -> String
solve n
 | mod (n-2) 3 > 0 = "1 1 " ++ show (n-2)
 | otherwise = "1 2 " ++ show (n-3)

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | (n - 2) `mod` 3 /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]

process :: Int -> (Int, Int, Int)
process n
    | m == 0 = (1,1,n-2)
    | otherwise = (1,2,n-3)
    where m = n `mod` 3

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    let (a,b,c) = process n
    putStrLn (show a ++ " " ++ show b ++ " " ++ show c)

main = do
       e1<-getLine
       let x=read e1::Int
           a=(x `div` 3)
           b=a
           c=x-a-b
       putStrLn $ show(a)++" "++show(b)++" "++show(c)

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= put

put = putStrLn . unwords . fmap show

sol n = [m,m,n-2*m] where m = n `div` 3

main = interact $ unwords . map show . solve . read
solve n = case d `mod` 3 of
            0 -> [d+2,d-1,d-1]
            1 -> [d,d,d+1]
            2 -> [d,d,d+2]
  where d = n `div` 3

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | (n - 2 `mod` 3) /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]

main = do
  n <- read `fmap` getLine :: IO Integer
  putStrLn $ foldl (++) "" $ map ((++ " ") . show) $ solve n

solve :: Integer -> [Integer]
solve n
  | n - 2 `mod` 3 /= 0 = [n-2, 1, 1]
  | otherwise = [n-3, 1, 2]


import Data.List (foldl')
import qualified Data.Map as M

main :: IO ()
main = getContents >>= printSolution . solve . map (toTuple . words) . tail . lines

solve :: [(String, String)] -> [(String, String)]
solve = M.toList . foldl' (\m (a, b) -> M.insert b (M.findWithDefault a a m) $ M.delete a m) M.empty

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

printSolution :: [(String, String)] -> IO ()
printSolution xs = print (length xs) >> mapM_ (\(a, b) -> putStrLn $ b ++ " " ++ a) xs

import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Applicative

main = getContents >>= putStrLn . solve . tail . words

solve :: [String] -> String
solve rs = unlines $ [show $ Set.size s] ++ [upwrap (Map.lookup x m) ++ " " ++ x | x <- Set.toList s]
    where (s, m) = solve' $ reverse rs
          upwrap (Just x) = x

solve' :: [String] -> (Set.Set String, Map.Map String String)
solve' [] = (Set.empty, Map.empty)
solve' (y:x:rs) = (s', m')
    where (s, m) = solve' rs
          s' = Set.delete x . Set.insert y $ s
          m' = case Map.lookup x m of
            Nothing -> Map.insert y x m
            Just z -> Map.insert y z m
solve' _ = (Set.fromList ["a","b"], Map.fromList [("a","A"), ("b","B")])

main = interact $ f [] . tail . words
f m (a:b:c) = f (g m a b) c
f m _ = unlines $ (show $ length m) : map unwords m
g ([m,n]:o) a b | n == a = [m,b]:o | otherwise = [m,n]:g o a b
g _ a b = [[a,b]]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
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 =  getLine >>= \n -> (mapM_ C.putStrLn).solve =<< (forM [1..read n] $ \ i ->C.getLine>>= \js -> let [a,b] = C.words js in return $ (a,b) )
solve xs = let ms=slv1 (Map.empty) xs in  [(C.pack $ show $ Map.size ms)] ++map (\(a,b)-> C.unwords [b, a]) (Map.toList ms)
slv1 ms [] = ms
slv1 ms ((x1,x2):xs) = slv1 fm xs
  where
  fm= let m =  Map.lookup x1 ms in if m == Nothing then Map.insert x2 x1 ms else  Map.delete x1 $ Map.insert x2 (fromJust m) ms

import qualified Data.Map.Strict as M
import Control.Applicative
import Control.Monad
import Data.List

main = do
    n <- readLn :: IO Int
    ns <- replicateM n ( words <$> getLine )
    let as = foldl' (\acc [k,v] ->  let b = M.filter (==k) acc
                                    in if b == M.empty
                                        then M.insert k v acc
                                        else let (e,f) = head $ M.toList b in M.alter (\_ -> Just v) e acc
                                    ) M.empty ns
    print $ M.size as
    mapM_ (putStrLn . uncurry (\a b -> a ++ " " ++ b)) $ M.toList  as

import Data.List (foldl')
import qualified Data.Map as M

main :: IO ()
main = getContents >>= printSolution . solve . map words . tail . lines

solve :: [[String]] -> [[String]]
solve = map (\(b, a) -> [a, b]) . M.toList . foldl' (\m [a, b] -> M.insert b (M.findWithDefault a a m) $ M.delete a m) M.empty

printSolution :: [[String]] -> IO ()
printSolution xs = print (length xs) >> mapM_ (putStrLn . unwords) xs


import Data.List (elemIndex, delete)
access :: (Int, ([Int], [Int])) -> (Int, ([Int], [Int]))
access (res, (row, (q:qs))) = (res + pos, (q : (delete q row), qs))
    where pos = case elemIndex q row of Just x -> x + 1
solve :: [Int] -> [Int] -> Int
solve rs xs = fst . until (null . snd . snd) access $ (0, (rs, xs))
norm = map read . words
main = do
    getLine
    row <- getLine
    queries <- getContents
    putStrLn . show $ solve (norm row) (norm queries)

import Control.Monad
import Control.Applicative
import Data.List (delete)

findPos (x:xs) v ind
  | x == v = ind
  | otherwise = findPos xs v (ind+1)

buy xs v = (cost+1,xs')
  where
    cost = findPos xs v 0
    xs' = v : delete v xs

process [] _ total = total
process (o:orders) xs total = process orders xs' (total+cost)
  where
    (cost, xs') = buy xs o

main = do
  [n,m,k] <- map read . words <$> getLine :: IO [Int]
  xs <- map read . words <$> getLine :: IO [Int]

  aa <- replicateM n getLine
  let orders = map read $ concat $ map words aa :: [Int]

  print $ process orders xs 0

import Data.List (elemIndex, delete)
solve :: [Int] -> [Int] -> Int
solve _ [] = 0
solve xs (q:qs) = pos + solve (q : delete q xs) qs
    where pos = case elemIndex q xs of Just p -> p + 1
main = do
    getLine
    row <- getLine
    queries <- getContents
    putStrLn . show $ solve (norm row) (norm queries)
    where norm = map read . words


import Prelude hiding (lookup)
import Data.Char
import Data.List hiding (lookup)
import Data.Map (fromList, insertWith, lookup)
import System.IO

fromJust :: Maybe a -> a
fromJust (Just a) = a
fromJust _ = undefined

getWord' :: String -> IO (String)
getWord' "" = do ch <- getChar ; eof <- isEOF
                 if eof then return "" else if isSpace ch then getWord' "" else getWord' [ch]
getWord' chs = do ch <- getChar ; eof <- isEOF
                  if eof then return chs else if isSpace ch then return chs else getWord' (chs ++ [ch])

getWord = getWord' ""

getInt :: IO (Int)
getInt = fmap read getWord

getInts' 0 acc = return acc
getInts' n acc = do x <- getInt ; getInts' (n-1) (acc ++ [x])

getInts :: Int -> IO ([Int])
getInts n = getInts' n []

-- SOLUTION

count xs = foldl f (fromList []) xs
           where f acc x = insertWith (+) x 1 acc

iter xs = map f xs
          where f x = fromJust (lookup x (count xs))

data Query = Query {
      posQuery :: Int
    , kQuery :: Int
    , idxQuery :: Int
    } deriving (Show)

type QResult = (Query, Int)

getQuery i n xs | i == n = return xs
getQuery i n xs = do
    idx <- getInt
    k <- getInt
    getQuery (i+1) n (xs ++ [Query i k (idx-1)])

getQueries = do
    q <- getInt
    getQuery 0 q []

sortQueries qs f = sortBy compareQueries qs
                 where compareQueries a b = compare (f a) (f b)
sortByK qs = sortQueries qs kQuery

sortResults qs = sortBy f qs
                 where f (a, _) (b, _) = compare (posQuery a) (posQuery b)

calcQueries :: [Query] -> [Int] -> Int -> Int -> [QResult] -> [QResult]
calcQueries [] _ _ _ res = res
calcQueries (q:qs) xs k n res
    | (k == (kQuery q)) || (k >= n) = calcQueries qs xs k n (res ++ [(q, xs !! (idxQuery q))])
calcQueries qs xs k n res = calcQueries qs (iter xs) (k+1) n res

putRes :: QResult -> IO ()
putRes res = do putStrLn (show (snd res))

forEach :: [a] -> (a -> IO ()) -> IO ()
forEach [] _ = return ()
forEach (x:xs) a = do a x; forEach xs a

--2
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

maxK n = 2 * (isqrt (2*n))

iterNums :: [[Int]] -> Int -> [[Int]]
iterNums rs target | ((length rs)-1) < target = iterNums (rs ++ [iter (last rs)]) target
iterNums rs target = rs

getRes :: [[Int]] -> Int -> Int -> Int
getRes rs idx k = (rs !! k) !! (idx-1)

doQuery :: [[Int]] -> Int -> Int -> IO ()
doQuery _ _ 0 = return ()
doQuery rs mK i = do
    idx <- getInt
    k <- getInt
    let nk = min k mK
    let nrs = iterNums rs nk
    putStrLn (show (getRes nrs idx nk))
    doQuery nrs mK (i-1)

loop :: IO () -> Int -> IO ()
loop a 0 = return ()
loop a n = do a; loop a (n-1)

doTests 0 = return ()
doTests t = do
    n <- getInt
    nums <- getInts n
    q <- getInt
    doQuery [nums] (maxK n) q
    doTests (t-1)

main = do t <- getInt ; doTests t

import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntMap as Map
import Data.List (sort)
import Data.Maybe (fromJust)

main = do
  t <- readInt <$> BS.getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- BS.getLine
    xs <- map readInt . BS8.words <$> BS.getLine
    let xss = solve xs
    let lxss = length xss - 1
    q <- readInt <$> BS.getLine
    forM_ [1 .. q] $ \_ -> do
      [xi, ki] <- map readInt . BS8.words <$> BS.getLine
      print $ (xss !! min lxss ki) !! (xi - 1)

solve :: [Int] -> [[Int]]
solve xs = do
  let freq = foldl (\m x -> Map.insertWith (+) x 1 m) Map.empty xs
  let xs' = map (\x -> fromJust (Map.lookup x freq)) xs
  if xs == xs' then [xs] else xs : solve xs'

readInt = fst . fromJust . BS8.readInt

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type PII = (Int, Int)

data TC = TC {n :: Int, as :: [Int], qs :: [PII]}

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  qs <- numberOf (pair int int)
  return TC {..}

type Output = [Int]

output :: Output -> C.ByteString
output = map showB >>> C.unlines

type VI = UArray Int Int

solve :: TC -> Output
solve TC {..} = map query qs
  where
    it = 12
    ls = take it $ iterate step as

    query (x, k) = ls !! min k (it - 1) !! (x - 1)

    step :: [Int] -> [Int]
    step ai = map (fs !) ai
      where
        fs :: VI
        fs = accumArray (+) 0 (1, n) $ map (,1) ai

    is = 0

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Prelude hiding (lookup)
import Data.Char
import Data.List hiding (lookup)
import Data.Map (fromList, insertWith, lookup)
import System.IO

fromJust :: Maybe a -> a
fromJust (Just a) = a
fromJust _ = undefined

getWord' :: String -> IO (String)
getWord' "" = do ch <- getChar ; eof <- isEOF
                 if eof then return "" else if isSpace ch then getWord' "" else getWord' [ch]
getWord' chs = do ch <- getChar ; eof <- isEOF
                  if eof then return chs else if isSpace ch then return chs else getWord' (chs ++ [ch])

getWord = getWord' ""

getInt :: IO (Int)
getInt = fmap read getWord

getInts' 0 acc = return acc
getInts' n acc = do x <- getInt ; getInts' (n-1) (acc ++ [x])

getInts :: Int -> IO ([Int])
getInts n = getInts' n []

-- SOLUTION

count xs = foldl f (fromList []) xs
           where f acc x = insertWith (+) x 1 acc

iter xs = map f xs
          where f x = fromJust (lookup x (count xs))

data Query = Query {
      posQuery :: Int
    , kQuery :: Int
    , idxQuery :: Int
    } deriving (Show)

type QResult = (Query, Int)

getQuery i n xs | i == n = return xs
getQuery i n xs = do
    idx <- getInt
    k <- getInt
    getQuery (i+1) n (xs ++ [Query i k (idx-1)])

getQueries = do
    q <- getInt
    getQuery 0 q []

sortQueries qs f = sortBy compareQueries qs
                 where compareQueries a b = compare (f a) (f b)
sortByK qs = sortQueries qs kQuery

sortResults qs = sortBy f qs
                 where f (a, _) (b, _) = compare (posQuery a) (posQuery b)

calcQueries :: [Query] -> [Int] -> Int -> Int -> [QResult] -> [QResult]
calcQueries [] _ _ _ res = res
calcQueries (q:qs) xs k n res
    | (k == (kQuery q)) || (k >= n) = calcQueries qs xs k n (res ++ [(q, xs !! (idxQuery q))])
calcQueries qs xs k n res = calcQueries qs (iter xs) (k+1) n res

putRes :: QResult -> IO ()
putRes res = do putStrLn (show (snd res))

forEach :: [a] -> (a -> IO ()) -> IO ()
forEach [] _ = return ()
forEach (x:xs) a = do a x; forEach xs a

--2
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

maxK n = 2 * (isqrt (2*n))

iterNums :: [[Int]] -> Int -> [[Int]]
iterNums rs target | ((length rs)-1) < target = iterNums (rs ++ [iter (head rs)]) target
iterNums rs target = rs

getRes :: [[Int]] -> Int -> Int -> Int
getRes rs idx k = (rs !! k) !! (idx-1) where l = length rs

doQuery :: [[Int]] -> Int -> Int -> IO ()
doQuery _ _ 0 = return ()
doQuery rs mK i = do
    idx <- getInt
    k <- getInt
    let nk = min k mK
    let nrs = iterNums rs nk
    putStrLn (show (getRes nrs idx nk))
    doQuery nrs mK (i-1)

loop :: IO () -> Int -> IO ()
loop a 0 = return ()
loop a n = do a; loop a (n-1)

doTests 0 = return ()
doTests t = do
    n <- getInt
    nums <- getInts n
    q <- getInt
    doQuery [nums] (maxK n) q
    doTests (t-1)

main = do t <- getInt ; doTests t

import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntMap as Map
import Data.List (sort)
import Data.Maybe (fromJust)

main = do
  t <- readInt <$> BS.getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- BS.getLine
    xs <- map readInt . BS8.words <$> BS.getLine
    let xss = solve xs
    let lxss = length xss - 1
    q <- readInt <$> BS.getLine
    forM_ [1 .. q] $ \_ -> do
      [xi, ki] <- map readInt . BS8.words <$> BS.getLine
      print $ (xss !! min lxss ki) !! (xi - 1)

solve :: [Int] -> [[Int]]
solve xs = do
  let freq = foldl (\m x -> Map.insertWith (+) x 1 m) Map.empty xs
  let xs' = map (\x -> fromJust (Map.lookup x freq)) xs
  if xs == xs' then [] else xs' : solve xs'

readInt = fst . fromJust . BS8.readInt