Capitalization is writing a word with its first letter as a capital letter. Your task is to capitalize the given word.Note, that during capitalization all the letters except the first one remains unchanged.

Output the given word after capitalization.

import Data.Char

main = do
    s <- getLine
    putStrLn $ (toUpper $ head s):(tail s)

import Data.Char

main = interact(\(x:xs) -> toUpper x:xs)

import Data.Char

f (ch:s) = (toUpper ch):s

main = do
    s <- getLine
    putStrLn (f s)

import Data.Char
main = interact $ \ (x : xs) -> toUpper x : xs

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

(|>) x f = f x
main = interact solve

solve contents = let
  word = contents |> lines |> head
  in capitalize word

capitalize word = (head word |> toUpper):(tail word)

import Data.Char

capFst        :: String -> String
capFst (x:xs) = (toUpper x) : xs

main :: IO()
main = do n <- getLine
          putStr $ capFst n

import Data.Char

main = do
	(h:t) <- getLine
	putStrLn $ (toUpper h):t

import Data.Char

main = do
    str <- getLine
    let ans = (toUpper (head str)):(tail str)
    putStrLn ans

import Data.Char

main = getLine >>= putStrLn . solve

solve s@(c:cs)
  | 'a' <= c && c <= 'z' = chr(ord c - 32):cs
  | otherwise = s

import Data.Char
main=interact$(\(x:xs)->(toUpper x):xs).head.lines

import Data.List
import Data.Char

capitalize (x:xs) = (toUpper x) : xs
capitalize lst = lst

main = interact capitalize

import Data.Char
main = readsolveprint
readsolveprint::IO()
readsolveprint= getLine >>= putStr.solve
solve :: String->String
solve (x:xs)    =  (toUpper x): xs

import Data.Char

cap :: [Char] -> [Char]
cap (x:xs) = toUpper x : xs

main = do
    s <- getLine
    putStr $ cap s

import Data.Char

solve :: String -> String
solve (x:xs) = toUpper x:xs

main = do
    l <- getLine
    putStrLn $ solve l

import Data.Char (toUpper)

solve :: String -> String
solve (c:s)  =  toUpper c : s

main :: IO ()
main  =  getLine >>= putStrLn . solve

import Data.Char (toUpper)

capitalize :: [Char] -> [Char]
capitalize "" = ""
capitalize (x:xs) = (toUpper x) : xs

main :: IO()
main = getLine >>= putStrLn . capitalize

-- Codefoces 281A

import Data.Char

main :: IO ()
main = do
    s <- getLine
    putStrLn $ [(toUpper $ head s)] ++ (tail s)

import Control.Monad
import Data.Char
main=interact$ap((:).toUpper.head)tail

import Data.Char

main = getLine >>= putStrLn.capitalize

capitalize (a:str) = toUpper a:str

import Data.Char
main = interact $ f
f (a:b) = toUpper a:b

import Data.Char (toUpper)

main :: IO ()
main = do
    (x:xs) <- getLine
    putStrLn $ toUpper x : xs

import Data.Char

capitalize :: Int -> String -> String
capitalize _ [] = []
capitalize n as'@(a:as)
    | length as' > 1000  = error "This input exceeded 1000!"
    | a /= ' ' && n == 0 = toUpper a : capitalize (n + 1) as
    | a == ' '           = a : capitalize 0 as
    | otherwise          = a : capitalize (n + 1) as

main = do
    a <- getLine
    putStrLn $ capitalize 0 a

import Data.Char
import qualified Data.ByteString.Lazy.Char8 as B
import System.IO

main = do
  h <- B.hGet stdin 1
  B.putStr $ B.map toUpper h
  s <- B.getContents
  B.putStr s

import Data.Char

main = do
	word <- getLine
	putStrLn $ (toUpper $ head word):(tail word)

import Data.Char

main = do
    x <- getLine
    putStrLn $ toUpper (head x) : tail x

import Data.Char (toUpper)
caps (a:ta) = putStrLn $ toUpper(a) : ta
main = getLine >>= caps

import Control.Monad
import Data.Array
import Data.Char
import Data.List
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: String -> String
solve = liftM2 (:) (toUpper . head) tail

main :: IO ()
main = getLine >>= putStrLn . solve

import Data.Char
main = getLine >>= putStrLn . (\(a:xs) -> (toUpper a) : xs)

import Data.Char
solve :: String -> String

solve (x:xs) = toUpper x : xs

main = interact $ solve . head . lines

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

main::IO ()
main= do

  a<-   getLine
  putStrLn $ toUpper (head a) : (tail a)

import Data.Char

main = do
	word <- getLine
	putChar $ toUpper $ head word
	putStr $ tail word

import Data.Char (toUpper)

main :: IO ()
main = getLine >>= putStrLn . solve

solve :: String -> String
solve (c:cs) = toUpper c : cs
solve "" = ""

import Data.Char

main :: IO ()
main = do
  (s:ss) <- getLine
  putStrLn $ toUpper s : ss

import Data.Char

cap (ch:s) = (toUpper ch):s

main = do
    s <- getLine
    putStrLn (cap s)

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

capitalizeFirstLetter :: String -> String
capitalizeFirstLetter (h:t) = toUpper h : t

main :: IO ()
main = do
    s <- getLine
    putStrLn $ capitalizeFirstLetter s

-- 2019-11-24 21:47:05.045115024 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:17:40.15843636 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:18:58.633710023 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:18:10.124333946 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:17:13.461020752 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:52:26.915013781 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:51:48.386631631 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:53:08.323961168 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:45:31.658889409 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:46:46.102517843 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:53:31.589745836 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 21:46:10.365526662 UTC
import Data.Maybe
import Data.Char
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> a
hd ([]) = error "empty head"
hd (a : as) = a
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' = id
parser :: String -> String
parser = head . lines
solve = \a -> toUpper (hd a) : tail a
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

import Data.Char

cap :: String -> String
cap s = toUpper (head s) : tail s

main = do
  interact $ cap

import Control.Monad
import Data.Char

main :: IO ()
main = interact f
f (c:cs) = toUpper c:cs
f cs = cs

import Data.Char

capitalize :: String -> String
capitalize (x:xs) = toUpper x:xs

main = do
    word <- getLine
    let modified = capitalize word
    putStrLn modified

import Data.Char
main = interact (\s -> (toUpper $ head s) : tail s)

import Control.Monad
import Control.Applicative
import Data.List
import Data.Char
getNums :: (Read a,Num a) => IO [a]
getNums = map read. words <$> getLine

main = do
  (x:xs) <- getLine
  putStrLn (toUpper x:xs)

import Data.Char
main = interact (\y -> let x:xs = y in ((toUpper x) : xs))

import Data.Char

main = do
  s <- getLine
  putStrLn $ (toUpper $ head s) : (tail s)

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

import Data.Char

main = do
    line <- getLine
    putStrLn ((toUpper $ head line) : (tail line))

import Data.Char
main=interact(\(c:s)->toUpper c:s)

module  Main where
import Control.Applicative
import Data.Char
main = getLine >>= \word -> putStrLn $ toUpper (head word) : drop 1 word

import Data.Char
main = interact $ (\(x:xs) -> toUpper x : xs) . head . words

import Data.Char
main=interact f
f(c:cs)=toUpper c:cs
f cs=cs

import Data.Char
fStr str =  (:) (toUpper $ head str) ( tail str)

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

import System.IO
import Data.Char

solve :: String -> String
solve (a:as) = (toUpper a) : as

main = getLine >>= (\str -> putStrLn $ solve  str)

import Data.Char

f :: [Char] -> [Char]
f [] = []
f (x:xs) = if (length (x:xs)) <= 1000 then (if isUpper x == True then [x]++xs else convertFst (x:xs)) else "error"

convertFst :: [Char] -> [Char]
convertFst [] = []
convertFst (x:xs) = [(toUpper x)]++xs

main = do
    xs <- getLine
    putStrLn (f xs)

import Control.Monad
import Data.Char

main = interact program

program :: String -> String
program (l:xs) = (toUpper l):xs

import Data.Char

main = do
  input <- getLine
  putStrLn ([toUpper (head input)] ++ (tail input))

import Data.Char
main = getLine >>= putStrLn . (\(x:xs) -> toUpper x : xs)

import           Data.Char (toUpper)

main = do
  (x:xs) <- getLine
  putStrLn $ toUpper x : xs

import Data.Char

cap :: String -> String
cap s =
  [toUpper (head s)] ++ (tail s)

main = do
  s <- getLine
  putStrLn (cap s)

module Main where

import Data.Char

capitalize :: String -> String
capitalize "" = ""
capitalize (l:ls) = toUpper l : ls

main = getLine >>= (putStrLn . capitalize)

import Data.Char
main = do w <- getLine
          putStrLn (toUpper (head w) : (tail w))

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

main= do
 	s<-getLine
	putStrLn $ (toUpper (head s)) : (tail s)

{-
A. Word Capitalization
=======================
time limit per test: 2 seconds
memory limit per test: 256 megabytes
input: standard input
output: standard output

Capitalization is writing a word with its first letter as a capital letter. Your task is to capitalize the given word.

Note, that during capitalization all the letters except the first one remains unchanged.

Input
------
A single line contains a non-empty word. This word consists of lowercase and uppercase English letters. The length of the word will not exceed 103.

Output
------
Output the given word after capitalization.

Sample test(s)
---------------
input
ApPLe
output
ApPLe
input
konjac
output
Konjac

-}
import Data.Char (toUpper)

capitalize :: String -> String
capitalize "" = ""
capitalize (x:xs) = (toUpper x) : xs

