Let's call a fraction $$$\frac{x}{y}$$$ good if there exists at least one another fraction $$$\frac{x'}{y'}$$$ such that $$$\frac{x}{y} = \frac{x'}{y'}$$$, $$$1 \le x', y' \le 9$$$, the digit denoting $$$x'$$$ is contained in the decimal representation of $$$x$$$, and the digit denoting $$$y'$$$ is contained in the decimal representation of $$$y$$$. For example, $$$\frac{26}{13}$$$ is a good fraction, because $$$\frac{26}{13} = \frac{2}{1}$$$.You are given an integer number $$$n$$$. Please calculate the number of good fractions $$$\frac{x}{y}$$$ such that $$$1 \le x \le n$$$ and $$$1 \le y \le n$$$. The answer may be really large, so print it modulo $$$998244353$$$.

The only line of the input contains one integer $$$n$$$ ($$$1 \le n < 10^{100}$$$).

Print the number of good fractions $$$\frac{x}{y}$$$ such that $$$1 \le x \le n$$$ and $$$1 \le y \le n$$$. The answer may be really large, so print it modulo $$$998244353$$$.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS -O2 #-}

import Control.Applicative (liftA2)
import Control.Monad (filterM, guard)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Bits ((.&.), (.|.), setBit, shiftL, shiftR, testBit)
import Data.Char (ord)
import Data.Int (Int8)

import Control.Monad.ST (ST, runST)

-- import Data.HashTable.ST.Cuckoo (HashTable)
import Data.IntMap.Strict (IntMap, empty, insert, lookup)

import Control.DeepSeq (NFData, deepseq)
import GHC.Generics (Generic)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)
import Prelude hiding (lookup)

newtype ModuloRing (p :: Nat) =
  ModuloRing Natural
  deriving (Eq, Generic)

instance NFData (ModuloRing p)

char :: KnownNat p => ModuloRing p -> Natural
char = natVal

instance KnownNat p => Show (ModuloRing p) where
  show (ModuloRing a) = show a

instance KnownNat p => Num (ModuloRing p) where
  (+) x@(ModuloRing a) (ModuloRing b) =
    ModuloRing $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(ModuloRing a) (ModuloRing b) = ModuloRing $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = ModuloRing . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(ModuloRing a) =
    ModuloRing $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

data Task =
  Task !Int !Int !Int !Int !Int !Int
  deriving (Show)

-- [index, xMask, yMask, xCarry, yCarry, exceed]
-- [7, 4, 4, 4, 4, 1]
hash :: Task -> Int
hash (Task index xMask yMask xCarry yCarry exceed) =
  index `shiftL` 17 .|. xMask `shiftL` 13 .|. yMask `shiftL` 9 .|.
  xCarry `shiftL` 5 .|.
  yCarry `shiftL` 1 .|.
  exceed