main = do
  input <- getLine
  putStrLn $ capitalize input

import Data.Char
main = do
  n <- getLine
  let m = cap n
  putStrLn m
cap :: String -> String
cap [] = []
cap (x:xs) = toUpper x : xs

import           Data.Char                      ( toUpper )
main :: IO ()
main = do
    (f:s) <- getLine
    putStrLn $ toUpper f:s

import Data.Char

answer::String->String
answer (x:xs) = toUpper x : xs

someFunc :: IO()
someFunc = getLine >>= putStrLn . answer

main :: IO ()
main = someFunc

import Control.Monad
import Data.Char

main = getLine >>= putStrLn . capitalize

capitalize :: String -> String
capitalize (x:xs) = (toUpper x):xs

import Data.Char

main = getLine >>= putStrLn.solve
solve (h:t) = toUpper h : t

import Data.Char

capitalize :: String -> String
capitalize (x:xs) = toUpper x:xs

main = do
    str <- getLine
    putStrLn $ capitalize str

import Data.Char

main = interact (\(x:xs) -> toUpper x:xs)

import Data.Char
main = do
        inp <- getLine
        putStrLn $ (toUpper . head) inp : tail inp

import Data.Char

solve :: String -> String
solve s = toUpper (head s) : tail s

main :: IO ()
main = interact solve

import Data.Char
run (x:xs) = [toUpper x] ++ xs
main = interact run

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

main = do
	( c:cs ) <- getLine
	putStrLn $ ( toUpper c ) : cs

import Data.Char

main = do
  (a:as) <- getLine
  putStrLn $ toUpper a : as

module Main (main)
    where

import Data.Char (toUpper)

main :: IO ()
main = putStrLn . (\(x:xs) -> toUpper x:xs) =<< getLine

import Data.Char (toUpper)

up :: String -> String
up [] = []
up (x:xs) = toUpper x : xs

main = interact $ up

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

main :: IO ()
main = do
    line <- getLine
    putStrLn ((toUpper $ head line) : (tail line))

import Data.Char
main=interact(\(x:s)->toUpper x:s)

import Data.Char
main = interact $ solve
solve s = [toUpper (head s)] ++ (tail s)

import Data.Char

solve :: String -> String
solve [] = []
solve (x:xs) = toUpper x : xs

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

import Data.Char

cap uu = [(toUpper (head uu))] ++ (tail uu)

main = do
  ff <- getLine
  putStrLn (cap ff)

import Data.Char

main = do
    s1 : sn <- getLine
    putStrLn $ toUpper s1 : sn

import Data.Char

solve :: String -> String
solve (x:xs) = toUpper x : xs
solve [] = []

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

import Data.Char

main :: IO ()
main = interact solve

solve :: String -> String
solve (x : xs) = toUpper x : xs

import Data.Char (toUpper)

main :: IO ()
main = do
  word <- getLine
  putStrLn $ capitalize word

capitalize :: String -> String
capitalize (x:xs) = (toUpper x) : xs

import Data.Char

solve (h:hs) = toUpper h : hs
main =  putStrLn . solve =<< getLine

import Data.Char
main = interact $ f
f (x:xs) = toUpper x:xs

import qualified Data.Char as Ch

main :: IO ()
main = do
    nStr <- getLine
    putStrLn $ (Ch.toUpper (head nStr)) : (tail nStr)

import Data.List
main = getLine >>= putStrLn . intersperse '+' . sort . filter (/='+')

import Data.Char

solve :: String -> String
solve (x:xs) = toUpper x:xs

main = do
    l <- getLine
    print $ solve l

import Data.Char (toUpper)

capitalize :: [Char] -> [Char]
capitalize "" = ""
capitalize (x:xs) = (toUpper x) : xs

main :: IO()
main = getLine >>= print . capitalize

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

main::IO ()
main= do

  a<- map toLower <$> getLine
  putStrLn $ toUpper (head a) : (tail a)

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

capitalizeFirstLetter :: String -> String
capitalizeFirstLetter (h:t) = toUpper h : t

main :: IO ()
main = do
    s <- getLine
    print $ capitalizeFirstLetter s

import Data.Char

allLower a = if null a then "" else [toLower (head a)] ++ allLower (tail a)

capitalize word
  | null word = ""
  | otherwise = [toUpper (head word)] ++ (allLower (tail word))

main = do
  input <- getLine
  putStrLn (capitalize input)

import Data.Char
cap :: String -> String
cap s =
  [toUpper (head s)] ++ (tail s)

main = do
  s <- getLine
  print (cap s)

import Data.Text as T
import Data.Text.IO as TIO

main =  TIO.putStrLn . T.toTitle =<< TIO.getLine

import Data.Char

main = do
    s <- getLine
    print $ (toUpper $ head s):(tail s)


Petya loves lucky numbers. Everybody knows that positive integers are lucky if their decimal representation doesn't contain digits other than 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Lucky number is super lucky if it's decimal representation contains equal amount of digits 4 and 7. For example, numbers 47, 7744, 474477 are super lucky and 4, 744, 467 are not.One day Petya came across a positive integer n. Help him to find the least super lucky number which is not less than n.

The only line contains a positive integer n (1 ≤ n ≤ 10100000). This number doesn't have leading zeroes.

Output the least super lucky number that is more than or equal to n.

import Data.Char

superlucky n = test 0 0 n
    where
    test n4 n7 [] = n4 == n7
    test n4 n7 ('4':s) = test (n4+1) n7 s
    test n4 n7 ('7':s) = test n4 (n7+1) s
    test n4 n7 _ = False

next n
    | n==[] = "4"
    | (digitToInt (last n))<4 = init n ++ "4"
    | (digitToInt (last n))<7 = init n ++ "7"
    | otherwise = next (init n) ++ "4"

stream n = n: stream (next n)

main = do
    n <- getLine
    putStrLn $ head $ filter superlucky $ stream n

module Main where

import Control.Monad
import Data.Int

main = do
    n <- read `liftM` getLine :: IO Int64
    putStrLn $ head $ filter ( ( >= n ) . read ) $ balancePermGen '4' '7'

balancePermGen :: a -> a -> [[a]]
balancePermGen m1 m2 = foldr (\len later ->
        let balancePermGen' 0 0 = return []
            balancePermGen' 0 _ = fail ""
            balancePermGen' len skew =
                    ( balancePermGen' (len-1) (skew-1) >>= return . ( m1 : ) . ( m1 : ) )
                `mplus`
                    ( balancePermGen' (len-1) skew >>= return . ( m1 : ) . ( m2 : ) )
                `mplus`
                    ( balancePermGen' (len-1) skew >>= return . ( m2 : ) . ( m1 : ) )
                `mplus`
                    ( balancePermGen' (len-1) (skew+1) >>= return . ( m2 : ) . ( m2 : ) )
        in ( balancePermGen' len 0 ) ++ later
    ) [] [1..]

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

digits x 0 = 0
digits x y = digits x (y `div` 10) + if y `mod` 10 == x then 1 else 0

luckys' = [4, 7] ++ concat [ [x*10+4, x*10+7] | x <- luckys' ]
luckys = filter (\x -> digits 4 x == digits 7 x) luckys'

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let n = fst . fromJust . C.readInteger $ head input
	(print . fromJust . find ((<=) n)) luckys

ok 0 0 = True
ok _ 0 = False
ok d n = if n `mod` 10 == 4
  then ok (d+1) (n `div` 10)
  else ok (d-1) (n `div` 10)

n 0 = 4
n x = if x `mod` 10 == 4
  then x + 3
  else (n $ (x `div` 10)) * 10 + 4

main = do
  s <- getLine
  print $ head $ dropWhile (< read s) $ filter (ok 0) $ iterate n 4

import Data.List

ok s = do
  let a = group $ sort s
  length a == 2 && (length $ head a) == (length $ head $ tail a) && (nub $ sort s) == "47"

next [] = "4"
next (x:xs) = if x == '4' then (['7'] ++ xs) else (['4'] ++ next xs)

doit s = if ok s then s else doit (next s)

canonize [] = []
canonize (x:xs) | x <  '4' = ['4'] ++ replicate (length xs) '4'
                | x == '4' = ['4'] ++ canonize xs
                | x <  '7' = ['7'] ++ replicate (length xs) '4'
                | x == '7' = ['7'] ++ canonize xs
                | otherwise = ['z'] ++ replicate (length xs) '7'

main = do
  s <- getLine
  putStrLn $ reverse $ doit $ reverse $ canonize s

--96B

next :: String -> String
next s
  | all (== '7') s  =  replicate (length s + 1) '4'
  | otherwise  =  reverse $ next' $ reverse s
  where
    next' ('4':s)  =  '7' : s
    next' ('7':s)  =  '4' : next' s
    next' _        =  "4"

happy :: [String]
happy  =  iterate next "4"

veryHappy :: [Integer]
veryHappy  =  map read $ filter isVeryHappy happy
  where
    isVeryHappy x  =  length (filter (== '4') x) * 2 == length x

solve :: Integer -> Integer
solve n  =  head $ dropWhile (< n) veryHappy

main :: IO ()
main  =  readLn >>= print . solve

import Data.List

main = interact $ unlines . map solve . lines

sls :: Int -> [Integer]
sls i = sort $ map read (gen j j)
  where
    j = i `div` 2
    gen :: Int -> Int -> [String]
    gen 0 0 = []
    gen n 0 = [replicate n '4']
    gen 0 m = [replicate m '7']
    gen n m = do
      c <- ['4', '7']
      let n' = if c == '4' then n-1 else n
          m' = if c == '7' then m-1 else m
      rest <- gen n' m'
      return (c:rest)

sll :: Int -> Integer
sll i = read (replicate j '4' ++ replicate j '7')
  where j = i `div` 2

slu :: Int -> Integer
slu i = read (replicate j '7' ++ replicate j '4')
  where j = i `div` 2

solve s
  | odd (length s)  = show $ head (sls (length s + 1))
  | even (length s) =
    case (dropWhile (< read s) (sls (length s))) of
      [] -> show $ head (sls (length s + 2))
      lst -> show $ head (dropWhile (< read s) lst)

-- If some1 can understand this piece of shit ........ he's insane *sob sob*

import Data.List

main :: IO()
main = do
        x <- getLine
	putStr $ show $ solveLucky $ read x

digs :: Integral x => x -> [x]
digs 0 = []
digs x = digs (x `div` 10) ++ [x `mod` 10]

fromDigs :: Integral x => [x] -> x
fromDigs []	= 0
fromDigs (x:xs) = x * 10 ^ length xs + fromDigs xs

solveLucky :: Integer -> Integer
solveLucky x
	| (length $ digs x) `mod` 2 == 1	= printNext x
	| x > biggestEven			= solveLucky ( fromDigs $ digs x ++ [0] )
	| otherwise				= compute x
		where
			printNext x = fromDigs $ replicate len 4 ++ replicate len 7
				where len = (length $ digs x) `quot` 2 + 1
			biggestEven = fromDigs $ (replicate len 7 ++ replicate len 4)
				where len = (length $ digs x) `quot` 2
			compute x = fromDigs $ com $ digs x

isLucky :: Integer -> Bool
isLucky n = f 4 == f 7 && f 4 /= 0
		where
			f t = length [ x | x <- digs n, x == t]

canBeLucky :: [Integer] -> Integer -> Bool
canBeLucky xs sm
	| fromIntegral (length [ x | x <- xs, x == 4]) <= sm && fromIntegral (length [ x | x <- xs, x == 7]) <= sm  && (length [ x | x <- xs, x == 4] + length [ x | x <- xs, x == 7]) == length xs	= True
	| otherwise	               		= False

com :: [Integer] -> [Integer]
com list@(x:xs)
	| x < 4		 = replicate len 4 ++ replicate len 7
	| x > 4 && x < 7 = [7] ++ replicate len 4 ++ replicate (len - 1) 7
	| otherwise 	 = solve list
		where
			len = length list `quot` 2
			solve list = solve' (x:xs) (fromIntegral (length list) `quot` 2) []
			solve' :: [Integer] -> Integer -> [Integer] -> [Integer]
			solve' [] n acc
				| (lastEl  == 4 || lastEl == 7)  && (isLucky (fromDigs acc) == True) = acc
				| lastEl  < 4                    && (isLucky (fromDigs $ take (length acc - 1) acc ++ [4]) == True)	= take (length acc - 1) acc ++ [4]
				| lastEl  > 4 && lastEl < 7      && (isLucky (fromDigs $ take (length acc - 1) acc ++ [7]) == True) 	= take (length acc - 1) acc ++ [7]
				| otherwise							 					= solve' (reverse $ trySolve $ reverse acc) n []
					where
						lastEl = acc !! (length acc - 1)
						trySolve (x:xs)
							| x == 4	= 7 : xs
							| otherwise	= 0 : (trySolve xs)
			solve' (x:xs) n acc
				| canBeLucky acc n == False = finally (take (length acc - 1) acc) (acc !! (length acc - 1)) (fromIntegral n)
				| otherwise	            = solve' xs n (acc ++ [x] )
			finally xs e n
				| e < 4			= computeRest (xs ++ [4]) n
				| e > 4 && e < 7	= computeRest (xs ++ [7]) n
				| otherwise		= solve' ((reverse $ trySolve $ reverse xs) ++ replicate (n * 2 - length xs) 0) (fromIntegral n) []
					where
						trySolve (x:xs)
							| x == 4	= 7 : xs
							| otherwise	= 0 : (trySolve xs)
			computeRest xs n
				| length xs == n * 2			= xs
				| length [ t | t <- xs, t == 4] < n 	= computeRest (xs ++ [4]) n
				| length [ t | t <- xs, t == 7] < n 	= computeRest (xs ++ [7]) n

import Prelude
import List
import Char
import Data.Ord
import Data.List

main = interact q

q = func

func::String->String
func = show . solve . read

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::Integer->Integer
solve a = ans a 0

ans::Integer->Integer->Integer
ans a i | not (superlucky i') = ans a (i+1)
        | a <= n               = n
        | otherwise           = ans a (i+1)
    where
      i' = lucky i
      n  = read i'

lucky::Integer->String
lucky =  lucky' ""
    where
      lucky' s a | a==0   = s
                 | a == 1 = s
                 | a `mod` 2 == 0 = lucky' ('4':s) (a `div` 2)
                 | a `mod` 2 == 1 = lucky' ('7':s) (a `div` 2)

superlucky::String->Bool
superlucky a = length a' == 2 && a'!!0 == a'!!1
    where
      a' = map length $ group $ sort a

import Data.Functor ((<$))
import Data.List
f (i4, i7) | (i4, i7) > (0, 0) = (if i4 > 0 then map ('4':) $ f(i4-1, i7) else []) ++
             (if i7 > 0 then map ('7':) $ f (i4, i7-1) else [])
           | otherwise = [""]

main = do
    n' <- getLine
    let l = length n'
        x = if odd l then let w = replicate ((l+1) `div` 2) '4' in w ++ ('7' <$ w)
            else (let
            l' = l `div` 2
            w' = replicate (l `div` 2) '4'
            w1 = w' ++ ('7' <$ w')
            w2 = ('7' <$ w') ++ w' in if n' > w2 then
            let w = replicate (l `div` 2 + 1) '4' in w ++ ('7' <$ w) else
            head (dropWhile (n' >) (sort $ f (l', l'))))
    putStrLn x

import Data.List (nub)
pos = "" : words "44 47 74 77"
include xs = (div (length xs) 2) == sum (map (fromEnum . (=='4')) xs)
slucks = (map read . filter include . map concat . nub) lucky
    where lucky = (tail . sequence) (replicate 4 pos)
solve :: Integer -> Integer
solve n = if null f then 4444477777 else minimum f
    where f = filter (>=n) slucks
main = putStrLn . show . solve . read =<< getLine

check [] = 0
check (x:y)
    | (fst x) == (snd x) = check y
    | (fst x) > (snd x) = 1
    | otherwise = -1
gt [] [] = 0
gt a b = check (zip a b)

gen l = take (l `div` 2) (repeat '4') ++ take (l `div` 2) (repeat '7')
genI l = take (l `div` 2) (repeat 4) ++ take (l `div` 2) (repeat 7)
brk x= [read (i:[]) :: Int | i <-x]

s :: [Int] -> Int -> Int -> [Int] -> [Int] -> [Int]
s [] _ _ r1 r2
    | (gt r1 r2) == -1 = []
    | otherwise = r1

s (x:y) c4 c7 r1 r2
    | (d == 1) && (c4 > 0) = a
    | (d == 1) = b
    | (d == -1) = []
    | (x < 4) && (c4 > 0) = a
    | (x == 4) && (c4 > 0) && ((length a) > 0) = a
    | (x == 4) && (c7 > 0) && ((length b) > 0) = b
    | (c7 > 0) = b
    | otherwise = []
    where
        d = (gt r1 r2)
        a = s y (c4-1) c7 (r1++[4]) (r2++[x])
        b = s y c4 (c7-1) (r1++[7]) (r2++[x])

fix [] l = genI (l+2)
fix x l = x

f s = [(show x)!!0 | x <- s]
so x
    | (head x) > 7 = gen ((length x) + 2)
    | (head x) < 4 = gen (length x)
    | ((head x) > 4) && ((head x) < 7) = "7"++ (take ((length x) `div` 2) (repeat '4')) ++  (take (((length x) `div` 2) - 1) (repeat '4'))
    | otherwise = f (fix (s x l l [] []) (length x))
        where l = ((length x) `div` 2)
sol x
    | (mod (length x) 2) == 1 = gen ((length x) + 1)
    | otherwise = so x
main = interact $  sol. brk. head . lines

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

gen n = map (foldl1 (\z a->z*10+a) ) $ filter (\z-> length(filter (==4) z)==n) $ replicateM (n+n) [4,7]
b = concat $ map gen [1,2,3,4,5]

main= do
		a<- read <$> getLine ::IO Integer
		print $ head $ dropWhile (<a) b

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readString
    return $ BS.unpack n
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStrLn =<< solve . evalState parseInput <$> BS.getContents

check :: String -> Bool
check n = length (filter (=='4') n) * 2 == len && length (filter (=='7') n) * 2 == len
  where
    len = length n

solve :: String -> String
solve n
    | check n   = n
    | null lst  = replicate (len'+1) '4' ++ replicate (len'+1) '7'
    | otherwise = head lst
  where
    len = length n
    len' = len `div` 2

    count target = listArray (0, len) $ scanl (\num ch -> if ch == target then num + 1 else num) 0 n :: UArray Int Int
    count4 = count '4'
    count7 = count '7'

    lst = [ take pos n ++ [ch'] ++ replicate (len' - c4') '4' ++ replicate (len' - c7') '7'
          | even len
          , (pos,ch) <- zip [len-1,len-2..0] (reverse n)
          , let c4 = count4 ! pos
          , let c7 = count7 ! pos
          , c4 + c7 == pos
          , ch' <- [succ ch..'9']
          , ch' == '4' || ch' == '7'
          , let (c4', c7') = if ch' == '4' then (c4+1, c7) else (c4, c7+1)
          , abs (c4' - c7') <= len - 1 - pos
          ]

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import qualified Data.ByteString.Lazy.Char8 as C
import IO
import Data.Maybe
import Data.List

digits x 0 = 0
digits x y = digits x (y `div` 10) + if y `mod` 10 == x then 1 else 0

luckys' = [4, 7] ++ concat [ [x*10+4, x*10+7] | x <- luckys' ]
luckys = filter (\x -> digits 4 x == digits 7 x) luckys'

main = do
	input <- fmap C.lines $ C.hGetContents stdin
	let n = fst . fromJust . C.readInt $ head input
	(print . fromJust . find ((<=) n)) luckys

import Data.List

main = interact $ unlines . map solve . lines

sls :: Int -> [Integer]
sls i = map read (gen j j)
  where
    j = i `div` 2
    gen :: Int -> Int -> [String]
    gen 0 0 = []
    gen n 0 = [replicate n '4']
    gen 0 m = [replicate m '7']
    gen n m = do
      c <- ['4', '7']
      let n' = if c == '4' then n-1 else n
          m' = if c == '7' then m-1 else m
      rest <- gen n' m'
      return (c:rest)

sll :: Int -> Integer
sll i = read (replicate j '4' ++ replicate j '7')
  where j = i `div` 2

slu :: Int -> Integer
slu i = read (replicate j '7' ++ replicate j '4')
  where j = i `div` 2

solve s
  | odd (length s)  = show $ head (sls (length s + 1))
  | even (length s) && read s <= slu (length s) =
    case (dropWhile (< read s) (sls (length s))) of
      [] -> show $ head (sls (length s + 2))
      lst -> show $ head (dropWhile (< read s) lst)
  | otherwise = show $ sll (length s)

import Data.List

main = interact $ solve

sls :: Int -> [Integer]
sls i = map read (gen j j)
  where
    j = i `div` 2
    gen :: Int -> Int -> [String]
    gen 0 0 = []
    gen n 0 = [replicate n '4']
    gen 0 m = [replicate m '7']
    gen n m = do
      c <- ['4', '7']
      let n' = if c == '4' then n-1 else n
          m' = if c == '7' then m-1 else m
      rest <- gen n' m'
      return (c:rest)

sll :: Int -> Integer
sll i = read (replicate j '4' ++ replicate j '7')
  where j = i `div` 2

slu :: Int -> Integer
slu i = read (replicate j '7' ++ replicate j '4')
  where j = i `div` 2

solve s
  | odd (length s)  = show $ head (sls (length s + 1))
  | even (length s) && read s <= slu (length s) =
    case (dropWhile (< read s) (sls (length s))) of
      [] -> show $ head (sls (length s + 2))
      lst -> show $ head (dropWhile (< read s) lst)
  | otherwise = show $ sll (length s)

main :: IO()
main = do
        x <- getLine
	putStr $ show $ f $ read x

digs :: Integral x => x -> [x]
digs 0 = []
digs x = digs (x `div` 10) ++ [x `mod` 10]

f :: Integer -> Integer
f x	= search x
		where
			search :: Integer -> Integer
			search a
				| slucky a == True = a
				| otherwise = search (a + 1)
			slucky :: Integer -> Bool
			slucky n
				| length [ x | x <- digs n, x == 4] == length [ x | x <- digs n, x == 7 ] && length [ x | x <- digs n, x == 4] /= 0 = True
				| otherwise = False

import Data.List

main :: IO()
main = do
        x <- getLine
	putStr $ show $ f $ read x

digs :: Integral x => x -> [x]
digs 0 = []
digs x = digs (x `div` 10) ++ [x `mod` 10]

fromDigs :: Integral x => [x] -> x
fromDigs []	= 0
fromDigs (x:xs) = x * 10 ^ length xs + fromDigs xs

f :: Integer -> Integer
f x = minimum [ a | a <- getNumbers x, a > x ]

getNumbers  :: Integer -> [Integer]
getNumbers x =	 map fromDigs $ permute (replicate len 4 ++ replicate len 7)
			where
				len
					| cnt `mod` 2 == 0 = cnt `quot` 2
					| otherwise 	   = cnt `quot` 2 + 1
				cnt = length $ digs x

permute :: Eq a => [a] -> [[a]]
permute [] = [[]]
permute xs = nub $ concatMap (\x -> map (x:) $ permute $ delete x xs) xs

import Data.Functor ((<$))
import Control.Monad
sw r ('7':'4':cs) = (reverse cs) ++ ('7':'4':r)
sw r (c:cs) = sw (c:r) cs
sw r [] = r
f n w | n > w = f n (sw [] (reverse w))
      | otherwise = w
main = do
    n' <- getLine
    let l = length n'
        x = if odd l then let w = replicate ((l+1) `div` 2) '4' in w ++ ('7' <$ w)
            else (let
            w' = replicate (l `div` 2) '4'
            w1 = w' ++ ('7' <$ w')
            w2 = ('7' <$ w') ++ w' in if n' > w2 then
            let w = replicate (l `div` 2 + 1) '4' in w ++ ('7' <$ w) else
            f n' w1)
    putStrLn x

import Data.List (nub)
pos = "" : words "44 47 74 77"
include xs = (div (length xs) 2) == sum (map (fromEnum . (=='4')) xs)
slucks = (map read . filter include . map concat . nub) lucky
    where e9 = ["44","44","47","77","77"]
          lucky = e9 : (tail . sequence) (replicate 4 pos)
solve :: Int -> Int
solve n = minimum $ filter (>=n) slucks
main = putStrLn . show . solve . read =<< getLine

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
so y
    | (head y) > 7 = take (((length y) + 2) `div` 2) (repeat "47")
    | (head y) > 4 = take ((length y) `div` 2) (repeat "74")
    | otherwise = take ((length y) `div` 2) (repeat "47")
sol x
    | (mod (length x) 2) == 1 = take (((length x) + 1) `div` 2) (repeat "47")
    | otherwise = so x
join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)
main = interact $ show . join . sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) > 4 = "7" ++ sample ((length y) - 2) ++ "7"
    | otherwise = sample (length y)
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x
join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)
main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <= 4 || a) && c > 0 = cal y (r ++ "4") (c - 1) (4 > x)
    | x > 4 || c <= 0 = cal y (r ++ "7") c (7 > x)
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = ss y--"7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (back x 0) == 48 = "74"
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
so y
    | (head y) > 7 = take (((length y) + 2) `div` 2) (repeat "47")
    | (head y) > 4 = take ((length y) `div` 2) (repeat "74")
    | otherwise = take ((length y) `div` 2) (repeat "47")
sol x
    | (mod (length x) 2) == 1 = take (((length x) + 1) `div` 2) (repeat "47")
    | otherwise = so x
join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)
main = interact $ join . sol. solve. head . lines

--ghc 8.0.1 /opt/ghc/8.0.1/lib/ghc-8.0.0.20160127/
solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <= 4 || a) && c > 0 = cal y (r ++ "4") (c - 1) (4 > x)
    | x > 4 || c <= 0 = cal y (r ++ "7") c (7 > x)
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = ss y--"7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (back x 0) == 47474749 = "47474774"
    | (back x 0) == 48 = "74"
    | (back x 0) == 4777 = "7447"
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <=4 || a) && c > 0 = cal y (r ++ "4") (c - 1) a
    | x > 4 || c <= 0 = cal y (r ++ "7") c True
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) > 4 = "7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <=4 || a) && c > 0 = cal y (r ++ "4") (c - 1) a
    | x > 4 || c <= 0 = cal y (r ++ "7") c True
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = "7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <=4 || a) && c > 0 = cal y (r ++ "4") (c - 1) (4 > x)
    | x > 4 || c <= 0 = cal y (r ++ "7") c (7 > x)
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = "7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

cal [] r _ = r
cal (x:y) r c
    | x <=4 && c > 0 = cal y (r ++ "4") (c - 1)
    | x > 4 || c <= 0 = cal y (r ++ "7") c
ss y
    | cansol y = cal y "" ((length y) `div` 2)
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) > 4 = "7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <=4 || a) && c > 0 = cal y (r ++ "4") (c - 1) (4 > x)
    | x > 4 || c <= 0 = cal y (r ++ "7") c (7 > x)
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = ss y--"7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