{-# INLINE hash #-}
type Modulo = ModuloRing 998244353

type Env = (Int, Int, [Int])

type Hash = IntMap Modulo

search :: Env -> Task -> State Hash Modulo
search (x, y, n) task@(Task index xMask yMask xCarry yCarry exceed) =
  case n of
    []
      | exceed == 1 -> return 0
      | xCarry /= 0 || yCarry /= 0 -> return 0
      | xMask .&. yMask > 0 -> return 1
      | otherwise -> return 0
    d:n' -> do
      h <- get
      let hc = hash task
          maxk = 9 `div` y
      case lookup hc h of
        Just m -> return m
        Nothing -> do
          v <-
            sum <$>
            sequence
              [ let index' = index + 1
                    (xCarry', xd) = (x * dk + xCarry) `quotRem` 10
                    (yCarry', yd) = (y * dk + yCarry) `quotRem` 10
                    exceed' =
                      case compare yd d of
                        LT -> 0
                        EQ -> exceed
                        GT -> 1
                    add d p mask =
                      let (k, r) = d `quotRem` p
                       in if r == 0 && 0 < k && k <= maxk
                            then setBit mask (k - 1)
                            else mask
                    xMask' = add xd x xMask
                    yMask' = add yd y yMask
                 in search
                      (x, y, n')
                      (Task index' xMask' yMask' xCarry' yCarry' exceed')
              | dk <- [0 .. 9]
              ]
          modify (insert hc v)
          return v

solve :: String -> Modulo
solve n =
  (fromInteger (read n) +) . (2 *) . sum $
  [ evalState (search (x, y, n') (Task 0 0 0 0 0 1)) empty
  | y <- [2 .. 9]
  , x <- [1 .. y - 1]
  , gcd x y == 1
  ]
  where
    !n' = fmap (\c -> ord c - 48) . reverse . show . (+ 1) . read $ n

main = getLine >>= print . solve

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS -O2 #-}

import Control.Applicative (liftA2)
import Control.Monad (filterM, guard)
import Control.Monad.State.Strict (State, evalState, get, modify, put)
import Data.Bits ((.&.), (.|.), setBit, shiftL, shiftR, testBit)
import Data.Char (ord)
import Data.Int (Int8)

import Control.Monad.ST (ST, runST)

-- import Data.HashTable.ST.Cuckoo (HashTable)
import Data.IntMap.Strict (IntMap, empty, insert, lookup)

import Control.DeepSeq (NFData, deepseq)
import GHC.Generics (Generic)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Numeric.Natural (Natural)
import Prelude hiding (lookup)

newtype ModuloRing (p :: Nat) =
  ModuloRing Natural
  deriving (Eq, Generic)

instance NFData (ModuloRing p)

char :: KnownNat p => ModuloRing p -> Natural
char = natVal

instance KnownNat p => Show (ModuloRing p) where
  show (ModuloRing a) = show a

instance KnownNat p => Num (ModuloRing p) where
  (+) x@(ModuloRing a) (ModuloRing b) =
    ModuloRing $
    if a + b >= mm
      then a + b - mm
      else a + b
    where
      mm = char x
  (*) x@(ModuloRing a) (ModuloRing b) = ModuloRing $ (a * b) `mod` mm
    where
      mm = char x
  fromInteger a = ret
    where
      mm = toInteger (char ret)
      ret = ModuloRing . fromInteger . (`mod` mm) . (+ mm) . (`mod` mm) $ a
  negate x@(ModuloRing a) =
    ModuloRing $
    if a == 0
      then 0
      else mm - a
    where
      mm = char x
  abs = id
  signum _ = 1

data Task =
  Task !Int !Int !Int !Int !Int !Int
  deriving (Show)

-- [index, xMask, yMask, xCarry, yCarry, exceed]
-- [7, 4, 4, 4, 4, 1]
hash :: Task -> Int
hash (Task index xMask yMask xCarry yCarry exceed) =
  index `shiftL` 17 .|. xMask `shiftL` 13 .|. yMask `shiftL` 9 .|.
  xCarry `shiftL` 5 .|.
  yCarry `shiftL` 1 .|.
  exceed

{-# INLINE hash #-}
type Modulo = ModuloRing 998244353

type Env = (Int, Int, [Int])

type Hash = IntMap Modulo

search :: Env -> Task -> State Hash Modulo
search (x, y, n) task@(Task index xMask yMask xCarry yCarry exceed) =
  case n of
    []
      | exceed == 1 -> return 0
      | xCarry /= 0 || yCarry /= 0 -> return 0
      | xMask .&. yMask > 0 -> return 1
      | otherwise -> return 0
    d:n' -> do
      h <- get
      let hc = hash task
      case lookup hc h of
        Just m -> return m
        Nothing -> do
          v <-
            sum <$>
            sequence
              [ let index' = index + 1
                    (xCarry', xd) = (x * dk + xCarry) `divMod` 10
                    (yCarry', yd) = (y * dk + yCarry) `divMod` 10
                    exceed' =
                      case compare yd d of
                        LT -> 0
                        EQ -> exceed
                        GT -> 1
                    maxk = 9 `div` y
                    add d p mask =
                      let (k, r) = d `divMod` p
                       in if r == 0 && 0 < k && k <= maxk
                            then setBit mask (k - 1)
                            else mask
                    xMask' = add xd x xMask
                    yMask' = add yd y yMask
                 in search
                      (x, y, n')
                      (Task index' xMask' yMask' xCarry' yCarry' exceed')
              | dk <- [0 .. 9]
              ]
          modify (insert hc v)
          return v

solve :: String -> Modulo
solve n =
  (fromInteger (read n) +) . (2 *) . sum $
  [ evalState (search (x, y, n') (Task 0 0 0 0 0 1)) empty
  | y <- [2 .. 9]
  , x <- [1 .. y - 1]
  , gcd x y == 1
  ]
  where
    !n' = fmap (\c -> ord c - 48) . reverse . show . (+ 1) . read $ n

main = getLine >>= print . solve


Holidays have finished. Thanks to the help of the hacker Leha, Noora managed to enter the university of her dreams which is located in a town Pavlopolis. It's well known that universities provide students with dormitory for the period of university studies. Consequently Noora had to leave Vičkopolis and move to Pavlopolis. Thus Leha was left completely alone in a quiet town Vičkopolis. He almost even fell into a depression from boredom!Leha came up with a task for himself to relax a little. He chooses two integers A and B and then calculates the greatest common divisor of integers "A factorial" and "B factorial". Formally the hacker wants to find out GCD(A!, B!). It's well known that the factorial of an integer x is a product of all positive integers less than or equal to x. Thus x! = 1·2·3·...·(x - 1)·x. For example 4! = 1·2·3·4 = 24. Recall that GCD(x, y) is the largest positive integer q that divides (without a remainder) both x and y.Leha has learned how to solve this task very effective. You are able to cope with it not worse, aren't you?

The first and single line contains two integers A and B (1 ≤ A, B ≤ 109, min(A, B) ≤ 12).

Print a single integer denoting the greatest common divisor of integers A! and B!.

NoteConsider the sample.4! = 1·2·3·4 = 24. 3! = 1·2·3 = 6. The greatest common divisor of integers 24 and 6 is exactly 6.

factorial n = foldr (*) 1 [1..n]
main = interact $ show . factorial . minimum . map read . words

import Data.List

main :: IO ()
main = do
    str <- getLine
    print $ foldr (*) 1 [1..minimum $ map read $ words str]

import Data.List

main :: IO ()
main = do
    str <- getLine
    print $ fact 1 $ minimum $ map read $ words str
    where
        fact ans 1 = ans
        fact ans n = fact (ans*n) (n-1)

import Data.List

main :: IO ()
main = do
    str <- getLine
    print $ fact $ minimum $ map read $ words str
    where
        fact 1 = 1
        fact num = num * (fact $ num-1)

import Data.List

main :: IO ()
main = do
    str <- getLine
    print $ foldl' (*) 1 [1..minimum $ map read $ words str]

module Main where

import Data.List

get_ans :: Integer -> Integer -> Integer
get_ans a b = fact (min a b)
	where
		fact x = if x == 0 then 1 else x * fact (x - 1)

main :: IO ()
main = do
	l <- getLine
	let [a, b] = map (read :: String -> Integer)  (words l)
	print (get_ans a b)

factorial uu pp
  | uu == 0 = 1
  | uu == 1 = pp
  | otherwise = factorial (pred uu) (pp * uu)

main = do
  ff <- getLine
  let a = (read (head (words ff)))::Int
      b = (read (last (words ff)))::Int

      ans = factorial (minimum [a,b]) 1

  putStrLn (show ans)

import Control.Monad
import Data.Char
import Data.List
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

mygcd :: Int -> Int -> Int
mygcd a b
  | a < b = fac a
  | otherwise = fac b

fac :: Int -> Int
fac 0 = 1
fac n = n * fac (n - 1)

main :: IO ()
main = do
  Just(a, _):Just(b, _):_ <- fmap (map C.readInt) $ fmap (C.split ' ') C.getLine
  putStrLn . show $ mygcd a b

main = do
  a:b:_ <- fmap ((map read) . words) getLine :: IO [Int]
  putStrLn . show . fac $ min a b
fac :: Int -> Int
fac n = foldr (*) 1 [1..n]

main = interact $ unlines . map (show . factorial . minimum . map read . words) . lines
factorial::Integer->Integer
factorial n = foldl (*) 1 [1..n]

-- Try Codeforces
-- author: Leonardone @ NEETSDKASU

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

solve [a,b] = f x where
    x = min a b
    f 1 = 1
    f k = k * f (k - 1)

solve (a:b:_)=show$mygcd ai bi where
	ai=read a::Int
	bi=read b::Int
	mygcd x y = product [2..(min ai bi)]
main=interact$solve.words.head.lines

import Data.List

main = do
  getLine >>= (\x -> putStrLn.show.(\x -> product [1..x]).minimum.(map (read :: String -> Integer)) $ words x)

main = do
  [a,b] <- getLine >>= return . map (\x -> read x :: Int) . words
  print $ product $ [2.. min a b]

fac :: Int -> Int
fac 0 = 1
fac n = n * fac (n - 1)

main :: IO ()
main = do
  [a, b] <- fmap (map read . words) getLine
  putStrLn $ show $ fac $ min a b

main = interact $ show . factorial . minimum . map read . words
factorial::Integer->Integer
factorial n = foldl (*) 1 [1..n]

main = interact foo

foo :: String -> String
foo inp =
    let [a, b] = take 2 . map read . words . head . lines $ inp :: [Int]
    in show $ fact $ min a b

fact :: Int -> Int
fact 0 = 1
fact 1 = 1
fact n = n * fact (n-1)

-- from a mobile device
import Prelude (IO, interact, ($), (.), (*), (-), (++), (>), show, uncurry, map, read, take, words, Int, otherwise)

main :: IO ()
main = interact $ (++ "\n") . show . uncurry gcd . tuple 2 . map read . take 2 . words
  where
    tuple 2 [a,b] = (a,b)

gcd :: Int -> Int -> Int
gcd a b | a > b = gcd b a | otherwise = fact a
  where
    fact 1 = 1
    fact n = n * fact (n-1)

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

main=do

  [a,b]<- map read <$> words <$> getLine ::IO [Integer]
  print $ product [1..(min a b)]

-- 2019-11-25 10:45:02.892536166 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:46:34.367674432 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:48:15.007409441 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:26:04.163844848 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:09:14.854199438 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:23:39.26826971 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:58:05.369023262 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:21:49.895679233 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:52:03.575036272 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:49:25.937477002 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:07:55.088370928 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:53:42.422713997 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:20:42.445797077 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:55:32.972108116 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para (min b a) 1 (\c d -> d * (1 +) c)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

main = interact $ show . solve . map read . words
solve [a,b] = product [1..min a b]

getint :: String -> [Int]
getint a = map read (words a)

fact :: Int -> Int
fact 1 = 1
fact n = n * fact (n - 1)
main = do
    input <- getLine
    let [a, b] = getint input
    print(fact(min a b))

import Control.Applicative( (<$>))

main = do
    [a_, b_] <- map (read::String->Integer) . words <$> getLine

    print $ if a_<b_
	    then product [1..a_]
	    else product [1..b_]

main = do
  [a, b] <- getLine >>= return . map read . words
  print . product $ [1..a `min` b]

main = do
  [a, b] <- getLine >>= return . map read . words
  print . product . take (a `min` b) $ [1..]

import Control.Monad

getNum :: Integer -> Integer -> Integer
getNum a p = getNum_ a p p

getNum_ :: Integer -> Integer -> Integer -> Integer
getNum_ a cur p
  | cur > a = 0
  | otherwise = (a `div` cur) + getNum_ a (cur * p) p

main = do
  [a, b] <- getLine >>= return . map read . words
  tmp <- forM [2,3,5,7,11] $ \p -> do
    let x = getNum a p
    let y = getNum b p
    return (p, x `min` y)
  print . product $ map (uncurry (^)) tmp

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve a b = product [1..min a b]

main = do
  [a, b] <- fmap readInts B.getLine
  print $ solve a b

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

process::Integer->Integer->Integer
process a b = product [1..c]
	where c= minimum [a, b]

main::IO ()
main=do
  [a,b]<-  map read <$> words <$> getLine::IO [Integer]
  print $ process a b

process :: Int -> Int -> Int
process a b = product [1..(min a b)]

readInt :: String -> Int
readInt = read

main = do
    line <- getLine
    let [a,b] = map readInt (words line)
    print $ process a b

factorial n = foldr (*) n [1..n]
main = interact $ show . factorial . minimum . map read . words

primes (p:ps) = p : [q | q <- filter ((/=0).(`mod`p)) ps]
main = do
  [a,b] <- getLine >>= return . map (\x -> read x :: Int) . words
  print $ product $ takeWhile (<= min a b) $ primes [2..]

-- 2019-11-25 10:56:25.525339662 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:44:19.640833202 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> (1 +) ((1 +) ((1 +) (min b a)))
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:08:31.856169546 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:07:23.420064243 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para b ((1 +) ((1 +) a)) (\_ d -> d)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:52:59.212327532 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:54:35.577685845 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para 1 b (\_ _ -> (1 +) ((1 +) a))
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:22:32.535737398 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para 1 b (\_ _ -> (1 +) ((1 +) a))
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:51:33.044098939 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para b ((1 +) ((1 +) a)) (\_ d -> d)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:21:11.938920681 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:10:30.55336758 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para 1 b (\_ _ -> (1 +) ((1 +) a))
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:47:26.506753033 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> (1 +) ((1 +) ((1 +) (min b a)))
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:19:48.82684758 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para b ((1 +) ((1 +) a)) (\_ d -> d)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:48:44.030105627 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:24:17.523612564 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-24 22:05:42.717675918 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a b -> nat_para b ((1 +) ((1 +) a)) (\_ d -> d)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))

-- 2019-11-25 10:45:42.248226788 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' f (a, b) = show $ f a b
parser :: String -> (Int, Int)
parser = fromJust . parseTwoInts
parseTwoInts :: String -> Maybe (Int, Int)
parseTwoInts i = do {when (length (lines i) /= 1) Nothing;
                     ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                     when (length ns /= 2) Nothing;
                     let {[a, b] = ns};
                     return (a, b)}
solve = \a _ -> (1 +) ((1 +) a)
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))


This task will exclusively concentrate only on the arrays where all elements equal 1 and/or 2.Array a is k-period if its length is divisible by k and there is such array b of length k, that a is represented by array b written exactly  times consecutively. In other words, array a is k-periodic, if it has period of length k.For example, any array is n-periodic, where n is the array length. Array [2, 1, 2, 1, 2, 1] is at the same time 2-periodic and 6-periodic and array [1, 2, 1, 1, 2, 1, 1, 2, 1] is at the same time 3-periodic and 9-periodic.For the given array a, consisting only of numbers one and two, find the minimum number of elements to change to make the array k-periodic. If the array already is k-periodic, then the required value equals 0.

The first line of the input contains a pair of integers n, k (1 ≤ k ≤ n ≤ 100), where n is the length of the array and the value n is divisible by k. The second line contains the sequence of elements of the given array a1, a2, ..., an (1 ≤ ai ≤ 2), ai is the i-th element of the array.

Print the minimum number of array elements we need to change to make the array k-periodic. If the array already is k-periodic, then print 0.

NoteIn the first sample it is enough to change the fourth element from 2 to 1, then the array changes to [2, 1, 2, 1, 2, 1].In the second sample, the given array already is 4-periodic.In the third sample it is enough to replace each occurrence of number two by number one. In this case the array will look as [1, 1, 1, 1, 1, 1, 1, 1, 1] — this array is simultaneously 1-, 3- and 9-periodic.

-- Codeforces 371A

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.List

main :: IO ()
main = do
    (n:k:xs) <- (map read . words) <$> getContents
    print . sum . map minimize . groupd k (n `div` k) $ xs
  where
    minimize xs = let (a, b) = foldl' (\(a, b) x -> if x == 1
                                                       then (a + 1, b)
                                                       else (a, b + 1)) (0, 0) xs
                   in min a b
    groupd k h xs = [[ xs !! (i * k + j) | i <- [0 .. (h - 1)] ] | j <- [0 .. (k - 1)]]

#!/usr/bin/env runghc
import Data.List
--import Data.List.Split
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (nk:ai:cs) = (:solve cs)$ show . sum . map f . transpose . chunksOf k $ a
  where
    [n,k] = map read . words $ nk
    a = map read . words $ ai::[Int]
f ns = length ns - (maximum . map length . group . sort) ns
chunksOf k [] = []
chunksOf k e = a:chunksOf k b
  where (a,b) = splitAt k e

solve :: [[Int]] -> Int
solve xs = if null xs
           then 0
           else
             let tmp = head xs
                 len = length tmp
                 one_count = length $ filter (\x->x==1) tmp
             in (min one_count (len-one_count)) + (solve $ tail xs)

splitSeq :: [Int] -> Int -> Int -> [[Int]]
splitSeq xs cur k = if null xs
                    then replicate k []
                    else
                      let tmp = splitSeq (tail xs) (mod (cur+1) k) k
                      in (\(l,x:r)->l++(((head xs):x):r)) $ splitAt cur tmp

toInt :: String -> Int
toInt x = read x :: Int

main = do s1 <- getLine
          s2 <- getLine
          let k = last $ map toInt (words s1)
              xs = map toInt (words s2)
              ys = splitSeq xs 0 k
          putStrLn $ show $ solve ys


IT City company developing computer games invented a new way to reward its employees. After a new game release users start buying it actively, and the company tracks the number of sales with precision to each transaction. Every time when the next number of sales is divisible by all numbers from 2 to 10 every developer of this game gets a small bonus.A game designer Petya knows that the company is just about to release a new game that was partly developed by him. On the basis of his experience he predicts that n people will buy the game during the first month. Now Petya wants to determine how many times he will get the bonus. Help him to know it.

The only line of the input contains one integer n (1 ≤ n ≤ 1018) — the prediction on the number of people who will buy the game.

Output one integer showing how many numbers from 1 to n are divisible by all numbers from 2 to 10.

main :: IO ()
main = print . (`div` 2520) =<< readLn

main = getLine >>= print . solve . read

solve :: Integer -> Integer
solve n = n `div` (8 * 9 * 5 * 7)

import Control.Monad
main = do
    a <- liftM read getLine
    putStrLn $ show $ (a `div` 2520)

import Control.Applicative
import Data.Array

main= do
	n<- read  <$>getLine::IO Integer
	let c = foldl lcm 1 [2..10]
	print $ div n c

main :: IO ()
main = print . solve . read =<< getContents

solve :: Integer -> Integer
solve n = n `div` 2520


Noora is a student of one famous high school. It's her final year in school — she is going to study in university next year. However, she has to get an «A» graduation certificate in order to apply to a prestigious one.In school, where Noora is studying, teachers are putting down marks to the online class register, which are integers from 1 to k. The worst mark is 1, the best is k. Mark that is going to the certificate, is calculated as an average of all the marks, rounded to the closest integer. If several answers are possible, rounding up is produced. For example, 7.3 is rounded to 7, but 7.5 and 7.8784 — to 8. For instance, if Noora has marks [8, 9], then the mark to the certificate is 9, because the average is equal to 8.5 and rounded to 9, but if the marks are [8, 8, 9], Noora will have graduation certificate with 8.To graduate with «A» certificate, Noora has to have mark k.Noora got n marks in register this year. However, she is afraid that her marks are not enough to get final mark k. Noora decided to ask for help in the internet, where hacker Leha immediately responded to her request. He is ready to hack class register for Noora and to add Noora any number of additional marks from 1 to k. At the same time, Leha want his hack be unseen to everyone, so he decided to add as less as possible additional marks. Please help Leha to calculate the minimal number of marks he has to add, so that final Noora's mark will become equal to k.

The first line contains two integers n and k (1 ≤ n ≤ 100, 1 ≤ k ≤ 100) denoting the number of marks, received by Noora and the value of highest possible mark. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ k) denoting marks received by Noora before Leha's hack.

Print a single integer — minimal number of additional marks, that Leha has to add in order to change Noora's final mark to k.

NoteConsider the first example testcase.Maximal mark is 10, Noora received two marks — 8 and 9, so current final mark is 9. To fix it, Leha can add marks [10, 10, 10, 10] (4 marks in total) to the registry, achieving Noora having average mark equal to . Consequently, new final mark is 10. Less number of marks won't fix the situation.In the second example Leha can add [5, 5, 5] to the registry, so that making average mark equal to 4.5, which is enough to have 5 in the certificate.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến n k as = max 0 $ 2 * (k * n - sum as) - n

main = do
  n:k:_ <- readInts <$> B.getLine
  as <- readInts <$> B.getLine
  print $ chiến n k as

-- (s + kx)/(n + x)>=k-0.5
-- s+kx>=kn+kx-0.5(n+x)
-- s >= kn-0.5(n+x)
-- 0.5(n+x)>=kn-s
-- x>=2(kn-s)-n

import Data.Functor

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

parsePairs [] = []
parsePairs (x:y:rs) = (x, y) : parsePairs rs

main = do
    xs <- getInts
    print $ solve xs

solve (_:k:xs) = max 0 $ (2*k-1)*(length xs) - 2*(sum xs)

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

fi=fromIntegral
rd x = read x::Int
getNumbers=map rd.words
extract (a:b:_)=(m,x) where
	(_:m:_)=getNumbers a
	x=getNumbers b

solve (m,x) = till0 (2*m*n-2*s-n) where
	s=sum x
	n=length x
	till0 x
		|x>0 = x
		|otherwise = 0

main=interact$show.solve.extract.lines

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, k] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    grades <- liftM (\l -> read <$> words l) getLine
    let s = sum grades
        a = n*(2*k - 1) - 2*s
    print $ max 0 a

import Data.Functor ((<$>))

main :: IO ()
main = do
  n:k:_ <- readLine
  scores <- readLine
  putStrLn $ show $ solution n k (take (fromInteger n) scores)
  where readLine = map (read :: String -> Integer) . words <$> getLine

solution :: Integer -> Integer -> [Integer] -> Integer
solution n k scores = max ans 0
  where ans = (2 * k - 1) * n - 2 * s
        s = sum scores

main = do
  (n:k:[]) <- (fmap (map read . words) $ getLine) :: IO [Int]
  xs <- (fmap (map read . words) $ getLine) :: IO [Int]
  print $ max 0 $ (\x -> x*2-n) $ sum $ map (k-) xs

--ghc 7.6

mean ::[Int] -> Double
mean xs = (fromIntegral.sum) xs / (fromIntegral.length) xs

minmarks :: [Int] -> Int -> Int
minmarks marks k
	|mean marks >= (fromIntegral k) - 0.5 = 0
	|otherwise = 1 + (minmarks (k:marks) k)

main = do

	[n, k] <- (map read.words) `fmap` getLine
	marks <- (map read.words) `fmap` getLine
	print $ minmarks marks k

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến n k as = 2 * (k * n - sum as) - n

main = do
  n:k:_ <- readInts <$> B.getLine
  as <- readInts <$> B.getLine
  print $ chiến n k as

-- (s + kx)/(n + x)>=k-0.5
-- s+kx>=kn+kx-0.5(n+x)
-- s >= kn-0.5(n+x)
-- 0.5(n+x)>=kn-s
-- x>=2(kn-s)-n

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

fi=fromIntegral
rd x = read x::Int
getNumbers=map rd.words
extract (a:b:_)=(m,x) where
	(_:m:_)=getNumbers a
	x=getNumbers b

solve (m,x)=2*m*n-2*s-n where
	s=sum x
	n=length x

main=interact$show.solve.extract.lines

{-# LANGUAGE BangPatterns #-}

import Data.Maybe
import Data.Int
import Data.Bool
import Data.List
import Control.Monad

modulant :: Int64
modulant = 1000000007

twos :: [Int64]
twos = work 1
    where
        work c = c : work (let x = 2*c in if x > modulant then x - modulant else x)

main :: IO ()
main = do
    [n, k] <- liftM (\l -> (read :: String -> Int) <$> words l) getLine
    grades <- liftM (\l -> read <$> words l) getLine
    let s = sum grades
    if 2*s >= 2*n*k - 1 then
        print 0
    else do
        let a = n*(2*k - 1) - 2*s
        print a

import Data.Functor ((<$>))

main :: IO ()
main = do
  n:k:_ <- readLine
  scores <- readLine
  putStrLn $ show $ solution n k (take (fromInteger n) scores)
  where readLine = map (read :: String -> Integer) . words <$> getLine

solution :: Integer -> Integer -> [Integer] -> Integer
solution n k scores = (2 * k - 1) * n - 2 * (sum scores)

main = do
  (n:k:[]) <- (fmap (map read . words) $ getLine) :: IO [Int]
  xs <- (fmap (map read . words) $ getLine) :: IO [Int]
  print $ (\x -> x*2-n) $ sum $ map (k-) xs

main = do
  [n, k] <- (map read.words) `fmap` getLine
  xs <- (map read.words) `fmap` getLine
  putStr $ show $ n*(2*k-1) - 2*(sum $! xs)


InputThe input contains two integers a1, a2 (0 ≤ ai ≤ 109), separated by a single space.OutputOutput a single integer.ExamplesInput3 14Output44Input27 12Output48Input100 200Output102

main = do
	l<-getLine
	let [a,b]=words l
	putStrLn $ show $ solve2 a b

solve2::String->String->Integer
solve2 a b = (read a) + (read (reverse b))

main :: IO ()
main = do
    s <- getLine
    let [sa, sb] = words s
        a = read sa :: Integer
        b = read $ reverse sb :: Integer
    print (a + b)

main = do
  [a,b] <- fmap  words getLine
  print (read a + read (reverse b))

main = getLine >>= putStrLn . show . (\[x,y] -> read (x) + read(reverse y)) . words

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

solve :: Integer -> Integer -> Integer
solve a b  =  a + (read $ reverse $ show b)

main :: IO ()
main = do
    [a, b] <- Main.reads
    print $ solve a b

solve [a, b] = read a + read (reverse b)
main = interact $ show . solve . words

import System.IO
import Control.Monad

parseInt :: String -> Int
parseInt x = read x

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering -- DO NOT REMOVE

    -- Auto-generated code below aims at helping you parse
    -- the standard input according to the problem statement.

    line <- getLine
    let xs = words line
    putStrLn $ show $ (parseInt $ xs!!0) + (parseInt $ reverse $ xs!!1)
    return ()

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, OverloadedStrings #-}
{-# 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
    a <- readInteger
    b <- read . reverse . BS.unpack <$> readString
    return (a, b)
  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 = print =<< solve . evalState parseInput <$> BS.getContents

solve (a, b) = a + b

-- {{{ A minimal State Monad
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
-- }}}

solve [a, b] = a + (read . reverse . show) b
main = fmap (map read . words) getLine >>= print . solve

main = do
	[a,b] <- fmap words getLine
	print $ read a + read (reverse b)

main :: IO ()
main =
    do cs <- getContents
       (putStr .show.solve.parseIn) cs

parseIn :: String -> [Integer]
parseIn = map read . words

solve ::[Integer] -> Integer
solve [a,b] = a + (revVal (b,0))

revVal (0,a) = a
revVal (n,a) = revVal ((div n 10),a * 10 + (mod n 10))

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Data.List
import Debug.Trace
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

solve :: B.ByteString -> B.ByteString -> Integer
solve s r = a + b
  where a = fromIntegral $ atoi s
        b = fromIntegral $ atoi (B.reverse r)

input :: IO Int
input = do
    [n] <- map atoi . B.words <$> B.getLine
    return n

main = do
    [a, b] <- B.words <$> B.getLine
    putStrLn . show $ solve a b

main = do
	l<-getLine
	let [a,b]=words l
	putStrLn $ show $ solve a b

solve::String->String->Integer
solve a b | length a< length b = solve  b (replicate (dif) '0' ++ a)
          | length a> length b = solve a (replicate (dif) '0' ++ b)
          | otherwise = (read a) + (read (reverse b))
   where dif =abs $ length a - length b

main = do
	l<-getLine
	let [a,b]=words l
	putStrLn $ show $ solve a b

solve::String->String->Integer
solve "0" b = (read (reverse b))
solve a b | length a< length b = solve  b (replicate (dif) '0' ++ a)
          | length a> length b = solve a (replicate (dif) '0' ++ b)
          | otherwise = (read a) + (read (reverse b))
   where dif =abs $ length a - length b


Little boy Valera studies an algorithm of sorting an integer array. After studying the theory, he went on to the practical tasks. As a result, he wrote a program that sorts an array of n integers a1, a2, ..., an in the non-decreasing order. The pseudocode of the program, written by Valera, is given below. The input of the program gets number n and array a.loop integer variable i from 1 to n - 1    loop integer variable j from i to n - 1        if (aj > aj + 1), then swap the values of elements aj and aj + 1But Valera could have made a mistake, because he hasn't yet fully learned the sorting algorithm. If Valera made a mistake in his program, you need to give a counter-example that makes his program work improperly (that is, the example that makes the program sort the array not in the non-decreasing order). If such example for the given value of n doesn't exist, print -1.

You've got a single integer n (1 ≤ n ≤ 50) — the size of the sorted array.

Print n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 100) — the counter-example, for which Valera's algorithm won't work correctly. If the counter-example that meets the described conditions is impossible to give, print -1. If there are several counter-examples, consisting of n numbers, you are allowed to print any of them.

import Control.Applicative
import Data.List

main= do
	n<-   read  <$> getLine ::IO Int
	putStrLn $ if n<3 then "-1" else intercalate " " $ map show [n,n-1..1]

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

main :: IO ()
main = getLine >>= mapM_ (\x -> putStr $ show x ++ " ")  .(\x -> if (x <= 2) then [-1] else [x, (x-1) ..1]). read. head.words

main :: IO()
main = prettify . solve . (\x -> read x :: Int) =<< getLine

solve :: Int -> Maybe [Int]
solve n
    | n <= 2    = Nothing
    | otherwise = Just (reverse [1..n])

prettify :: Maybe [Int] -> IO()
prettify Nothing = putStrLn "-1"
prettify (Just list) = putStrLn $ unwords . map show $ list

main = interact $ unwords . (map show) . solve . read . head . lines
solve 1 = [-1]
solve 2 = [-1]
solve n = [n] ++ replicate (n-2) 2 ++ [1]

import Data.List

solve :: Int -> String
solve n
    | n <= 2    = "-1"
    | otherwise = "100 100 " ++ intercalate " " [show x | x <- (take (n - 2) [1..])]

main :: IO ()
main = do
    n <- readLn :: IO Int
    putStrLn $ solve n

main = do
  n <- fmap read getLine
  if n <= 2
    then print $ -1
    else putStrLn $ unwords $ map show $ [2 .. n] ++ [1]

getList :: Int -> [Int]
getList n
	| n == 1	= []
	| n == 2	= []
	| n == 3	= 3:2:1:[]
	| otherwise	= n : getList (n - 1)

printList :: [Int] -> IO()
printList [] = do
	putStrLn ""
printList (a:b) = do
	putStr ((show a) ++ " ")
	printList b

main :: IO()
main = do
	str <- getLine
	let ans = getList (read (str))
	if (null ans)
		then putStrLn "-1"
		else printList ans

main = getLine >>= (\x -> putStrLn $ unwords $ map show $ f (read x::Int))

f :: Int -> [Int]
f a
    | a==1 || a==2 = [-1]
    | otherwise = reverse [1..a]

import Data.List
f n = case n of
    1 -> [-1]
    2 -> [-1]
    a -> [a,a-1..1]
main = (readLn :: IO Int) >>= putStrLn . concat . intersperse " " . map show . f

import Data.List (intercalate)

main :: IO ()
main  =  do
    n  <-  readLn
    if n < 3
        then print (-1)
        else putStrLn $ intercalate " " $ map show $ (2:3:(replicate (n-2) 1))

s n
  | n <= 2 = [-1]
  | True   = [n, n - 1 .. 1]

main = interact $ unwords . map show . s . read

main=interact$unwords.map show.f.read
f n|n<3=[-1]|1>0=[n,n-1..1]

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

solve :: Integer -> [Integer]
solve n | n < 3 = [ -1 ]
        | otherwise = [n, n - 1 .. 1]

import Data.List (intercalate)

main :: IO ()
main  =  do
    n  <-  readLn
    if n < 3
        then print (-1)
        else putStrLn $ intercalate " " $ map show $ (1:2:(replicate (n-2) 1))


In the city of Ultima Thule job applicants are often offered an IQ test. The test is as follows: the person gets a piece of squared paper with a 4 × 4 square painted on it. Some of the square's cells are painted black and others are painted white. Your task is to repaint at most one cell the other color so that the picture has a 2 × 2 square, completely consisting of cells of the same color. If the initial picture already has such a square, the person should just say so and the test will be completed. Your task is to write a program that determines whether it is possible to pass the test. You cannot pass the test if either repainting any cell or no action doesn't result in a 2 × 2 square, consisting of cells of the same color.

Four lines contain four characters each: the j-th character of the i-th line equals "." if the cell in the i-th row and the j-th column of the square is painted white, and "#", if the cell is black.

Print "YES" (without the quotes), if the test can be passed and "NO" (without the quotes) otherwise.

NoteIn the first test sample it is enough to repaint the first cell in the second row. After such repainting the required 2 × 2 square is on the intersection of the 1-st and 2-nd row with the 1-st and 2-nd column.

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

solve :: [String] -> Bool
solve ss  =  or  $ do
    i  <-  [0..2]
    j  <-  [0..2]
    let s  =  [ss !! i !! j, ss !! i !! (j+1), ss !! (i+1) !! j, ss !! (i+1) !! (j+1)]
    return (sort s /= "##..")

main :: IO ()
main  =  do
    ss  <-  sequence [getLine, getLine, getLine, getLine]
    if solve ss
        then putStrLn "YES"
        else putStrLn "NO"

  where

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

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

data Color = Black | White deriving (Eq,Show)
type Board = [[Color]]

check :: Board -> Bool
check board = any (==True) $ map (square board) [(i,j) | i <- [0..2] , j <- [0..2]]

square :: Board -> (Int,Int) -> Bool
square board pos = allEqual elems where
    (i,j) = pos
    elems = map (flip access board) [(i,j),(i+1,j),(i,j+1),(i+1,j+1)]

allEqual :: Eq a => [a] -> Bool
allEqual (x:xs) = all (==x) xs

access :: (Int,Int) -> Board -> Color
access (i,j) board = (board !! i ) !! j

convert :: Board -> [Board]
convert board =board:boards where
    boards = map (convert' board) [(i,j) | i <- [0..3] , j <- [0..3]]
    convert' bd (i,j) = take i bd ++[convert'' j (bd !! i)] ++ drop (i+1) bd
    convert'' j line = take j line ++ [rev (line !! j)] ++ drop (j+1) line

rev :: Color -> Color
rev Black = White
rev White = Black

iq :: Board -> Bool
iq = any (== True).map check.convert

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

toBoard :: [String] -> Board
toBoard = map toColor

toColor :: String -> [Color]
toColor [] = []
toColor ('#':xs) = Black:toColor xs
toColor ('.':xs) = White:toColor xs

main = do
    l1 <- getLine
    l2 <- getLine
    l3 <- getLine
    l4 <- getLine
    putStrLn.answer.iq $ toBoard [l1, l2, l3, l4]

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

solve :: [String] -> Bool
solve cs = or [ length [ () | i' <- [i..i+1], j' <- [j..j+1], cs !! i' !! j' == '#' ] /= 2 | i <- [0..2], j <- [0..2] ]

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

take2x2 :: [String] -> Int -> Int -> String
take2x2 strs i j = strs!!i!!j : strs!!(i+1)!!j : strs!!i!!(j+1) : [strs!!(i+1)!!(j+1)]

countChar :: String -> Char -> Int
countChar "" c = 0
countChar (x:xs) c = if x==c then 1 + (countChar xs c) else countChar xs c

hantei :: String -> Bool
hantei str = if (countChar str '.')>=3 || (countChar str '#')>=3
             then True
             else False
boolTostr True = "YES"
boolTostr False = "NO"

main = do input <- getContents
          putStrLn (boolTostr (or (map hantei [take2x2 (lines input) i j|i<-[0,1,2], j<-[0,1,2]])))

import Control.Applicative
import Data.List

check a x | s>=3 || s<=1 = True
          |otherwise = False
		where s =  a!!x +a!!(x+1)+a!!(x+4)+a!!(x+5)

tr '.' = 1
tr '#' = 0

main= do
	a<- concat .lines <$> getContents
	let aa = map tr a
	putStrLn $ if or ( map (check aa) [0,1,2,4,5,6,8,9,10]) then "YES" else "NO"

import Data.List

main = interact $ yesno . solve . lines

yesno False = "YES"
yesno True = "NO"
solve xs = all (2==) . map elems $ prepare xs
    where
        prepare l@(_:xs) = concat $ zipWith dup l xs
        dup l r = zipWith (\(a1,a2) (b1,b2) -> [a1,a2,b1,b2]) (pairwise l) (pairwise r)
        pairwise l@(_:xs) = zip l xs
        elems xs = max (count '#' xs) (count '.' xs)
        count x xs = length $ elemIndices x xs

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

solve :: [String] -> Bool
solve ss  =  or  $ do
    i  <-  [0..2]
    j  <-  [0..2]
    let s  =  [ss !! i !! j, ss !! i !! (j+1), ss !! (i+1) !! j, ss !! (i+1) !! (j+1)]
    return (sort s /= "##..")

main :: IO ()
main  =  do
    ss  <-  sequence [getLine, getLine, getLine, getLine]
    if solve ss
        then putStrLn "yes"
        else putStrLn "no"

  where

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

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

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

solve :: [String] -> Bool
solve cs = or [ length [ () | i' <- [i..i+1], j' <- [j..j+1], cs !! i' !! j' == '#' ] == 3 | i <- [0..2], j <- [0..2] ]

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

take2x2 :: [String] -> Int -> Int -> String
take2x2 strs i j = strs!!i!!j : strs!!(i+1)!!j : strs!!i!!(j+1) : [strs!!(i+1)!!(j+1)]

countChar :: String -> Char -> Int
countChar "" c = 0
countChar (x:xs) c = if x==c then 1 + (countChar xs c) else countChar xs c

hantei :: String -> Bool
hantei str = if (countChar str '.')>=3 || (countChar str '#')>=3
             then True
             else False
boolTostr True = "YES"
boolTostr False = "NO"

main = do input <- getContents
          print (boolTostr (or (map hantei [take2x2 (lines input) i j|i<-[0,1,2], j<-[0,1,2]])))


You want to arrange n integers a1, a2, ..., an in some order in a row. Let's define the value of an arrangement as the sum of differences between all pairs of adjacent integers.More formally, let's denote some arrangement as a sequence of integers x1, x2, ..., xn, where sequence x is a permutation of sequence a. The value of such an arrangement is (x1 - x2) + (x2 - x3) + ... + (xn - 1 - xn).Find the largest possible value of an arrangement. Then, output the lexicographically smallest sequence x that corresponds to an arrangement of the largest possible value.

The first line of the input contains integer n (2 ≤ n ≤ 100). The second line contains n space-separated integers a1, a2, ..., an (|ai| ≤ 1000).

Print the required sequence x1, x2, ..., xn. Sequence x should be the lexicographically smallest permutation of a that corresponds to an arrangement of the largest possible value.

NoteIn the sample test case, the value of the output arrangement is (100 - ( - 50)) + (( - 50) - 0) + (0 - 50) + (50 - ( - 100)) = 200. No other arrangement has a larger value, and among all arrangements with the value of 200, the output arrangement is the lexicographically smallest one.Sequence x1, x2, ... , xp is lexicographically smaller than sequence y1, y2, ... , yp if there exists an integer r (0 ≤ r < p) such that x1 = y1, x2 = y2, ... , xr = yr and xr + 1 < yr + 1.

import Data.List
import Control.Applicative

main :: IO ()
main = getLine >> sort <$> map read <$> words <$> getLine >>= putStrLn . solve

solve :: [Int] -> String
solve xs = show (last xs) ++ " " ++ intercalate " " (show <$> (init $ tail xs)) ++ " " ++ show (head xs)

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

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

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

main = do
  getLine
  xs <- getInts

  let
    a = maximum xs
    b = minimum xs

  putStr $ unwords $ map show $ [a] ++ sort (xs \\ [a, b]) ++ [b]

import Control.Monad (liftM, unless, when)
import Data.List (group, intercalate, sort)
import Prelude hiding (reads)

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

solve :: [Int] -> [Int]
solve xs  =   concat [[last xs'], init (tail xs'), [head xs']]
  where
    xs'  =  sort xs

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

main :: IO ()
main  =  getLine >> reads >>= prints . solve

module Main where
-- import Control.Monad
import Data.List
import Data.Array
main :: IO ()
main = do
    _ <- getLine
    line <- getLine
    let ints = map read $ words line :: [Integer]
        (ma,mi) = (maximum ints, minimum ints)
        (otherints,_,_) = foldl (\(filtered,foundMax,foundMin) e ->
                                    case (e == ma, e==mi, foundMax, foundMin) of
                                      (True, _, False,_) -> (filtered, True, foundMin)
                                      (_, True, _, False) -> (filtered, foundMax, True)
                                      _ -> (e:filtered, foundMax, foundMin))
                                ([],False,False)
                                ints
    putStrLn $ unwords $ map show (ma:sort otherints ++ [mi])

import Data.List
import Text.Printf

middle :: [a] -> [a]
middle = init . tail

swapFirstLast :: [Integer] -> [Integer]
swapFirstLast xs = [last xs] ++ (middle xs) ++ [head xs]

main = do
    [n] <- (map (read :: String -> Integer) . words) `fmap` getLine
    seq <- (map (read :: String -> Integer) . words) `fmap` getLine
    let res = concat $ map ((++ " ") . show) $ swapFirstLast $ sort seq
    putStrLn res

import Data.List (sort)

main :: IO ()
main = putStrLn . unwords . map show . solve . tail . map read . words =<< getContents

solve :: [Int] -> [Int]
solve xs = [ maximum xs ] ++ init (tail (sort xs)) ++ [ minimum xs ]

module Main where

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

main = do
    getLine
    ns <- map read <$> words <$> getLine
    mapM_ (\x -> putStr (show x ++ " ")) $ solve ns
    putStrLn ""

remFirst :: Int -> [Int] -> [Int]
remFirst _ [] = []
remFirst p (x:xs) | p==x = xs
                  | otherwise = x : remFirst p xs

solve :: [Int] -> [Int]
solve xs =
    let min = minimum xs
        max = maximum xs
    in max : (sort $ remFirst min $ remFirst max xs) ++ [min]

main = do
    input <- getLine
    let n = read (input) :: Int
    input <- getLine
    let input' = f $ split ' ' input
    let sorted = qsort input'
    let rev = reverse sorted
    putStrLn (show (head rev) ++ foldl (\x y -> x ++ " " ++ show y) "" (init (tail sorted)) ++ " " ++ show (last rev))

f :: [String] -> [Int]
f x = map read x

qsort :: (Ord a) => [a] -> [a]
qsort [] = []
qsort (x:xs) = qsort [a | a <- xs, a <= x] ++ [x] ++ qsort [a | a <- xs, a > x]

split' :: (Eq a) => a -> [a] -> [a] -> [[a]]
split' _ [] l = [l]
split' v (x:xs) l
   | x /= v = split' v xs (l ++ [x])
   | otherwise = [l] ++ split' v xs []

split :: (Eq a) => a -> [a] -> [[a]]
split v xs = split' v xs []

import Data.List
import Data.Char

ans xs = (last ys):(tail.init $ ys)++[head ys]
    where ys= sort xs

main = do
    getLine
    n<-getLine
    let input = map (\x->read x::Int) $ words n
    putStrLn $ unwords $ map show $ ans input

import Data.List

cal ls = let sorted = map (+0) $ sort $ map read $ words $ ls !! 1
	 in foldl1 (\x y -> x++" "++y) $ map show $ swap $ reverse sorted

swap ls = let rev = reverse ls
	      revNoHead = reverse $ tail ls
	  in [head ls] ++ tail revNoHead ++ [head rev]

main = interact ( cal . lines)

import Data.List
import Data.Char
import Data.Maybe
import Control.Applicative
import Debug.Trace
import qualified Data.ByteString.Char8 as B

debug x = trace (show x) x
(|>) x f = f x; infixl 1 |>
(||>) mx f = mx >>= (return . f); infixl 1 ||>
ref = (!!)

toDigit n = chr (48 + n)
readInt = fst . fromJust . B.readInt

solve xs =
  a : (sort ls ++ [b])
  where
    a = maximum xs
    b = minimum xs
    ls = delete a $ delete b xs

main = do
  ls <- B.getContents ||> B.lines
  xs <- (ref ls 1) |> B.words |> map readInt |> return
  putStrLn $ join $ solve xs
  where
    join [x] = show x
    join (x:xs) = show x ++ " " ++ join xs

module Main where

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

main = do
    getLine
    ns <- map read <$> words <$> getLine
    mapM_ (\x -> putStr (show x ++ " ")) $ solve ns
    putStrLn ""

remFirst :: Int -> [Int] -> [Int]
remFirst _ [] = []
remFirst p (x:xs) | p==x = xs
                  | otherwise = x : remFirst p xs

remLast :: Int -> [Int] -> [Int]
remLast x xs = reverse $ remFirst x (reverse xs)

solve :: [Int] -> [Int]
solve xs =
    let min = minimum xs
        max = maximum xs
    in max : (remLast min $ remFirst max xs) ++ [min]

main = do
    input <- getLine
    let n = read (input) :: Int
    input <- getLine
    let input' = f $ split ' ' input
    let sorted = reverse $ qsort input'
    putStrLn (show (head sorted) ++ foldl (\x y -> x ++ " " ++ show y) "" (tail sorted))

f :: [String] -> [Int]
f x = map read x

qsort :: (Ord a) => [a] -> [a]
qsort [] = []
qsort (x:xs) = qsort [a | a <- xs, a <= x] ++ [x] ++ qsort [a | a <- xs, a > x]

split' :: (Eq a) => a -> [a] -> [a] -> [[a]]
split' _ [] l = [l]
split' v (x:xs) l
   | x /= v = split' v xs (l ++ [x])
   | otherwise = [l] ++ split' v xs []

split :: (Eq a) => a -> [a] -> [[a]]
split v xs = split' v xs []

import Data.List

cal ls = let sorted = map (+0) $ sort $ map read $ words $ ls !! 1
	 in foldl1 (\x y -> x++" "++y) $ map show $ swap sorted

swap ls = takeEven ls (reverse ls) 0

takeEven ls rev c
	| ls == [] || rev==[] = []
	| odd c = (head ls) : takeEven (tail ls) (tail rev) (c+1)
	| otherwise = (head rev) : takeEven (tail ls) (tail rev) (c+1)

main = interact ( cal . lines)

import Data.List

cal ls = let sorted = map (+0) $ sort $ map read $ words $ ls !! 1
	 in foldl1 (\x y -> x++" "++y) $ map show $ swap sorted

swap ls = takeEven ls (reverse ls) 0

takeEven ls rev c
	| ls == [] || rev==[] = []
	| odd c = (head rev) : takeEven (tail ls) (tail rev) (c+1)
	| otherwise = (head ls) : takeEven (tail ls) (tail rev) (c+1)

main = interact ( cal . lines)

import Data.List

cal ls = let sorted = map (+0) $ sort $ map read $ words $ ls !! 1
	 in foldl1 (\x y -> x++" "++y) $ map show $ swap sorted

swap ls = let rev = reverse ls
	      revNoHead = reverse $ tail ls
	  in [head ls] ++ tail revNoHead ++ [head rev]

main = interact ( cal . lines)


You are given a regular polygon with $$$n$$$ vertices labeled from $$$1$$$ to $$$n$$$ in counter-clockwise order. The triangulation of a given polygon is a set of triangles such that each vertex of each triangle is a vertex of the initial polygon, there is no pair of triangles such that their intersection has non-zero area, and the total area of all triangles is equal to the area of the given polygon. The weight of a triangulation is the sum of weigths of triangles it consists of, where the weight of a triagle is denoted as the product of labels of its vertices.Calculate the minimum weight among all triangulations of the polygon.

The first line contains single integer $$$n$$$ ($$$3 \le n \le 500$$$) — the number of vertices in the regular polygon.

Print one integer — the minimum weight among all triangulations of the given polygon.

NoteAccording to Wiki: polygon triangulation is the decomposition of a polygonal area (simple polygon) $$$P$$$ into a set of triangles, i. e., finding a set of triangles with pairwise non-intersecting interiors whose union is $$$P$$$.In the first example the polygon is a triangle, so we don't need to cut it further, so the answer is $$$1 \cdot 2 \cdot 3 = 6$$$.In the second example the polygon is a rectangle, so it should be divided into two triangles. It's optimal to cut it using diagonal $$$1-3$$$ so answer is $$$1 \cdot 2 \cdot 3 + 1 \cdot 3 \cdot 4 = 6 + 12 = 18$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
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.Lazy.Safe (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy.Safe as STL
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  n <- readInt <$> getLine
  print $ sum $ zipWith (*) [2..(n-1)] [3..n]

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

solve n = sum xs where
    xs = [i * (i - 1) | i <- [3..n]]

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