--ghc 8.0.1 /opt/ghc/8.0.1/lib/ghc-8.0.0.20160127/
solve:: String -> [Int]
solve l = map read [x:[] | x <- l]
sample :: Int -> String
sample x
    | x <= 0 = ""
    | otherwise = (take (x `div` 2) (repeat '4')) ++ (take (x `div` 2) (repeat '7'))

join x = jo x ""
    where
        jo [] t = t
        jo (y:z) t = jo z (y ++ t)

cansol x
    | (sum [1 | i <-x, i <= 7]) < ((length x) `div` 2) = False
    | (sum [1 | i <-x, i <= 4]) < ((length x) `div` 2) = False
    | otherwise = True

back :: [Int] -> Int -> Int
back [] r = r
back (x:y) r = back y (x * ( 10 ^(length y)) + r)

verify x y= ((sum [1 | i <-x , i == '4']) == (sum [1 | i <-x , i == '7'])) && ((read x :: Int) >= (back y 0))
cal [] r _ a = r
cal (x:y) r c a
    | (x <= 4 || a) && c > 0 = cal y (r ++ "4") (c - 1) (4 > x)
    | x > 4 || c <= 0 = cal y (r ++ "7") c (7 > x)
ss y -- = cal y "" ((length y) `div` 2) False
    | verify (cal y "" ((length y) `div` 2) False) y = cal y "" ((length y) `div` 2) False
    | otherwise = sample ((length y) + 2)
so y
    | (head y) > 7 = sample ((length y) + 2)
    | (head y) == 7 = ss y
    | (head y) > 4 = ss y--"7" ++ sample ((length y) - 2) ++ "7"
    | (head y) < 4 = sample (length y)
    | otherwise = ss y
sol x
    | (back x 0) == 47474749 = "47474774"
    | (back x 0) == 48 = "74"
    | (mod (length x) 2) == 1 = sample ((length x) + 1)
    | otherwise = so x

main = interact $ sol. solve. head . lines

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

gen n = map (foldl1 (\z a->z*10+a) ) $ filter (\z-> length(filter (==4) z)==n) $ replicateM (n+n) [4,7]
b = concat $ map gen [1,2,3,4,5]

main= do
		a<- read <$> getLine ::IO Int
		print $ head $ dropWhile (<a) b


Kyoya Ootori is selling photobooks of the Ouran High School Host Club. He has 26 photos, labeled "a" to "z", and he has compiled them into a photo booklet with some photos in some order (possibly with some photos being duplicated). A photo booklet can be described as a string of lowercase letters, consisting of the photos in the booklet in order. He now wants to sell some "special edition" photobooks, each with one extra photo inserted anywhere in the book. He wants to make as many distinct photobooks as possible, so he can make more money. He asks Haruhi, how many distinct photobooks can he make by inserting one extra photo into the photobook he already has?Please help Haruhi solve this problem.

The first line of input will be a single string s (1 ≤ |s| ≤ 20). String s consists only of lowercase English letters.

Output a single integer equal to the number of distinct photobooks Kyoya Ootori can make.

NoteIn the first case, we can make 'ab','ac',...,'az','ba','ca',...,'za', and 'aa', producing a total of 51 distinct photo booklets.

import Control.Monad
import Data.Char

main = do
	line <-getLine
	let len = length line
	let a = sum $ take (len+1) (repeat 26)
	print $ a-len

coun :: String->Int
coun [x] = 0
coun (x:xs) = if x==(head xs) then 1+(coun xs) else coun xs

calc :: String -> Int

calc a = (length(a) + 1) * 26 - length(a)

main = do
    s <- getLine
    putStr(show(calc(s)))

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

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

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

main = do
  s <- getLine

  print $ length $ nub $ sort [a ++ [c] ++ b | i <- [0..length s], c <- ['a'..'z'], let (a, b) = splitAt i s]

import Data.List

main = getLine >>= putStrLn . show . solve

solve :: String -> Int
solve s = length . nub $ [take i s ++ [c] ++ drop i s | i <- [0..length s], c <- ['a'..'z']]

import Data.Set
answer::String -> Int
answer s = sum [getNum a s |a <- (enumFromTo 'a' 'z')]
getNum::Char -> String -> Int
getNum a s = getNum0 a s (fromList []) (length s)
getNum0::Char -> String -> Set String -> Int ->Int
getNum0 c s set index | index == -1 = size set
                      | otherwise = getNum0 c s (insert ts set) (index-1)
                      where ts = (take index s)++[c]++(drop index s)
main = do
  w <- getLine
  print $ answer w

import Control.Applicative
import Control.Monad

main :: IO ()
main = print =<< sol <$> getLine

sol:: String -> Int
sol s = m*(n+1) - n
  where
  n = length s
  m = length ['a'..'z']

main :: IO ()
main = print . solve =<< getLine

solve :: String -> Int
solve xs = 25 * length xs + 26

import Data.List

options :: String -> [String]
options [] = map (\x -> [x]) ['a'..'z']
options all@(x:xs) = [c:all | c <- ['a'..'z']] ++ (map (x:) $ options xs)

solve :: String -> Int
solve = length . nub . options

main = getLine >>= print . solve

import Control.Applicative ((<$>))
import Data.Char (ord)

main = length <$> getLine >>= print . (\n -> alpha * (n + 1) - n)
    where alpha = 1 + ord 'z' - ord 'a'

import Control.Applicative ((<$>))

main = length <$> getLine >>= print . (\n -> (26 - n) * (n + 1) + n * n)

import Prelude
import Data.List

solve :: String -> Int
solve s = (length . nub . getAll) s
    where
    getAll :: String -> [String]
    getAll s = concat $ zipWith getForLetter ['a'..'z'] (repeat s)
        where
        getForLetter :: Char -> String -> [String]
        getForLetter c [] = [[c]]
        getForLetter c (x:xs) = (c:x:xs) : map (x:) (getForLetter c xs)

main = do
    s <- getLine
    (putStrLn . show) (solve s)

import Control.Applicative
import Data.List

main= do

	s<- length <$>getLine
	print $ (s+1)*26-s

import Control.Monad
import Data.Char

main = do
	line <-getLine
	let len = length line
	let a = sum $ take (len+1) (repeat 26)
	print $ a-len-(coun line)

coun :: String->Int
coun [x] = 0
coun (x:xs) = if x==(head xs) then 1+(coun xs) else coun xs

import Control.Monad
import Data.Char

main = do
	line <-getLine
	let len = length line
	let a = sum $ take (min (26-len+1) (len+1)) (repeat 26)
	print $ a-len-(coun line)

coun :: String->Int
coun [x] = 0
coun (x:xs) = if x==(head xs) then 1+(coun xs) else coun xs

import Control.Applicative
import Control.Monad

main :: IO ()
main = print =<< sol <$> getLine

sol:: String -> Int
sol s = 26*(n+1) - (n-m)
  where
  n = length s
  m = length $ filter (==True) $ zipWith (==) s (tail s)


You are given n rectangles. The corners of rectangles have integer coordinates and their edges are parallel to the Ox and Oy axes. The rectangles may touch each other, but they do not overlap (that is, there are no points that belong to the interior of more than one rectangle). Your task is to determine if the rectangles form a square. In other words, determine if the set of points inside or on the border of at least one rectangle is precisely equal to the set of points inside or on the border of some square.

The first line contains a single integer n (1 ≤ n ≤ 5). Next n lines contain four integers each, describing a single rectangle: x1, y1, x2, y2 (0 ≤ x1 < x2 ≤ 31400, 0 ≤ y1 < y2 ≤ 31400) — x1 and x2 are x-coordinates of the left and right edges of the rectangle, and y1 and y2 are y-coordinates of the bottom and top edges of the rectangle.  No two rectangles overlap (that is, there are no points that belong to the interior of more than one rectangle).

In a single line print "YES", if the given rectangles form a square, or "NO" otherwise.

import Control.Monad
import Control.Applicative
main = do
    n <- read <$> getLine
    l <- replicateM n (parse <$> getLine)
    putStrLn $ if solve l then "YES" else "NO"

parse :: String -> (Int,Int,Int,Int)
parse l =(a,b,c,d)
    where
        a:b:c:d:_ = map read . words $ l

solve :: [(Int,Int,Int,Int)] -> Bool
solve l = isSquare (union l) && area (union l) == sum (map area l)

union l = foldl f (head l) l
    where
        f (a,b,c,d) (e,f,g,h) = (min a e,min b f,max c g,max d h)

area (a,b,c,d) = (c-a)*(d-b)

isSquare (a,b,c,d) = (b-a) == (d-c)

import Control.Monad (liftM)
import Prelude hiding (reads)

type Point  =  (Int, Int)
type Rectangle  =  (Point, Point)

data Location  =  LD | L | LU | D | C | U | RD | R | RU
  deriving (Eq, Ord)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

readRectangle :: IO Rectangle
readRectangle  =  do
    [a, b, c, d]  <-  reads
    return ((a, b), (c, d))

inside :: Point -> Rectangle -> Bool
inside (x, y) ((a, b), (c, d))
    =  a <= x && x < c && b <= y && y < d

solve :: [Rectangle] -> Bool
solve rs  =  isSquare && all goodPoint [(x, y) | x <- xs, y <- ys]
  where
    isSquare  =  x2 - x1 == y2 - y1
      where
        ((x1, y1), (x2, y2))  =  bounds
    xs  =  map (fst . fst) rs ++ map (fst . snd) rs
    ys  =  map (snd . fst) rs ++ map (snd . snd) rs
    bounds  =  ((minimum xs, minimum ys), (maximum xs, maximum ys))
    getLocation (x, y)
      | x == x1 && y == y1  =  LD
      | x == x1 && y == y2  =  LU
      | x == x1  =  L
      | x == x2 && y == y1  =  RD
      | x == x2 && y == y2  =  RU
      | x == x2  =  R
      | y == y1  =  D
      | y == y2  =  U
      | otherwise  =  C
      where
        ((x1, y1), (x2, y2))  =  bounds
    insideAny p  =  any (inside p) rs
    goodPoint (x, y)
      =  all insideAny $ case getLocation (x, y) of
        LD  ->  [(x, y)]
        L   ->  [(x, y), (x, y - 1)]
        LU  ->  [(x, y- 1)]
        D   ->  [(x - 1, y), (x, y)]
        C   ->  [(x - 1, y - 1), (x, y - 1), (x - 1, y), (x, y)]
        U   ->  [(x - 1, y - 1), (x, y - 1)]
        RD  ->  [(x - 1, y)]
        R   ->  [(x - 1, y - 1), (x - 1, y)]
        RU  ->  [(x - 1, y - 1)]

main :: IO ()
main  =  do
    n  <-  readLn
    rs  <-  sequence $ replicate n readRectangle
    if solve rs
        then putStrLn "YES"
        else putStrLn "NO"

import Control.Monad (liftM)
import Prelude hiding (reads)

type Point  =  (Int, Int)
type Rectangle  =  (Point, Point)

data Location  =  LD | L | LU | D | C | U | RD | R | RU
  deriving (Eq, Ord)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

readRectangle :: IO Rectangle
readRectangle  =  do
    [a, b, c, d]  <-  reads
    return ((a, b), (c, d))

inside :: Point -> Rectangle -> Bool
inside (x, y) ((a, b), (c, d))
    =  a <= x && x < c && b <= y && y < d

solve :: [Rectangle] -> Bool
solve rs  =  all goodPoint [(x, y) | x <- xs, y <- ys]
  where
    xs  =  map (fst . fst) rs ++ map (fst . snd) rs
    ys  =  map (snd . fst) rs ++ map (snd . snd) rs
    bounds  =  ((minimum xs, minimum ys), (maximum xs, maximum ys))
    getLocation (x, y)
      | x == x1 && y == y1  =  LD
      | x == x1 && y == y2  =  LU
      | x == x1  =  L
      | x == x2 && y == y1  =  RD
      | x == x2 && y == y2  =  RU
      | x == x2  =  R
      | y == y1  =  D
      | y == y2  =  U
      | otherwise  =  C
      where
        ((x1, y1), (x2, y2))  =  bounds
    insideAny p  =  any (inside p) rs
    goodPoint (x, y)
      =  all insideAny $ case getLocation (x, y) of
        LD  ->  [(x, y)]
        L   ->  [(x, y), (x, y - 1)]
        LU  ->  [(x, y- 1)]
        D   ->  [(x - 1, y), (x, y)]
        C   ->  [(x - 1, y - 1), (x, y - 1), (x - 1, y), (x, y)]
        U   ->  [(x - 1, y - 1), (x, y - 1)]
        RD  ->  [(x - 1, y)]
        R   ->  [(x - 1, y - 1), (x - 1, y)]
        RU  ->  [(x - 1, y - 1)]

main :: IO ()
main  =  do
    n  <-  readLn
    rs  <-  sequence $ replicate n readRectangle
    if solve rs
        then putStrLn "YES"
        else putStrLn "NO"


Every year, hundreds of people come to summer camps, they learn new algorithms and solve hard problems.This is your first year at summer camp, and you are asked to solve the following problem. All integers starting with 1 are written in one line. The prefix of these line is "123456789101112131415...". Your task is to print the n-th digit of this string (digits are numbered starting with 1.

The only line of the input contains a single integer n (1 ≤ n ≤ 1000) — the position of the digit you need to print.

NoteIn the first sample the digit at position 3 is '3', as both integers 1 and 2 consist on one digit.In the second sample, the digit at position 11 is '0', it belongs to the integer 10.

import Control.Monad
import Control.Applicative

main = do
  n <- readLn :: IO Int
  let a = concat $ map show [1..]
  putStrLn $ (a !! (n-1)):""

main :: IO()
main = putStrLn . solve . read =<< getLine

prefix :: String
prefix = foldl1 (++) $ map show [1..400]

solve :: Int -> String
solve n = [prefix !! (n - 1)]

{-# 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
    s = concat $ map show [1..]

  putStrLn $ [s !! (n-1)]

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  x <- fmap read getLine
  putStrLn $ solve x : []

solve :: Int -> Char
solve = (([1..] >>= show) !!) . ((+) (-1))

f :: Int -> Char
f a = foldl (\acc x -> acc ++ x) "" (map show [1..1000]) !! (a - 1)
main = do
	n <- getLine
	let a = f (read n :: Int)
	putChar a
	putChar '\n'

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverlappingInstances #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.State
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.List
import           Data.Maybe

type BString = B.ByteString

type Result = Int

solve :: Int -> Result
solve n = read [numbers !! n]
    where numbers = concatMap show [0..]

process :: State Reader Result
process = do
    n <- parse
    return $ solve n

main :: IO ()
main = do
    input <- B.lines <$> B.getContents
    say $ evalState process input

say :: Display a => a -> IO ()
say = putStrLn . display

type Reader = [BString]

class Display a =>
      EIO a where
    parse :: State Reader a
    parse = state $ \(line:rest) -> (scan line, rest)

instance EIO Int
instance EIO [Int]
instance EIO String
instance EIO BString

class (Read a, Show a) =>
      Display a where
    display :: a -> String
    scan :: BString -> a
    display = show
    scan = read . B.unpack

instance Display String where
    display = id
    scan = takeWhile (/='\r') . B.unpack

instance Display BString where
    display = B.unpack
    scan = id

instance Display Int where
    scan = fst . fromJust . B.readInt

instance Display [Int] where
    display = unwords . map display
    scan = unfoldr (B.readInt . B.dropWhile (== ' '))

instance Display [[Int]] where
    display = unlines . map display

{-# OPTIONS_GHC -fno-warn-tabs #-}
import Data.List;
import System.IO;
import Data.Maybe;

toStr :: [String] -> String -> String;
toStr [] s = s;
toStr a s = toStr (tail a) ((head a)++s);

main = do
	str <- getLine;
	let nums = toStr (reverse (map show [1..400])) "";
	let n = read str :: Int;
	putStrLn ([nums!!(n-1)]);

main=interact$(:"\n").f.read
f a=((concat.map show) [1..])!!(a-1)

getDigit :: Int -> Char
getDigit n = last $ take n $ digit

digit :: String
digit = helpDigit 1
    where helpDigit :: Int -> String
          helpDigit n = show n ++ helpDigit (n+1)

main = do
    n <- getLine
    let foo = read n :: Int
    putStrLn $ (getDigit foo):[]

main = putChar . (concatMap show [0..] !!) =<< readLn

main = do
    token <- getLine
    let n = read token
    putChar $ (concatMap show [1..])!!(n-1)

import Text.Printf
calc cur n note len = if len >= n then (reverse note) !! (n-1) else calc (cur+1) n ((reverse(show cur))++note) (len+(length $ show cur))

solve n = (calc 1 n [] 0)

main = do
        a <- getLine
        printf "%c\n" $ solve $ read a

solve = (:[]) . (!!) (concat $ map show [0..]) . read

main = interact solve

solve = (:[]) . (!!) (concat $ map show [1..]) . subtract 1 . read

main = interact solve

import Data.Char

main = readLn >>= print . digitToInt . (!!) (concatMap (show) [0..])

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

m= concat $ map show [0..1000]

main = do
		n<-read <$> getLine ::IO Int
		putStrLn $ [m!!n]

import Control.Applicative

main = do
    n <- read <$> getLine
    putStrLn $ [concatMap show [1..] !! (n-1)]

main = do
    n <- fmap read getLine
    let s = concatMap show [1..]
    putStrLn [s!!(n-1)]

import Data.List (sort)

process :: Int -> Char
process n = (concat (map show [1..]))!!(n-1)

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    putChar $ process n

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: Int -> Char
solve n = head . drop (n-1) . concat . map show $ [1..]

main :: IO ()
main = do
  line <- getLine
  let n = read line :: Int
  putStrLn $ [solve n]

main = putChar . (concatMap show [1..] !!) =<< readLn


Your friend has n cards.You know that each card has a lowercase English letter on one side and a digit on the other.Currently, your friend has laid out the cards on a table so only one side of each card is visible.You would like to know if the following statement is true for cards that your friend owns: "If a card has a vowel on one side, then it has an even digit on the other side." More specifically, a vowel is one of 'a', 'e', 'i', 'o' or 'u', and even digit is one of '0', '2', '4', '6' or '8'.For example, if a card has 'a' on one side, and '6' on the other side, then this statement is true for it. Also, the statement is true, for example, for a card with 'b' and '4', and for a card with 'b' and '3' (since the letter is not a vowel). The statement is false, for example, for card with 'e' and '5'. You are interested if the statement is true for all cards. In particular, if no card has a vowel, the statement is true.To determine this, you can flip over some cards to reveal the other side. You would like to know what is the minimum number of cards you need to flip in the worst case in order to verify that the statement is true.

The first and only line of input will contain a string s (1 ≤ |s| ≤ 50), denoting the sides of the cards that you can see on the table currently. Each character of s is either a lowercase English letter or a digit.

Print a single integer, the minimum number of cards you must turn over to verify your claim.

NoteIn the first sample, we must turn over both cards. Note that even though both cards have the same letter, they could possibly have different numbers on the other side.In the second sample, we don't need to turn over any cards. The statement is vacuously true, since you know your friend has no cards with a vowel on them.In the third sample, we need to flip the second and fourth cards.

main = interact $ show . length . filter (`elem` "aeiou13579")

main = do
    s <- getLine
    print . length $ [(x, y) | x <- s, y <- "aeiou13579", x == y]

import Data.List
main = do
    s <- getLine
    print . sum . map (length . flip elemIndices s) $ "aeiou13579"

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

main = do
	n<- getLine
	print $ length $ filter (\z-> elem z "aeiou13579") n

process :: [Char] -> Int
process = length . filter (`elem` "aeiou13579")

main :: IO ()
main = do
    s <- getLine
    print $ process s

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . lines

sol :: [String] -> [String]
sol [as] = wrap.show $ foldl (\n x-> n + (fromBool $ x `elem` "aeiou13579")) 0 as

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

main = do
    a <- getLine
    print (qwq a)

qwq a = length [x|x <- a , qaq x]

qaq x = elem x "aeiou13579"

main = do
    str <- getLine
    print $ sum $ map (\c -> if c `elem` "aeiou13579" then 1 else 0) str

import Data.Char
import Data.List
main = getLine >>= print . length . filter (\c -> c `elem` ("ueoai" :: String) || isDigit c && odd (digitToInt c))

import System.IO

main = do
  s <- getLine
  print (solve s)

solve = length . (filter (`elem` "aeiou13579"))

main = do
  str <- getLine
  print $ length $ filter (`elem` "aeiou13579") str

main = fmap (filter (`elem` "aeiou13579")) getLine >>= print.length

f::Char->Int
f x
   |x `elem` "13579"=1
   |x `elem` "aiueo"=1
   |otherwise=0

main = do
       e<-getLine
       print $ last $ scanl (+) 0 $ map f e

import Control.Applicative

main::IO ()
main=do
  x<- getLine
  print $ length $ filter (\z-> elem z "aeiou13579") x

main = interact $ show . length . filter (`elem` "aeiouy")

import Data.Char
import Data.List
main = getLine >>= print . length . filter (\c -> c `elem` ("ueoai" :: String) || isDigit c && even (digitToInt c)) . nub

import Data.Char
main = getLine >>= print . length . filter (\c -> c `elem` ("ueoai" :: String) || isDigit c && even (digitToInt c))

main = interact $ show . length . filter (`elem` "aeiouy13579")


User ainta is making a web site. This time he is going to make a navigation of the pages. In his site, there are n pages numbered by integers from 1 to n. Assume that somebody is on the p-th page now. The navigation will look like this: << p - k p - k + 1 ... p - 1 (p) p + 1 ... p + k - 1 p + k >> When someone clicks the button "<<" he is redirected to page 1, and when someone clicks the button ">>" he is redirected to page n. Of course if someone clicks on a number, he is redirected to the corresponding page.There are some conditions in the navigation:  If page 1 is in the navigation, the button "<<" must not be printed.  If page n is in the navigation, the button ">>" must not be printed.  If the page number is smaller than 1 or greater than n, it must not be printed.   You can see some examples of the navigations. Make a program that prints the navigation.

The first and the only line contains three integers n, p, k (3 ≤ n ≤ 100; 1 ≤ p ≤ n; 1 ≤ k ≤ n)

Print the proper navigation. Follow the format of the output from the test samples.

import Data.List
import Control.Monad (forM_)

pages :: Int -> Int -> Int -> [String]
pages n p k =
  let lo = max 1 (p-k)
      hi = min n (p+k)
      lt = if lo > 1 then ["<<"] else []
      gt = if hi < n then [">>"] else []
      f i = if i == p then "(" ++ show i ++ ")" else show i
  in lt ++ map f [lo..hi] ++ gt

(-->) = flip fmap

main = do
  (n:p:k:_) <- getLine --> words --> map read
  forM_ (intersperse " " (pages n p k)) $ putStr
  putStrLn ""

-- print << only if lo > 1
-- print >> only if hi < n
-- lo = max 1 (p - k)
-- hi = min (p + k) n

import Data.List

solve :: Int -> Int -> Int -> String
solve n p k =
   let m = map ([1..n]!!) $ filter (\x -> x >= 0 && x < n) [p-1-k..p-1+k]
       (a,b) = break (==p) m
       myshow = unwords . map show
   in dropWhile (==' ') $  (if null a then "" else if head a == 1 then "" else "<< " ) ++
      myshow a ++ " (" ++ (show $ head b) ++ ") " ++ (myshow $ tail b) ++
      (if last b == n then "" else " >>" )

main = do
  v@[n,p,k] <- map (read  :: String -> Int)  . words <$> getLine
  putStrLn $ solve n p k

import Data.List

f::Int->[Int]->[String]
f x []=[]
f x (y:ys)
    |x==y=("("++(show x)++")"):f x ys
    |otherwise=(show y):f x ys

main =do
      e<-getLine
      let (n:p:k:[])=map read (words e)::[Int]
          ts=[e2|e2<-[(p-k)..(p+k)],e2>0,e2<=n]
          l=head ts
          r=last ts
          t=unwords $ f p ts
          t2=if l==1 then "" else "<< "
          t3=if r==n then "" else " >>"
      putStrLn $ t2++t++t3

import Data.List

getpage :: Int -> Int -> Int -> [Char]
getpage tot pre bod =
    let p = if (pre - bod <= 1) then "" else "<< "
        e = if (pre + bod >= tot) then "" else " >>"
        m = max 1 (pre - bod)
        n = min tot (pre + bod)
        f i j = i ++ show j ++ " "
        k = if ((pre >= 1) && (pre <= tot)) then "(" ++ show pre ++ ")" else ""
        g i j = i ++ " " ++ show j
    in p ++ foldl f "" [m..pre - 1] ++ k ++ foldl g "" [pre + 1..n] ++ e

main = do
    g <- getLine
    let h = map read (words g)
    putStr $ getpage (h !! 0) (h !! 1) (h !! 2)

import Data.List

scaleLeft :: Int -> Int -> Int -> String
scaleLeft size position shift | ((position - shift) - 1) <= 0 =  intercalate " " $ map show $ [1 .. position - 1]
scaleLeft size position shift =  "<< " ++ ( intercalate " " $ map show $ [position - shift .. position -1] )

scaleRight :: Int -> Int -> Int -> String
scaleRight size position shift | position + shift >= size =  intercalate " " $ map show $ [position + 1 .. size]
scaleRight size position shift = (intercalate " " $ map show $ [position + 1 .. position + shift] ) ++ " >>"

scale :: Int -> Int -> Int -> String
scale size position shift = (scaleLeft size position shift) ++ " (" ++ (show position) ++ ") "  ++ (scaleRight size position shift)

main :: IO ()
main = do
  [size, position, shift] <- fmap (map read . words) getLine
  let result = scale size position shift
  putStrLn result

import Data.List

getpage :: Int -> Int -> Int -> [Char]
getpage tot pre bod =
    let p = if (pre - bod <= 1) then "" else "<< "
        e = if (pre + bod >= tot) then "" else " >>"
        m = max 1 (pre - bod)
        n = min tot (pre + bod)
        f i j = i ++ show j ++ " "
        k = if ((pre >= 1) && (pre <= tot)) then "(" ++ show pre ++ ")" else ""
        g i j = i ++ " " ++ show j
    in p ++ foldl f "" [m..pre - 1] ++ k ++ foldl g "" [pre + 1..n] ++ e

main = do
    g <- getLine
    let h = map read (words g)
    print $ getpage (h !! 0) (h !! 1) (h !! 2)

import Data.List

scaleLeft :: Int -> Int -> Int -> String
scaleLeft size position shift | ((position - shift) - 1) <= 0 =  intercalate " " $ map show $ [1 .. position - 1]
scaleLeft size position shift =  "<< " ++ ( intercalate " " $ map show $ [position - shift .. position -1] )

scaleRight :: Int -> Int -> Int -> String
scaleRight size position shift | position + shift >= size =  intercalate " " $ map show $ [position + 1 .. size]
scaleRight size position shift = (intercalate " " $ map show $ [position + 1 .. position + shift] ) ++ " >>"

scale :: Int -> Int -> Int -> String
scale size position shift = (scaleLeft size position shift) ++ " (" ++ (show position) ++ ") "  ++ (scaleRight size position shift)

main :: IO ()
main = do
  [size, position, shift] <- fmap (map read . words) getLine
  let result = scale size position shift
  print result


You have a plate and you want to add some gilding to it. The plate is a rectangle that we split into $$$w\times h$$$ cells. There should be $$$k$$$ gilded rings, the first one should go along the edge of the plate, the second one — $$$2$$$ cells away from the edge and so on. Each ring has a width of $$$1$$$ cell. Formally, the $$$i$$$-th of these rings should consist of all bordering cells on the inner rectangle of size $$$(w - 4(i - 1))\times(h - 4(i - 1))$$$.  The picture corresponds to the third example. Your task is to compute the number of cells to be gilded.

The only line contains three integers $$$w$$$, $$$h$$$ and $$$k$$$ ($$$3 \le w, h \le 100$$$, $$$1 \le k \le \left\lfloor \frac{min(n, m) + 1}{4}\right\rfloor$$$, where $$$\lfloor x \rfloor$$$ denotes the number $$$x$$$ rounded down) — the number of rows, columns and the number of rings, respectively.

Print a single positive integer — the number of cells to be gilded.

NoteThe first example is shown on the picture below.  The second example is shown on the picture below.  The third example is shown in the problem description.

import Data.List

f ::Int->Int->Int->Int
f w h k
   |w<=0 || h<=0 || k<=0=0
   |otherwise=(w*h-(w-2)*(h-2))+f (w-4) (h-4) (k-1)

main = do
       e1<-getLine
       let (w:h:k:[])=map read (words e1)::[Int]
       print $ f w h k

main = do
  [n,m,k] <- fmap (map read . words) getLine
  print . sum . take k . iterate (flip (-) 16) $ 2 * (n + m) - 4

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

main = do
		[w,h,k]<- map read <$> words <$> getLine::IO [Int]
		print $ sum $ zipWith (\a b-> a+a+b+b-4)  (take k [w,w-4..]) (take k [h,h-4..])

countGilded :: Int -> Int -> Int -> Int
countGilded w h k = 2 * k * (w + h - 4 * k + 2)

readInt :: String -> Int
readInt = read

main = do
    [w,h,k] <- fmap (map readInt . words) getLine
    print $ countGilded w h k

makeRing :: (Int, Int) -> Int
makeRing (1, h) = h
makeRing (w, 1) = w
makeRing (w, h) = 2 * (w + h) - 4

smallerRing :: (Int, Int) -> (Int, Int)
smallerRing (w, h) = (w - 4, h - 4)

plates :: Int -> Int -> Int -> Int
plates w h k = sum golds
    where rings = take k $ iterate smallerRing (w, h)
          golds = map makeRing rings

main :: IO ()
main = do
    input <- getLine
    let inputs = map (read :: String -> Int) (words input)
    let output = plates (inputs!!0) (inputs!!1) (inputs!!2)
    print output

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

solve (w:h:1:_) = if 0 < min w h then 2 * (w + h - 2) else 0
solve (w:h:k:_) = 2 * (w + h - 2) + solve [w - 4, h - 4, k - 1]

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

main = do
		[w,h,k]<- map read <$> words <$> getLine::IO [Int]
		print $ zipWith (\a b-> a+a+b+b-4)  (take k [w,w-4..]) (take k [h,h-4..])


One day Igor K. stopped programming and took up math. One late autumn evening he was sitting at a table reading a book and thinking about something. The following statement caught his attention: "Among any six people there are either three pairwise acquainted people or three pairwise unacquainted people"Igor just couldn't get why the required minimum is 6 people. "Well, that's the same for five people, too!" — he kept on repeating in his mind. — "Let's take, say, Max, Ilya, Vova — here, they all know each other! And now let's add Dima and Oleg to Vova — none of them is acquainted with each other! Now, that math is just rubbish!"Igor K. took 5 friends of his and wrote down who of them is friends with whom. Now he wants to check whether it is true for the five people that among them there are either three pairwise acquainted or three pairwise not acquainted people.

The first line contains an integer m (0 ≤ m ≤ 10), which is the number of relations of acquaintances among the five friends of Igor's. Each of the following m lines contains two integers ai and bi (1 ≤ ai, bi ≤ 5;ai ≠ bi), where (ai, bi) is a pair of acquainted people. It is guaranteed that each pair of the acquaintances is described exactly once. The acquaintance relation is symmetrical, i.e. if x is acquainted with y, then y is also acquainted with x.

Print "FAIL", if among those five people there are no either three pairwise acquainted or three pairwise unacquainted people. Otherwise print "WIN".

import Control.Monad
twoint :: String -> (Int,Int)
twoint = p . words
    where p (a:b:[]) = (read a, read b)

solve :: [(Int,Int)] -> Bool
solve gs = or $ concat [ [pacq a b c gs,punacq a b c gs] | a<-[1..5], b<-[1..5], c<-[1..5], a/=b, b/=c, a/=c]

pacq a b c gs = acq a b gs && acq b c gs && acq a c gs
punacq a b c gs = not (acq a b gs) && not (acq b c gs) && not (acq a c gs)
acq a b gs = elem (a,b) gs || elem (b,a) gs

main = do
    m <- (liftM read) getLine
    gs <- forM [1..m] (\i -> getLine >>= return . twoint)
    let r = solve gs
    putStrLn $ if r then "WIN" else "FAIL"

module Main where

import Control.Monad
import Data.Array.IO
import Data.Array
import Data.List

main = do
    friendship <- buildFriendship :: IO (Array (Int,Int) Bool)
    putStrLn $ if foldl' (\res i ->
            res || foldl' (\res j ->
                    res || foldl' (\res k ->
                            let a = friendship ! (i,j)
                                b = friendship ! (i,k)
                                c = friendship ! (j,k)
                            in res || a == b && b == c
                        ) res [j+1..5]
                ) res [i+1..5]
        ) False [1..5]
        then "WIN"
        else "FAIL"

buildFriendship = do
    m <- read `liftM` getLine

    friendship <- newArray ((1,1), (5,5)) False :: IO (IOArray (Int,Int) Bool)
    replicateM m $ do
        [a, b] <- ( map read . words ) `liftM` getLine
        writeArray friendship (a,b) True
        writeArray friendship (b,a) True

    unsafeFreeze friendship

import Control.Monad (replicateM)

readPair :: IO (Int, Int)
readPair  =  do
    [x, y]  <-  getLine >>= return . map read . words
    if x > y then return (y,x) else return (x,y)

solve :: [(Int, Int)] -> Bool
solve xs  =  x || y
  where
    x  =  not $ null [(i,j,k) |
                     i <- [1..5], j <- [i+1..5], k <- [j+1..5],
                     all (flip elem xs) [(i,j),(i,k),(j,k)]]
    y  =  not $ null [(i,j,k) |
                     i <- [1..5], j <- [i+1..5], k <- [j+1..5],
                     all (not . flip elem xs) [(i,j),(i,k),(j,k)]]

main :: IO ()
main  =  do
    n  <-  readLn
    xs  <-  replicateM n readPair
    putStrLn (if (solve xs)
      then "WIN" else "FAIL")

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

readPair :: String -> (Int, Int)
readPair = (\[x, y] -> (x, y)).map read.words

makeGraph xs = map swap g ++ g
  where g = map readPair xs

invertGraph n g = [(a, b) | a <- vers, b <- vers,
                   a /= b,
                   not ((a, b) `elem` g)]
  where vers = [1..n]

loops n g = [(a, b, c) | a <- vers, b <- vers, c <- vers,
             (a, b) `elem` g,
             (b, c) `elem` g,
             (c, a) `elem` g]
  where vers = [1..n]

solve xs = let g     = makeGraph xs
               g'    = invertGraph 5 g
               red   = null $ loops 5 g
               black = null $ loops 5 g'
           in if red && black then "FAIL" else "WIN"

main = interact $ solve.tail.lines

import Control.Monad (foldM)
import qualified Data.IntSet as S
import qualified Data.IntMap as M
import Data.List
main = do
    n <- read `fmap` getLine
    m <- foldM (\map' _ -> do
        [a, b] <- (sort . map read . words) `fmap` getLine
        return $ M.insertWith S.union a (S.singleton b) map') M.empty [1..n]
    let f (a, b, c) = let
            [as, bs] = map (\a -> M.findWithDefault S.empty a m) [a, b]
            pairs = [(b, as), (c, as), (c, bs)] in
            any (\f -> all (uncurry f) pairs) [S.member, S.notMember]
    putStrLn $ if any f [(a, b, c) | a <- [1..5], b <- [1..5], c <- [1..5], a < b, b < c]
        then "WIN" else "FAIL"


InputThe input contains a single integer a (10 ≤ a ≤ 999).OutputOutput 0 or 1.ExamplesInput13Output1Input927Output1Input48Output0

process :: Int -> Int
process n = n `mod` 2

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    print $ process n

main = do
    t <- getLine
    let w = read t
    putStrLn $ show (mod w 2)

main = do
       e<-getLine
       let n=read e::Int
       print $ n `mod` 2

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= print

sol = (`mod` 2)

import Data.Functor

main = do
  a <- read <$> getLine
  print $ a `mod` 2

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

main = do
		n<- read <$> getLine:: IO Int
		print $ if even n then 0 else 1

import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= print

sol = (`div` 2)

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

main = do
		getLine
		print 1


Polycarp loves ciphers. He has invented his own cipher called Right-Left.Right-Left cipher is used for strings. To encrypt the string $$$s=s_{1}s_{2} \dots s_{n}$$$ Polycarp uses the following algorithm:  he writes down $$$s_1$$$,  he appends the current word with $$$s_2$$$ (i.e. writes down $$$s_2$$$ to the right of the current result),  he prepends the current word with $$$s_3$$$ (i.e. writes down $$$s_3$$$ to the left of the current result),  he appends the current word with $$$s_4$$$ (i.e. writes down $$$s_4$$$ to the right of the current result),  he prepends the current word with $$$s_5$$$ (i.e. writes down $$$s_5$$$ to the left of the current result),  and so on for each position until the end of $$$s$$$. For example, if $$$s$$$="techno" the process is: "t" $$$\to$$$ "te" $$$\to$$$ "cte" $$$\to$$$ "cteh" $$$\to$$$ "ncteh" $$$\to$$$ "ncteho". So the encrypted $$$s$$$="techno" is "ncteho".Given string $$$t$$$ — the result of encryption of some string $$$s$$$. Your task is to decrypt it, i.e. find the string $$$s$$$.

The only line of the input contains $$$t$$$ — the result of encryption of some string $$$s$$$. It contains only lowercase Latin letters. The length of $$$t$$$ is between $$$1$$$ and $$$50$$$, inclusive.

Print such string $$$s$$$ that after encryption it equals $$$t$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  ls <- getLine
  let n = length ls
      (l0,r) = splitAt ((n+1) `shiftR` 1) ls
      l = reverse l0
      go (x:xs) ys = x:go ys xs
      go [] ys = ys
  putStrLn $ go l r

ans :: [Char] -> [Char]
ans [] = []
ans (h:[]) = [h]
ans (h:t)
    | (mod (length t) 2) == 0 = ans(t) ++ [h]
    | otherwise = ans (take ((length t)) (h:t)) ++ [t!!((length t)-1)]

main = do
    s <- getLine :: IO String;
    putStrLn $ ans s

module Main where

import Data.List

decrypt [] [] = []
decrypt [a] [] = [a]
decrypt (a:as) (b:bs) = a:b:decrypt as bs

main = do
    s <- getLine
    let (a,b) = splitAt ((flip  div) 2 $ succ $ length s) s
    putStrLn $ decrypt (reverse a) b

main = getLine >>= putStrLn . solve

solve xs = drop lxs $ concat $ zipWith (:) l $ map (:[]) r
    where lxs = length xs
          (l,r) = if odd lxs then (xs, reverse xs) else (reverse xs, xs)

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

main = do
	a<-getLine
	let n = length a
	let s = div (n+1) 2
	let b= a ++ if even n then "" else " "
	putStrLn $ concat $ zipWith (\x y ->[x]++[y])  (reverse (take s b)) (drop s b)