Vasya has n pairs of socks. In the morning of each day Vasya has to put on a pair of socks before he goes to school. When he comes home in the evening, Vasya takes off the used socks and throws them away. Every m-th day (at days with numbers m, 2m, 3m, ...) mom buys a pair of socks to Vasya. She does it late in the evening, so that Vasya cannot put on a new pair of socks before the next day. How many consecutive days pass until Vasya runs out of socks?

The single line contains two integers n and m (1 ≤ n ≤ 100; 2 ≤ m ≤ 100), separated by a space.

Print a single integer — the answer to the problem.

NoteIn the first sample Vasya spends the first two days wearing the socks that he had initially. Then on day three he puts on the socks that were bought on day two.In the second sample Vasya spends the first nine days wearing the socks that he had initially. Then he spends three days wearing the socks that were bought on the third, sixth and ninth days. Than he spends another day wearing the socks that were bought on the twelfth day.

calc :: Int -> Int -> Int -> Int
calc 0 d m = d - 1
calc n d m
    | d `mod` m == 0 = calc n (d + 1) m
    | otherwise = calc (n - 1) (d + 1) m

main = do
    line <- getLine
    let ns = map read (words line) :: [Int]
    print $ calc (ns !! 0) 1 (ns !! 1)

import Control.Monad;
import Data.List;
main = getLine >>= print . solve . map read . words

solve :: [Integer] -> Integer
solve [m, n]
      |  m >= n    = (n+) $ solve [m - n + 1, n]
      | otherwise = m

process :: Int -> Int -> Int
process n m = n + ((n-1) `div` (m-1))

readInt :: String -> Int
readInt = read

main = do
    [n,m] <- fmap (map readInt.words) getLine
    print $ process n m

socks :: Int ->  Int -> Int -> Int
socks 0 _ _ = 0
socks n m d = 1 + socks (n - 1 + new) m (d + 1)
    where new = if (d `rem` m == 0) then 1 else 0

solve :: String -> String
solve s = show $ socks n m 1
    where (n:m:_) = (fmap read . words) s

main :: IO ()
main = interact $ solve

f n m = f' n m 1
        where f' socks m days   | socks == 0 = days-1
                                | days `mod` m  == 0 = f' socks m (days+1)
                                | otherwise = f' (socks-1) m (days+1)
main = do
  line <- getLine
  let [n,m] = map read $ words line :: [Int]
      ans = f n m
  print ans

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

solve :: Int -> Int -> Int
solve n m = f n m 1
  where f socks m days
          | socks == 0 = days -1
          | days `mod` m == 0 = f socks m (days+1)
          | otherwise = f (socks - 1) m (days + 1)

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad

process m cur days
  | cur == 0 = days
  | otherwise = process m (cur-1 + if days `mod` m == 0 then 1 else 0) (days+1)

main = do
  [n,m] :: [Int] <- map read . words <$> getLine
  print $ process m n 0 - 1

days :: Int -> Int -> Int -> Int
days d 0 _ = d - 1
days d n m = let ads = if d `mod` m == 0
                       then 1
                       else 0
             in days (d + 1) (n - 1 + ads) m

main = do
    twoInts <- getLine
    let [n, m] = map (read::String->Int) $ words twoInts
    print $ days 1 n m

module Main (main)
    where

main :: IO ()
main = print . solve 1 . take 2 . map read . words =<< getLine
    where solve c [0,_] = c - 1
          solve c [n,m] = let r = if c `mod` m == 0 then 1 else 0
                           in solve (c + 1) [n - 1 + r,m]

main = do
	t <-getLine
	let [n,m] = map read $ words t
	putStrLn $ show $ solve n m 1

solve 0 m c = c-1
solve n m c = if mod c m == 0 then solve n m (c+1) else solve (n-1) m (c+1)

solve :: [Int] -> Int
solve [n, m] = solve' 1 n
    where
        solve' :: Int -> Int -> Int
        solve' d 0 = 0
        solve' d n | (mod d m) == 0 = 1 + solve' 1 n
                   | otherwise = 1 + solve' (d + 1) (n - 1)

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

-- import Debug.Trace

days a b per cnt
  | b == per = (days (a+1) b 0 (cnt))
  | a == 0 = cnt
  | otherwise = (days (a-1) b (per+1) (cnt+1))

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

      hh = days aa bb 0 0
  putStrLn (show hh)

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve _ 0 _ = 0
solve k n m = 1 + solve (k + 1) nn m
  where nn = n - if k `mod` m == 0 then 0 else 1

main :: IO ()
main = do
  [n, m] <- getInts
  print $ solve 1 n m

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

getIntArray :: B.ByteString -> [Int]
getIntArray = map fst . mapMaybe B.readInt . B.words

main = B.interact $ B.pack . show . getAns . getIntArray

getAns (n:m:_) = solveS 0 n (n `div` m) m

solveS p d n m
	| p == n = d
	| otherwise = solveS n (d + n - p) ((d + n - p) `div` m) m

main = do
  [n, m] <- fmap (map read . words) getLine
  let
    count d 0 = d - 1
    count d n = if d `mod` m == 0 then count (d+1) n else count (d+1) (n-1)

  print $ count 1 n

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve.map read.words.head . lines
solve :: [Int]->Int
solve [x,y] = solve2 [x,0] --(sum $ solve2 [x]) `div` y
    where
    --  solve2 (0:zs) = []
    --  solve2 (z:zs) =  solve2 [z `div` y]++[z]
    solve2 [0,b] = b
    solve2 [a,b] = solve2 [((b `mod` y)+a) `div` y,a+b]

import Control.Applicative

main = do
  [n,m] <- map read . words <$> getLine
  print $ n + div (n-1) (m-1)

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

countSocks a b c | a < b = c + a
                 | otherwise = countSocks (a - b + 1) b (c + b)

solve (a:b:[]) = putStrLn $ show $ countSocks a b 0
main = getLine >>= \x -> solve $ readNumbers x

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

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

main=do

   [m,n]<- map read <$> words <$> getLine ::IO [Int]
   print $ process m n 0

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

solve :: [Int] -> Int
solve [n, m] = go n 1
  where go 0 d = d - 1
        go k d | d `mod` m == 0 = go k (d + 1)
               | otherwise = go (k - 1) (d + 1)

import Prelude hiding (readList, showList)
import Control.Monad
import Control.Arrow
import Control.Applicative
import Data.List

readList :: Read a => IO [a]
readList = fmap (fmap read . words) getLine

readList' :: Read a => a -> IO [a]
readList' _ = readList

readInt :: IO Int
readInt = head <$> readList' (undefined::Int)

showList :: Show a => [a] -> IO ()
showList = putStrLn . unwords . map show

skipLine :: IO ()
skipLine = void $ getLine

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

divUp :: Integral a => a -> a -> a
divUp x y
  | x `mod` y /= 0 = x `div` y + 1
  | otherwise      = x `div` y

u :: a
u = undefined

step :: Int -> Int -> Int -> Int
step m curr day
  | curr == 0 = day-1
  | day `mod` m == 0 = step m curr (day+1)
  | otherwise = step m (curr-1) (day+1)

main :: IO ()
main = do
  [n,m] <- readList' (u :: Int)
  print $ step m n 1

main = do
    [n,m] <- fmap (map read . words) getLine
    solve 1 n m
solve d 0 _ = print (d-1)
solve d n m = solve (d+1) (n-1+b) m
  where b | d `mod` m == 0 = 1
          | otherwise = 0

days 0 m t = t - 1
days n m t = if t `mod` m == 0 then days n m (t+1)
                               else days (n-1) m (t+1)
main = do
    [n, m] <- fmap (map read . words) getLine
    print $ days n m 1

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

solve :: Int -> Int -> Int -> Int
solve 0 _ _ = 0
solve n m d = 1 + solve (n-1+new) m (d+1)
    where new = if (d `rem` m == 0) then 1 else 0

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

module Main where

import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

main :: IO ()
main = do
    (n:m:[]) <- readNumbers
    loop n m n 0
  where
    loop n m pairCount days
      | pairCount == 0 = print (pred days)
      | otherwise =
          if days `mod` m == 0
            then
              loop n m pairCount (succ days)
            else
              loop n m (pred pairCount) (succ days)

days n m
    | (n >= m) = m + (days (n-m+1) (m))
    | otherwise = n

main = do
    line <- getLine
    let [n, m] = map read $ words line
    print $ days n m

import Control.Applicative
import Data.List

process n m x | n==0 = x
              | n<m = x+n
              | otherwise = process (n+1-m) m (x+m)

main= do
	[n,m]<- map read . words <$> getLine ::IO [Int]
	if (n<m) then print n else print $ process n m 0

f n m = f' n m 0 1
        where f' n m s a = if (quot n (m ^ a)) > 0 then
                             f' n m (s + (quot n (m ^ a))) (a+1)
                           else
                             s
main = do
  line <- getLine
  let [n,m] = map read $ words line :: [Int]
      ans = n + (f n m)
  print ans

main = do
  line <- getLine
  let [n,m] = map read $ words line :: [Int]
      ans = n + (quot n m) + (quot (quot n m) m)
  print ans

f n m = f' n m 1
        where f' socks m days   | socks == 1 = days +1
                                | days `mod` m  == 0 = f' socks m (days+1)
                                | otherwise = f' (socks-1) m (days+1)
main = do
  line <- getLine
  let [n,m] = map read $ words line :: [Int]
      ans = f n m
  print ans

module Main (main)
    where

main :: IO ()
main = print . solve . take 2 . map read . words =<< getLine
    where solve [0,_] = 0
          solve [1,_] = 1
          solve [n,m] = n + solve [n `div` m,m]

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve.map read.words.head . lines
solve :: [Int]->Int
solve [x,y] = sum $ solve2 [x]
    where
      solve2 (0:zs) = []
      solve2 (z:zs) =  solve2 [z `div` y]++[z]

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve.map read.words.head . lines
solve :: [Int]->Int
solve [x,y] =x+(sum $ solve2 [x]) `div` y
    where
      solve2 (0:zs) = []
      solve2 (z:zs) =  solve2 [z `div` y]++[z]

import Control.Applicative

main = do
  [n,m] <- map read . words <$> getLine
  let days = iterate (`div`m) n
  print . sum $ takeWhile (/=0) days

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

solve :: [Int] -> Int
solve [n, m] = go n 0
  where go 0 d = d
        go k d | d `mod` m == 1 = go k (d + 1)
               | otherwise = go (k - 1) (d + 1)

module Main where

import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

main :: IO ()
main = do
  (n:m:[]) <- readNumbers
  let remainingDays = n `div` m
      diff = remainingDays `div` m
  print $ case () of
    _ | m > n  -> n
      | otherwise -> n + remainingDays + diff


Buses run between the cities A and B, the first one is at 05:00 AM and the last one departs not later than at 11:59 PM. A bus from the city A departs every a minutes and arrives to the city B in a ta minutes, and a bus from the city B departs every b minutes and arrives to the city A in a tb minutes.The driver Simion wants to make his job diverse, so he counts the buses going towards him. Simion doesn't count the buses he meet at the start and finish.You know the time when Simion departed from the city A to the city B. Calculate the number of buses Simion will meet to be sure in his counting.

The first line contains two integers a, ta (1 ≤ a, ta ≤ 120) — the frequency of the buses from the city A to the city B and the travel time. Both values are given in minutes. The second line contains two integers b, tb (1 ≤ b, tb ≤ 120) — the frequency of the buses from the city B to the city A and the travel time. Both values are given in minutes. The last line contains the departure time of Simion from the city A in the format hh:mm. It is guaranteed that there are a bus from the city A at that time. Note that the hours and the minutes are given with exactly two digits.

Print the only integer z — the number of buses Simion will meet on the way. Note that you should not count the encounters in cities A and B.

NoteIn the first example Simion departs form the city A at 05:20 AM and arrives to the city B at 05:50 AM. He will meet the first 5 buses from the city B that departed in the period [05:00 AM - 05:40 AM]. Also Simion will meet a bus in the city B at 05:50 AM, but he will not count it.Also note that the first encounter will be between 05:26 AM and 05:27 AM (if we suggest that the buses are go with the sustained speed).

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

tr ':' = ' '
tr x = x

main=do
	 [a,ta]<- map read.words <$> getLine::IO [Int]
	 [b,tb]<- map read.words <$> getLine::IO [Int]
	 s<- getLine
	 let [h,m]= map read $ words $ map tr s
	 let x = h*60+m
	 let se = [300,300+b..1439]
	 let st = x-tb
         print $ length $ takeWhile (<x +ta) $ dropWhile (<=st) se


You are given a rectangular cake, represented as an r × c grid. Each cell either has an evil strawberry, or is empty. For example, a 3 × 4 cake may look as follows:  The cakeminator is going to eat the cake! Each time he eats, he chooses a row or a column that does not contain any evil strawberries and contains at least one cake cell that has not been eaten before, and eats all the cake cells there. He may decide to eat any number of times.Please output the maximum number of cake cells that the cakeminator can eat.

The first line contains two integers r and c (2 ≤ r, c ≤ 10), denoting the number of rows and the number of columns of the cake. The next r lines each contains c characters — the j-th character of the i-th line denotes the content of the cell at row i and column j, and is either one of these:    '.' character denotes a cake cell with no evil strawberry;  'S' character denotes a cake cell with an evil strawberry.

Output the maximum number of cake cells that the cakeminator can eat.

NoteFor the first example, one possible way to eat the maximum number of cake cells is as follows (perform 3 eats).

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

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

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

main = do
  [r, c] <- getInts
  a <- lines <$> getContents

  let
    k1 = length $ filter (not . elem 'S') a
    k2 = length $ filter (not . elem 'S') $ transpose a

  print $ k1*c + k2*r - k1*k2

import Data.List
import Control.Monad

badones :: [(Int,Int)] -> [(Int,Int)]
badones ps = concat [[(a,b),(c,d),(a,d),(c,b)] | (a,b) <- ps, (c,d) <- ps]

rect :: Int -> Int -> [(Int,Int)]
rect n m = [(i,j) | i <- [1..n], j <- [1..m]]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m ps = length (rect n m \\ badones ps)

strawberry :: Char -> Bool
strawberry c = c == 's'

main = do
  [n, m] <- fmap (map read . words) getLine
  let readLine i = fmap (map (\j -> (i, j+1)) . elemIndices 'S') getLine
  strawberries <- mapM readLine [1..n]
  putStrLn . show . solve n m . concat $ strawberries

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInteger x
someFunc::IO()
someFunc = C.getLine>>= \is ->let ns = map rIn $ C.words is in (solve.(\js->(ns,js))=<<forM [1..(head ns )] (\i->C.init<$>C.getLine) )
solve ([x,y],xs) = print $ (\(t1,t2)->t1*y+t2*x-t1*t2)$ join (***) (sum.map (\a->if C.notElem 'S' a then 1 else 0))(xs,C.transpose xs)

import Control.Monad (liftM, replicateM)
import Data.List (transpose)
import Prelude hiding (reads)

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

solve :: (Int, Int) -> [[Bool]] -> Int
solve (n, m) xs  =  n' * m + m' * (n - n')
  where
    n'  =  length $ filter and xs
    m'  =  length $ filter and $ transpose xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    xs  <-  replicateM n getLine
    print $ solve (n, m) $ map (map (== '.')) xs

import Data.List
main=getContents>>=print.solve.tail.lines
solve=length.filter(=='_').concat.f.transpose.f where f=map(\s->if all(`elem`"._")s then map(const '_')s else s)

import Data.List (transpose)

main :: IO ()
main = getContents >>= print . solve . tail . lines

solve :: [String] -> Int
solve = length . filter (=='_') . concat . eat . transpose . eat
  where eat = map (\cs -> if all (`elem`"._") cs then map (const '_') cs else cs)

import Data.List (transpose)
main = interact $ show . solve . tail . lines
solve g = if rs == r || cs == c then max (rs*c) (cs*r) else cs*r + rs*c - rs*cs
  where
    r = length g
    c = length (head g)
    rs = length (filter (all (== '.')) g)
    cs = length (filter (all (== '.')) (transpose g))

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

main = do
    [r,c] <- map read . words <$> getLine
    cake <- forM [1..r] (\_ -> map (=='S') <$> getLine)
    print $ solve cake r c

solve :: [[Bool]] -> Int -> Int -> Int
solve xxs r c = if length b > 0 then r*c - length b * length (head b) else r*c
    where a = filter or xxs
          b = filter or $ transpose a

import Control.Applicative
import Data.List
main=do
  [r,c] <- map read.words <$> getLine
  css <- lines <$> getContents
  let l = length . concat $ f css
  print $ r*c-l

f :: [String] -> [String]
f css = if css==css' then css else f css'
   where
     css' = h $ g css

g css = filter (any('S'==)) css
h = transpose.g.transpose

import Control.Applicative
import Control.Monad

check'x :: (Num b) => [[Char]] -> b
check'x [] = 0
check'x (x: xs) = (if 'S' `elem` x then 1 else 0) + (check'x xs)

check'y :: (Num b) => [[Char]] -> b
check'y [] = 0
check'y x = (if 'S' `elem` head' x then 1 else 0) + (check'y (tail' x))

head' [x] = [head x]
head' (x: xs) = head x : head' xs

tail' ([x]: _) = []
tail' [x] = [tail x]
tail' (x: xs) = tail x : tail' xs

calc' map = check'x map * check'y map

readInt = read <$> getLine :: IO Int
readInts = map read . words <$> getLine :: IO [Int]

main = do
    [x, y] <- readInts

    lst <- forM [1..x] (\_ -> do
        xs <- getLine
        return xs)

    putStr( show (x*y-(calc' lst)))

import Control.Applicative
import Data.List

main=do
	[r,c]<-   map read.words   <$> getLine:: IO  [Int]
	s<- lines <$> getContents
	let t = transpose s
	let rr = length $ filter (\z-> notElem 'S' z) s
	let cc = length $ filter (\z-> notElem 'S' z) t
	print $ rr*c + cc*(r-rr)

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
rIn x= fst $ fromJust  $ C.readInteger x
someFunc::IO()
someFunc = C.getLine>>= \is ->let ns = map rIn $ C.words is in (solve.(\js->(ns,js))=<<forM [1..(head ns )] (\i->C.getLine) )
solve ([x,y],xs) = print $ (\(t1,t2)->t1*y+t2*x-t1*t2)$ join (***) (sum.map (\a->if C.notElem 'S' a then 1 else 0))(xs,C.transpose xs)

import Data.List (transpose)
main = interact $ show . solve . tail . lines
solve g = if rs == r || cs == c then max rs cs else cs + rs
  where
    r = length g
    c = length (head g)
    rs = length (filter (all (== '.')) g)
    cs = length (filter (all (== '.')) (transpose g))


Let's define a split of $$$n$$$ as a nonincreasing sequence of positive integers, the sum of which is $$$n$$$. For example, the following sequences are splits of $$$8$$$: $$$[4, 4]$$$, $$$[3, 3, 2]$$$, $$$[2, 2, 1, 1, 1, 1]$$$, $$$[5, 2, 1]$$$.The following sequences aren't splits of $$$8$$$: $$$[1, 7]$$$, $$$[5, 4]$$$, $$$[11, -3]$$$, $$$[1, 1, 4, 1, 1]$$$.The weight of a split is the number of elements in the split that are equal to the first element. For example, the weight of the split $$$[1, 1, 1, 1, 1]$$$ is $$$5$$$, the weight of the split $$$[5, 5, 3, 3, 3]$$$ is $$$2$$$ and the weight of the split $$$[9]$$$ equals $$$1$$$.For a given $$$n$$$, find out the number of different weights of its splits.

The first line contains one integer $$$n$$$ ($$$1 \leq n \leq 10^9$$$).

Output one integer — the answer to the problem.

NoteIn the first sample, there are following possible weights of splits of $$$7$$$:Weight 1: [$$$\textbf 7$$$] Weight 2: [$$$\textbf 3$$$, $$$\textbf 3$$$, 1] Weight 3: [$$$\textbf 2$$$, $$$\textbf 2$$$, $$$\textbf 2$$$, 1] Weight 7: [$$$\textbf 1$$$, $$$\textbf 1$$$, $$$\textbf 1$$$, $$$\textbf 1$$$, $$$\textbf 1$$$, $$$\textbf 1$$$, $$$\textbf 1$$$]

main = interact $ show . succ . (`quot` 2) . read

main :: IO ()
main = do
  x <- getInt
  let a = div x 2 + 1
  print a
getInt :: IO Int
getInt = readLn

main = print . (+ 1) . (`div` 2) =<< readLn

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

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

main = do
		n<- read<$> getLine ::IO Int
		print $ (div n 2) + 1


Those unwilling to return home from a long journey, will be affected by the oddity of the snail and lose their way. Mayoi, the oddity's carrier, wouldn't like this to happen, but there's nothing to do with this before a cure is figured out. For now, she would only like to know the enormous number of possibilities to be faced with if someone gets lost.There are n towns in the region, numbered from 1 to n. The town numbered 1 is called the capital. The traffic network is formed by bidirectional roads connecting pairs of towns. No two roads connect the same pair of towns, and no road connects a town with itself. The time needed to travel through each of the roads is the same. Lost travelers will not be able to find out how the towns are connected, but the residents can help them by providing the following facts:   Starting from each town other than the capital, the shortest path (i.e. the path passing through the minimum number of roads) to the capital exists, and is unique;  Let li be the number of roads on the shortest path from town i to the capital, then li ≥ li - 1 holds for all 2 ≤ i ≤ n;  For town i, the number of roads connected to it is denoted by di, which equals either 2 or 3. You are to count the number of different ways in which the towns are connected, and give the answer modulo 109 + 7. Two ways of connecting towns are considered different if a pair (u, v) (1 ≤ u, v ≤ n) exists such there is a road between towns u and v in one of them but not in the other.

The first line of input contains a positive integer n (3 ≤ n ≤ 50) — the number of towns. The second line contains n space-separated integers d1, d2, ..., dn (2 ≤ di ≤ 3) — the number of roads connected to towns 1, 2, ..., n, respectively. It is guaranteed that the sum of di over all i is even.

Output one integer — the total number of different possible ways in which the towns are connected, modulo 109 + 7.

NoteIn the first example, the following structure is the only one to satisfy the constraints, the distances from towns 2, 3, 4 to the capital are all 1.  In the second example, the following two structures satisfy the constraints.

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Data.Functor ((<$>))
import Data.Array
import Data.Int

type I = Int64

p :: I
p = 10 ^ 9 + 7

c :: I -> I -> I
c n k = a ! (n, k)
  where
    a :: Array (I, I) I = array ((0,0),(50,50))
      [((i,j), c' i j) | i <- [0..50], j <- [0..50]]
    c' _ 0 = 1
    c' 0 _ = 0
    c' i j = (a ! (i-1,j) + a ! (i-1,j-1)) `mod` p

cross :: I -> I -> I -> I
cross k m n = a ! (k, m, n)
  where
    a :: Array (I, I, I) I = array ((0,0,0), (50, 50, 50))
      [((x,y,z), c' x y z) | x <- [0..50], y <- [0..50], z <- [0..50]]
    c' 0 0 0 = 1
    c' 0 1 0 = 0
    c' 0 y 0 = ((y-1) * a ! (0, y-2, 0)) `mod` p
    c' x y 0 = (sum [a ! (x-1-i, y+2*i-2, 0) * c (x-1) i * c y (2-i) |
                     i <- [max 0 (2-y)..min 2 (x-1)]]) `mod` p
    c' 0 0 z = 0
    c' 0 y z = (a ! (0, y-1, z-1) * y) `mod` p
    c' x 0 z = (a ! (x-1, 1, z-1) * x) `mod` p
    c' x y z = (a ! (x, y-1, z-1) * y + a ! (x-1, y+1, z-1) * x) `mod` p

solve d' = (s' len 0,
            [((n, r), s' n r) | n <- [1..len], r <- [1..n]])
  where
    d :: Array Int I = listArray (0, length d' - 1) d'
    a :: Array (I, I) I = array ((1,1), (len,len))
      [((n, r), s' n r) | n <- [1..len], r <- [1..n]]
    s' 1 1 = 1
    s' 1 _ = 0
    s' n r = sum [(cr (n-r) q r * a ! (n-r, q)) `mod` p | q <- [1..n-r]] `mod` p
    cr n q r
      | n == 1 && q == 1 = if r == d ! 0 then 1 else 0
      | n == 1 = 0
      | otherwise = cross (threes n q) (twos n q) r
    twos n q = q - threes n q
    threes n q = sumthrees ! n - sumthrees ! (n-q)
    sumthrees :: Array I I = array (0, len) $
      (0,0):[(i, d ! (fromIntegral i-1) - 2 + sumthrees ! (i-1)) | i <- [1..len]]
    len = fromIntegral $ snd (bounds d) + 1

main = do
  _ <- getLine
  (d :: [I]) <- (map read . words) <$> getLine
  print $ fst $ solve d

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Data.Functor ((<$>))
import Data.Array

p :: Int
p = 10 ^ 9 + 7

c :: Int -> Int -> Int
c n k = a ! (n, k)
  where
    a :: Array (Int, Int) Int = array ((0,0),(50,50))
      [((i,j), c' i j) | i <- [0..50], j <- [0..50]]
    c' _ 0 = 1
    c' 0 _ = 0
    c' i j = a ! (i-1,j) + a ! (i-1,j-1)

cross :: Int -> Int -> Int -> Int
cross k m n = a ! (k, m, n)
  where
    a :: Array (Int, Int, Int) Int = array ((0,0,0), (50, 50, 50))
      [((x,y,z), c' x y z) | x <- [0..50], y <- [0..50], z <- [0..50]]
    c' 0 0 0 = 1
    c' 0 1 0 = 0
    c' 0 y 0 = ((y-1) * a ! (0, y-2, 0)) `mod` p
    c' x y 0 = (sum [a ! (x-1-i, y+2*i-2, 0) * c (x-1) i * c y (2-i) |
                     i <- [max 0 (2-y)..min 2 (x-1)]]) `mod` p
    c' 0 0 z = 0
    c' 0 y z = (a ! (0, y-1, z-1) * y) `mod` p
    c' x 0 z = (a ! (x-1, 1, z-1) * x) `mod` p
    c' x y z = (a ! (x, y-1, z-1) * y + a ! (x-1, y+1, z-1) * x) `mod` p

solve d' = (s' len 0,
            [((n, r), s' n r) | n <- [1..len], r <- [1..n]])
  where
    d = listArray (0, length d' - 1) d'
    a :: Array (Int, Int) Int = array ((1,1), (len,len))
      [((n, r), s' n r) | n <- [1..len], r <- [1..n]]
    s' 1 1 = 1
    s' 1 _ = 0
    s' n r = sum [cr (n-r) q r * a ! (n-r, q) | q <- [1..n-r]] `mod` p
    cr n q r
      | n == 1 && q == 1 = if r == d ! 0 then 1 else 0
      | n == 1 = 0
      | otherwise = cross (threes n q) (twos n q) r
    twos n q = q - threes n q
    threes n q = sumthrees ! n - sumthrees ! (n-q)
    sumthrees :: Array Int Int = array (0, len) $
      (0,0):[(i, d ! (i-1) - 2 + sumthrees ! (i-1)) | i <- [1..len]]
    len = snd (bounds d) + 1

main = do
  _ <- getLine
  (d :: [Int]) <- (map read . words) <$> getLine
  print $ fst $ solve d

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Data.Functor ((<$>))
import Data.Array

p :: Int
p = 10 ^ 9 + 7

c :: Int -> Int -> Int
c n k = a ! (n, k)
  where
    a :: Array (Int, Int) Int = array ((0,0),(50,50))
      [((i,j), c' i j) | i <- [0..50], j <- [0..50]]
    c' _ 0 = 1
    c' 0 _ = 0
    c' i j = a ! (i-1,j) + a ! (i-1,j-1)

cross :: Int -> Int -> Int -> Int
cross k m n = a ! (k, m, n)
  where
    a :: Array (Int, Int, Int) Int = array ((0,0,0), (50, 50, 50))
      [((x,y,z), c' x y z) | x <- [0..50], y <- [0..50], z <- [0..50]]
    c' 0 0 0 = 1
    c' 0 1 0 = 0
    c' 0 y 0 = ((y-1) * a ! (0, y-2, 0)) `mod` p
    c' x y 0 = (sum [a ! (x-1-i, y+2*i-2, 0) * c (x-1) i * c y (2-i) |
                     i <- [max 0 (2-y)..min 2 (x-1)]]) `mod` p
    c' 0 0 z = 0
    c' 0 y z = (a ! (0, y-1, z-1) * y) `mod` p
    c' x 0 z = (a ! (x-1, 1, z-1) * x) `mod` p
    c' x y z = (a ! (x, y-1, z-1) * y + a ! (x-1, y+1, z-1) * x) `mod` p

solve d' = (s' len 0,
            [((n, r), s' n r) | n <- [1..len], r <- [1..n]])
  where
    d = listArray (0, length d' - 1) d'
    a :: Array (Int, Int) Int = array ((1,1), (len,len))
      [((n, r), s' n r) | n <- [1..len], r <- [1..n]]
    s' 1 1 = 1
    s' 1 _ = 0
    s' n r = sum [(cr (n-r) q r * a ! (n-r, q)) `mod` p | q <- [1..n-r]] `mod` p
    cr n q r
      | n == 1 && q == 1 = if r == d ! 0 then 1 else 0
      | n == 1 = 0
      | otherwise = cross (threes n q) (twos n q) r
    twos n q = q - threes n q
    threes n q = sumthrees ! n - sumthrees ! (n-q)
    sumthrees :: Array Int Int = array (0, len) $
      (0,0):[(i, d ! (i-1) - 2 + sumthrees ! (i-1)) | i <- [1..len]]
    len = snd (bounds d) + 1

main = do
  _ <- getLine
  (d :: [Int]) <- (map read . words) <$> getLine
  print $ fst $ solve d


You are locked in a room with a door that has a keypad with 10 keys corresponding to digits from 0 to 9. To escape from the room, you need to enter a correct code. You also have a sequence of digits.Some keys on the keypad have fingerprints. You believe the correct code is the longest not necessarily contiguous subsequence of the sequence you have that only contains digits with fingerprints on the corresponding keys. Find such code.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 10$$$) representing the number of digits in the sequence you have and the number of keys on the keypad that have fingerprints. The next line contains $$$n$$$ distinct space-separated integers $$$x_1, x_2, \ldots, x_n$$$ ($$$0 \le x_i \le 9$$$) representing the sequence. The next line contains $$$m$$$ distinct space-separated integers $$$y_1, y_2, \ldots, y_m$$$ ($$$0 \le y_i \le 9$$$) — the keys with fingerprints.

In a single line print a space-separated sequence of integers representing the code. If the resulting sequence is empty, both printing nothing and printing a single line break is acceptable.

NoteIn the first example, the only digits with fingerprints are $$$1$$$, $$$2$$$ and $$$7$$$. All three of them appear in the sequence you know, $$$7$$$ first, then $$$1$$$ and then $$$2$$$. Therefore the output is 7 1 2. Note that the order is important, and shall be the same as the order in the original sequence.In the second example digits $$$0$$$, $$$1$$$, $$$7$$$ and $$$9$$$ have fingerprints, however only $$$0$$$ and $$$1$$$ appear in the original sequence. $$$1$$$ appears earlier, so the output is 1 0. Again, the order is important.

import Control.Monad

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

main = do
    [n,m] <- getInts
    ns <- getInts
    ms <- getInts
    let ys = filter (\x -> x `elem` ms) ns
    forM_ ys $ \y -> do
        putStr (show y)
        putChar ' '
    putStrLn ""

import Data.List

f::[String]->[String]->[String]
f [] _=[]
f (x:xs) ys
    |x `elem` ys=x : f xs ys
    |otherwise=f xs ys

main = do
       e1<-getLine
       e2<-getLine
       e3<-getLine
       let xs=words e2
           ys=words e3
       putStrLn $ unwords $ f xs ys

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

main = do
		getLine
		a<-map read<$> words  <$> getLine ::IO [Int]
		b<-map read<$> words  <$> getLine ::IO [Int]
		putStrLn $ intercalate " " $ map show $ filter (\z-> elem z b) a

import Data.Set (fromList,member)

findCode :: [Int] -> [Int] -> [Int]
findCode x y = filter (`member` sy) x
    where sy = fromList y

main = do
    n'm' <- getLine
    x' <- getLine
    let x = map read . words $ x'
    y' <- getLine
    let y = map read . words $ y'
    putStrLn . unwords . map show $ findCode x y


Vadim is really keen on travelling. Recently he heard about kayaking activity near his town and became very excited about it, so he joined a party of kayakers.Now the party is ready to start its journey, but firstly they have to choose kayaks. There are 2·n people in the group (including Vadim), and they have exactly n - 1 tandem kayaks (each of which, obviously, can carry two people) and 2 single kayaks. i-th person's weight is wi, and weight is an important matter in kayaking — if the difference between the weights of two people that sit in the same tandem kayak is too large, then it can crash. And, of course, people want to distribute their seats in kayaks in order to minimize the chances that kayaks will crash.Formally, the instability of a single kayak is always 0, and the instability of a tandem kayak is the absolute difference between weights of the people that are in this kayak. Instability of the whole journey is the total instability of all kayaks.Help the party to determine minimum possible total instability!

The first line contains one number n (2 ≤ n ≤ 50). The second line contains 2·n integer numbers w1, w2, ..., w2n, where wi is weight of person i (1 ≤ wi ≤ 1000).

Print minimum possible total instability.

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

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

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

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

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

main = do
	n <- readInt
	as <- sort <$> readInts
	print $ minimum $ map solve $ [ ( erase j . erase i ) as | i <- [ 0 .. 2 * n - 1 ], j <- [ 0 .. i - 1 ] ]

erase pos as = take pos as ++ drop ( pos + 1 ) as

solve [] = 0
solve (a1:a2:as) = a2 - a1 + solve as

import Data.List

main = fmap ((* 2) . read) getLine >>= \n -> getLine >>= print . minimum .
    map (sum . map (\[a, b] -> abs (a - b)) . takeWhile (not . null) . map (take 2) . iterate (drop 2)) .
    concatMap (map (sort . take (n - 2) . uncurry drop) . zip [0..] . replicate (n - 1) . cycle) .
    map (take (n - 1) . uncurry drop) . zip [0..] . replicate n . cycle . map read . words

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

listLists _ [] = []
listLists soFar (x:xs) = (soFar ++ xs) : (listLists (soFar ++ [x]) xs)

listListLists l = foldl (++) [] (map llm (llm l))
                  where llm = listLists []

scor (x:y:xs) = (abs $ x - y) + scor xs
scor _ = 0

main = do
  n <- (*2) <$> (readLn::IO Int)
  l <- ( DL.sort . ( map $ \x -> fst $ fromMaybe (0, BS.empty) (BS.readInt x) ) . BS.words ) <$> BS.getLine
  print $ minimum $ map scor $ listListLists l

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Control.Applicative

listLists _ [] = []
listLists soFar (x:xs) = (soFar ++ xs) : (listLists (soFar ++ [x]) xs)

listListLists l = foldl (++) [] (map llm (llm l))
                  where llm = listLists []

scor (x:y:xs) = (abs $ x - y) + scor xs
scor _ = 0

main = do
  n <- readLn::IO Int
  l <- ( ( map $ \x -> fst $ fromMaybe (0, BS.empty) (BS.readInt x) ) . BS.words ) <$> BS.getLine
  print $ minimum $ map scor $ listListLists l


One cold winter evening Alice and her older brother Bob was sitting at home near the fireplace and giving each other interesting problems to solve. When it was Alice's turn, she told the number n to Bob and said:—Shuffle the digits in this number in order to obtain the smallest possible number without leading zeroes.—No problem! — said Bob and immediately gave her an answer.Alice said a random number, so she doesn't know whether Bob's answer is correct. Help her to find this out, because impatient brother is waiting for the verdict.

The first line contains one integer n (0 ≤ n ≤ 109) without leading zeroes. The second lines contains one integer m (0 ≤ m ≤ 109) — Bob's answer, possibly with leading zeroes.

Print OK if Bob's answer is correct and WRONG_ANSWER otherwise.

import Data.List
s [a,b]
    | (ds == []) = a == b
    | True = ((head ds) : ns ++ tail ds) == b
        where
            (ns, ds) = span (=='0') $ sort a

f True = "OK"
f False = "WRONG_ANSWER"
main = putStrLn.f.s.(\x -> take 2 $ lines x) =<< getContents

import Data.List ((\\), sort)

main = do
	alice <- getLine
	bob <- getLine
	putStrLn $ if gao alice == bob then "OK" else "WRONG_ANSWER"

gao "0" = "0"
gao a = let a0 = minimum (filter (/= '0') a); a1 = a \\ [a0] in a0 : sort a1

import Data.List

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

output :: Bool -> IO()
output True = putStrLn "OK"
output False = putStrLn "WRONG_ANSWER"

solve :: [String] -> Bool
solve [num, actual] = let sorted = sort $ filter ('0' /=) num
                          zeros = filter ('0' ==) num
                          (first, rest) = splitAt 1 sorted
                          expect = first ++ zeros ++ rest
                      in expect == actual

import Data.List

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

output :: Bool -> IO()
output True = putStrLn "OK"
output False = putStrLn "WRONG_ANSWER"

solve :: [String] -> Bool
solve [num, actual] = let sorted = sort $ filter ((/=) '0') num
                          zeros = filter ((==) '0') num
                          (first, rest) = splitAt 1 sorted
                          expect = first ++ zeros ++ rest
                      in expect == actual

import Data.List((\\), sort)

main = do
	al <- getLine
	bo <- getLine
        putStrLn $ if yao al == bo then "OK" else "WRONG_ANSWER"

yao "0"="0"
yao a = let a0 = minimum (filter (/= '0') a) in a0 : sort (a \\ [a0])

import Data.List ((\\), sort)

main = do
        alice <- getLine
        bob <- getLine
        putStrLn $ if gao alice == bob then "OK" else "WRONG_ANSWER"

gao "0" = "0"
gao a = let a0 = minimum $ filter (/= '0') a; a1 = a \\ [a0] in a0: sort a1

import Data.List

findSmallest x = let (a,b) = span (=='0') $ sort x in if null b then a else head b : (a ++ tail b)
main = do
    a<-getLine
    b<-getLine
    putStrLn $ if findSmallest a == b && length a == length b then "OK" else "WRONG_ANSWER"

import List (sort)

solve :: String -> String
solve "0"  =  "0"
solve ss =  x : zs ++ xs
  where
    zs  =  filter (== '0') ss
    (x:xs)  =  sort $ filter (/= '0') ss

main :: IO ()
main  =  do
    s1  <-  getLine
    s2  <-  getLine
    putStrLn $ if s2 == solve s1 then "OK" else "WRONG_ANSWER"

removeFirst c "" = ""
removeFirst c (x:xs) | c == x = xs
                     | otherwise = x : removeFirst c xs

getMinimumWithZero "" = ""
getMinimumWithZero xs = smallest : getMinimumWithZero (removeFirst smallest xs)
    where smallest = minimum xs

getMinimum "0" = "0"
getMinimum xs = smallest : getMinimumWithZero (removeFirst smallest xs)
    where smallest = minimum (filter (>'0') xs)

solve a b = if (b == getMinimum a) then "OK" else "WRONG_ANSWER"

main = do
       qn <- getLine
       ans <- getLine
       putStrLn (solve qn ans)

import Data.List (sort)
main = do
    q <- fmap read getLine
    a <- getLine
    putStrLn $ if solve q == a then "OK" else "WRONG_ANSWER"
solve :: Int -> String
solve n = if not $ null sortedWithoutZero then head sortedWithoutZero : (zeros ++ tail sortedWithoutZero) else "0"
    where s = show n
          zeros = filter (=='0') s
          sortedWithoutZero = sort $ filter (/='0') s

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (partition, sort)
import Data.Char (ord)

reconstruct :: [Int] -> [Int] -> [Int]
reconstruct zs [] = zs
reconstruct zs (h : t) = h : (zs ++ t)

solve :: [Int] -> [Int] -> String
solve aliceNs bobNs | ds == bobNs   = "OK"
                    | otherwise     = "WRONG_ANSWER"
    where
        ds = reconstruct zs (sort ns)
        (zs, ns) = partition (== 0) aliceNs

main =
  do
    aliceStr <- getLine
    bobStr <- getLine
    let intOfChar c = ord c - ord '0'
    let aliceNs = map intOfChar aliceStr
    let bobNs   = map intOfChar bobStr
    putStrLn (solve aliceNs bobNs)

import Data.List ((\\), sort)

main = do
        alice <- getLine
        bob <- getLine
        putStrLn $ if gao alice == bob then "YES" else "NO"

gao "0" = "0"
gao a = let a0 = minimum $ filter (/= '0') a; a1 = a \\ [a0] in a0: sort a1

import Data.List
import Control.Arrow
main = putStrLn  . (\[a,b] -> if fst a==fst b && snd a==snd b then"OK"else"WRONG_ANSWER") =<< (sequence$zipWith(\f x->f<$> x)(replicate 2 $ (arr sort.dropWhile(=='0') &&& arr length)) $ replicate 2 getLine)

import Data.List
main = (\[a,b] -> putStrLn $ if a==b then "OK" else "WRONG_ANSWER")=<< (sequence  $ zipWith (\f x -> f <$> x) (replicate 2 $ sort . dropWhile (/='0')) $ replicate 2 getLine)

import Data.List
main = (\[a,b] -> putStrLn $ if a==b then "OK" else "WRONG_ANSWER")=<< (sequence  $ zipWith (\f x -> f <$> x) (replicate 2 sort) $ replicate 2 getLine)

import Data.List
main = putStrLn  . (\[a,b] -> if a==b then "OK" else "WRONG_ANSWER")  =<< (sequence  $ zipWith (\f x -> f <$> x) (replicate 2 $ sort . dropWhile (=='0')) $ replicate 2 getLine)

import Data.List (sort)
main = do
    q <- fmap read getLine
    a <- fmap read getLine
    putStrLn $ if solve q == a then "OK" else "WRONG_ANSWER"
solve :: Int -> Int
solve n = if not $ null sortedWithoutZero then read $ head sortedWithoutZero : (zeros ++ tail sortedWithoutZero) else 0
    where s = show n
          zeros = filter (=='0') s
          sortedWithoutZero = sort $ filter (/='0') s

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

digitsRev :: Integer -> [Integer]
digitsRev n | n < 10    = [n]
            | otherwise = d : (digitsRev ds)
    where
        (ds, d) = quotRem n 10

number :: [Integer] -> Integer
number l = foldl' (\x y -> 10 * x + y) 0 l

reconstruct :: [Integer] -> [Integer] -> [Integer]
reconstruct zs [] = zs
reconstruct zs (h : t) = h : (zs ++ t)

solve :: Integer -> Integer -> String
solve n answer  | answer == d   = "OK"
                | otherwise     = "WRONG_ANSWER"
    where
        d = number ds
        ds = reconstruct zs (sort ns)
        (zs, ns) = partition (== 0) rds
        rds = digitsRev n

main =
  do all <- BS.getContents
     let Just (alicen, r1) = readInteger all
     let Just (bobn, _) = readInteger r1
     putStrLn (solve alicen bobn)
  where readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)


Vasya has n burles. One bottle of Ber-Cola costs a burles and one Bars bar costs b burles. He can buy any non-negative integer number of bottles of Ber-Cola and any non-negative integer number of Bars bars.Find out if it's possible to buy some amount of bottles of Ber-Cola and Bars bars and spend exactly n burles.In other words, you should find two non-negative integers x and y such that Vasya can buy x bottles of Ber-Cola and y Bars bars and x·a + y·b = n or tell that it's impossible.

First line contains single integer n (1 ≤ n ≤ 10 000 000) — amount of money, that Vasya has. Second line contains single integer a (1 ≤ a ≤ 10 000 000) — cost of one bottle of Ber-Cola. Third line contains single integer b (1 ≤ b ≤ 10 000 000) — cost of one Bars bar.

If Vasya can't buy Bars and Ber-Cola in such a way to spend exactly n burles print «NO» (without quotes). Otherwise in first line print «YES» (without quotes). In second line print two non-negative integers x and y — number of bottles of Ber-Cola and number of Bars bars Vasya should buy in order to spend exactly n burles, i.e. x·a + y·b = n. If there are multiple answers print any of them. Any of numbers x and y can be equal 0.

NoteIn first example Vasya can buy two bottles of Ber-Cola and one Bars bar. He will spend exactly 2·2 + 1·3 = 7 burles.In second example Vasya can spend exactly n burles multiple ways:   buy two bottles of Ber-Cola and five Bars bars;  buy four bottles of Ber-Cola and don't buy Bars bars;  don't buy Ber-Cola and buy 10 Bars bars. In third example it's impossible to but Ber-Cola and Bars bars in order to spend exactly n burles.

import Data.Int
main = interact exec
exec = (\r -> case r of { (x, y):_ -> "YES\n" ++ show x ++ " " ++ show y; _ -> "NO"}) . solve . map read . words

solve [n, a, b]  = takeWhile (\(_, y) -> y >= 0) [(x, y) | x <- [0..10000000], let (y, r) = (n - x * a) `quotRem` b, r == 0]
  where _ = n :: Int64

getInt :: IO Integer
getInt = read `fmap` getLine

solve :: Integer -> Integer -> Integer -> Maybe (Integer, Integer)
solve a b n = go 0
    where go x
            | x*a > n = Nothing
            | (n - x*a) `mod` b == 0 = Just (x, (n - x*a) `div` b)
            | otherwise = go (x+1)

main :: IO ()
main = do
    n <- getInt
    a <- getInt
    b <- getInt
    let k = solve a b n
    case k of
        Nothing -> putStrLn "NO"
        Just (a,b) -> do
            putStrLn "YES"
            putStrLn (show a ++ " " ++ show b)

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

exgcd a 0 = (a, 1, 0)
exgcd a b = (ret, y, x - a `div` b * y) where
    (ret, x, y) = exgcd b (a `mod` b)

pmod x y = ((x `mod` y) + y) `mod` y

-- Bezout's Lemma -- min. ax s.t. ax+cy=d, x, y >= 0
run a c d | r /= 0 = (-1, -1) | otherwise = (k, (d - a * k) `div` c) where
    k = (x * q) `pmod` p
    p = c `div` g
    (q, r) = d `divMod` g
    (g, x, y) = exgcd a c

main = do
    (map (read :: String -> Integer) . lines -> [n, a, b]) <- getContents
    let r = run a b n
    putStrLn $ if fst r == -1 || snd r < 0 then "NO" else "YES\n" ++ show (fst r) ++ " " ++ show (snd r)

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

swap (a,b) = (b,a)
-------------------------------------------------------------------------------

main = interact $ unlines . sol . lines

sol nn = let
  [n, a, b] = map read nn :: [Integer]
  pattern (x,y) = "YES\n" ++ (show x) ++ " " ++ (show y)
  res = case sol' n (max a b) (min a b) 0 of
            Just p -> pattern (if a /= max a b then swap p else p)
            Nothing -> "NO"
  in [res]

-- sol' :: Int -> Int -> Int -> Int -> Maybe (Int,Int)
sol' n a b ac
  | n <  0         = Nothing
  | n `mod` b == 0 = Just (ac, n`div`b)
  | otherwise      = sol' (n-a) a b (ac+1)

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

swap (a,b) = (b,a)
-------------------------------------------------------------------------------

main = interact $ unlines . sol . lines

sol nn = let
  [n, a, b] = map read nn :: [Int]
  pattern (x,y) = "YES\n" ++ (show x) ++ " " ++ (show y)
  res = case sol' n (max a b) (min a b) 0 of
            Just p -> pattern (if a /= max a b then swap p else p)
            Nothing -> "No"
  in [res]

sol' :: Int -> Int -> Int -> Int -> Maybe (Int,Int)
sol' n a b ac
  | n <= 0         = Nothing
  | n `mod` b == 0 = Just (ac, n`div`b)
  | otherwise      = sol' (n-a) a b (ac+1)

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

swap (a,b) = (b,a)
-------------------------------------------------------------------------------

main = interact $ unlines . sol . lines

sol nn = let
  [n, a, b] = map read nn :: [Integer]
  pattern (x,y) = "YES\n" ++ (show x) ++ " " ++ (show y)
  res = case sol' n (max a b) (min a b) 0 of
            Just p -> pattern (if a /= max a b then swap p else p)
            Nothing -> "NO"
  in [res]

-- sol' :: Int -> Int -> Int -> Int -> Maybe (Int,Int)
sol' n a b ac
  | n <= 0         = Nothing
  | n `mod` b == 0 = Just (ac, n`div`b)
  | otherwise      = sol' (n-a) a b (ac+1)

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

swap (a,b) = (b,a)
-------------------------------------------------------------------------------

main = interact $ unlines . sol . lines

sol nn = let
  [n, a, b] = map read nn :: [Integer]
  pattern (x,y) = "YES\n" ++ (show x) ++ " " ++ (show y)
  res = case sol' n (max a b) (min a b) 0 of
            Just p -> pattern (if a /= max a b then swap p else p)
            Nothing -> "No"
  in [res]

-- sol' :: Int -> Int -> Int -> Int -> Maybe (Int,Int)
sol' n a b ac
  | n <= 0         = Nothing
  | n `mod` b == 0 = Just (ac, n`div`b)
  | otherwise      = sol' (n-a) a b (ac+1)


"QAQ" is a word to denote an expression of crying. Imagine "Q" as eyes with tears and "A" as a mouth.Now Diamond has given Bort a string consisting of only uppercase English letters of length n. There is a great number of "QAQ" in the string (Diamond is so cute!).  illustration by 猫屋 https://twitter.com/nekoyaliu Bort wants to know how many subsequences "QAQ" are in the string Diamond has given. Note that the letters "QAQ" don't have to be consecutive, but the order of letters should be exact.

The only line contains a string of length n (1 ≤ n ≤ 100). It's guaranteed that the string only contains uppercase English letters.

Print a single integer — the number of subsequences "QAQ" in the string.

NoteIn the first example there are 4 subsequences "QAQ": "QAQAQYSYIOIWIN", "QAQAQYSYIOIWIN", "QAQAQYSYIOIWIN", "QAQAQYSYIOIWIN".

getQAQ :: String -> Int
getQAQ = solve 0 0
         where
             solve num sum [] = 0
             solve num sum (s1:sx)
                                 | s1 == 'Q' = sum + solve (num + 1) sum sx
                                 | s1 == 'A' = solve num (sum + num) sx
                                 | otherwise = solve num sum sx
main = interact $ show . getQAQ

getQAQ' a sum [] = 0
getQAQ' a sum (s1:sx)
                | s1 == 'Q' = sum + getQAQ' (a+1) sum sx
                | s1 == 'A' = getQAQ' a (sum+a) sx
                | otherwise = getQAQ' a sum sx
getQAQ s = getQAQ' 0 0 s
main = print . getQAQ =<< getLine

main = interact $ show . solve
solve s = sum $ zipWith3 (((*) .) . (*)) l m r where
  l = scanl1 (+) $ map (fromEnum . (== 'Q')) s
  m = map (fromEnum . (== 'A')) s
  r = scanr1 (+) $ map (fromEnum . (== 'Q')) s

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

process m n p _ [] =  m
process m n p f (a:as) | a=='Q' =  process (m+n) n (p+1) 1 as
                       | f==0 = process m n p f as
		       | otherwise = process m (n+p) p 1 as

main::IO ()
main=do
	s<- getLine
	let a= filter (\z-> elem z "AQ") s
	print $ process 0 0 0 0  a

process :: String -> Int
process xs = qaq
    where
        (_,_,qaq) = f xs
        f :: [Char] -> (Int, Int, Int)
        f [] = (0,0,0)
        f (x:xs)
            | x == 'Q' = (q+1,aq,qaq+aq)
            | x == 'A' = (q,aq+q,qaq)
            | otherwise = (q,aq,qaq)
            where (q,aq,qaq) = f xs

readInt :: String -> Int
readInt = read

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

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

process m n p [] =  m
process m n p (a:as) | a=='Q' =  process (m+n) n (p+1) as
                     | otherwise = process m (n+p) p as

main::IO ()
main=do
	s<- getLine
	let a= filter (\z-> elem z "AQ") s
	print $ process 0 0 0  s

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

process m n p _ [] =  m
process m n p f (a:as) | a=='Q' =  process (m+n) n (p+1) 1 as
                       | f==0 = process m n p f as
		       | otherwise = process m (n+p) p 1 as

main::IO ()
main=do
	s<- getLine
	let a= filter (\z-> elem z "AQ") s
	print $ process 0 0 0 0  s


Рассмотрим следующий код сортировки слиянием на языке Python: def sort(a):  n = len(a)  b = [0 for i in range(n)]  log = []  def mergeSort(l, r):    if r - l <= 1:      return    m = (l + r) >> 1    mergeSort(l, m)    mergeSort(m, r)    i, j, k = l, m, l    while i < m and j < r:      if a[i] < a[j]:        log.append('0')        b[k] = a[i]        i += 1      else:        log.append('1')        b[k] = a[j]        j += 1      k += 1    while i < m:      b[k] = a[i]      i += 1      k += 1    while j < r:      b[k] = a[j]      j += 1      k += 1    for p in range(l, r):      a[p] = b[p]  mergeSort(0, n)  return "".join(log)Как можно заметить, этот код использует логирование — важнейший инструмент разработки.Старший разработчик ВКонтакте Вася сгенерировал перестановку $$$a$$$ (массив из $$$n$$$ различных целых чисел от $$$1$$$ до $$$n$$$), дал её на вход функции sort и получил на выходе строку $$$s$$$. На следующий день строку $$$s$$$ Вася нашёл, а перестановка $$$a$$$ потерялась. Вася хочет восстановить любую перестановку $$$a$$$ такую, что вызов функции sort от неё даст ту же строку $$$s$$$. Помогите ему!

Ввод содержит непустую строку $$$s$$$, состоящую из символов 0 и 1.  В этой версии задачи для любого теста существует перестановка длины $$$16$$$, удовлетворяющая условию. Тем не менее, ваш ответ может иметь любую длину, в том числе отличную от $$$16$$$.

В первой строке выведите целое число $$$n$$$ — длину перестановки. Во второй строке выведите $$$n$$$ различных целых чисел $$$a_0, a_1, \ldots, a_{n-1}$$$ ($$$1 \le a_i \le n$$$) — элементы перестановки. Если существует несколько вариантов ответа, выведите любой из них.

{-# LANGUAGE NoMonadFailDesugaring #-}

import Debug.Trace
import Data.Maybe
import Control.Monad.Trans.Maybe
import Control.Monad.State

chop = do
    x:xs <- get
    put xs
    return x

helper' :: Int -> Int -> MaybeT (State String) [Int]
helper' 0 zeroes = return $ replicate zeroes 0
helper' ones 0   = return $ replicate ones 1
helper' ones zeroes = do
                    c <- chop
                    case c of
                        '0' -> fmap (0:) $ helper' ones (zeroes - 1)
                        '1' -> fmap (1:) $ helper' (ones - 1) zeroes

solution' :: Int -> Int -> MaybeT (State String) [[Int]]
solution' l r | r - l <= 1 = return []
              | otherwise = do
                  let m = div (r + l) 2
                  a <- solution' l m
                  b <- solution' m r
                  res <- helper' (r - m) (m - l)
                  return (a ++ b ++ [res])

separate :: [Int] -> State [[Int]] [Int]
separate [x] = return [x]
separate values = do
                    fil:xs <- get
                    put xs

                    let collect (0:f, a, b) x = (f, x:a, b)
                        collect (1:f, a, b) x = (f, a, x:b)
                        (_, l, r) = foldl collect (fil, [], []) values
                    right <- separate (reverse r)
                    left <- separate (reverse l)
                    return $ left ++ right

runSolution' :: Int -> String -> ([Int], Int)
runSolution' i s = case runState (runMaybeT $ solution' 0 i) s of
                     (Just res, "") -> (evalState (separate [1..i]) $ reverse res, i)
                     _ -> runSolution' (i + 1) s

main = do
    s <- getLine
    let (a, i) = runSolution' 1 s
    putStrLn $ show i
    mapM (putStr.(++ " ").show) a

import Debug.Trace
import Data.Maybe
import Data.Char
import Control.Monad.Trans.Maybe
import Control.Monad.State
import Control.Monad.Writer

chop :: MaybeT (State [Int]) Int
chop = do
    x:xs <- get
    put xs
    return x

foo :: Int -> Int -> [Int] -> MaybeT (State [Int]) ([Int], Int)
foo 0 _ coll = return (reverse coll, 1)
foo _ 0 coll = return (reverse coll, 0)
foo z o coll = do
            x <- chop
            case x of
                0 -> foo (z - 1) o (x:coll)
                1 -> foo z (o - 1) (x:coll)

solution' :: Int -> Int -> [([Int], Int)] -> MaybeT (State [Int]) [([Int], Int)]
solution' l r coll | r - l <= 1 = return coll
                   | otherwise = do
                        let m = div (r + l) 2
                        coll' <- solution' l m coll
                        coll'' <- solution' m r coll'
                        x <- foo (m - l) (r - m) []
                        return (x:coll'')

helper :: ([Int], Int) -> [Int] -> ([Int], [Int]) -> ([Int], [Int])
helper _ [] acc = acc
helper s@([], 0) (x:xs) (a, b) = helper s xs (x:a, b)
helper s@([], 1) (x:xs) (a, b) = helper s xs (a, x:b)
helper (0:s, n)  (x:xs) (a, b) = helper (s, n) xs (x:a, b)
helper (1:s, n)  (x:xs) (a, b) = helper (s, n) xs (a, x:b)

separate :: [Int] -> [Int] -> State [([Int], Int)] [Int]
separate [x] coll = return (x:coll)
separate values coll = do
                        xs <- get
                        put $ tail xs
                        let (l, r) = helper (head xs) values ([], [])
                        coll' <- separate (reverse r) coll
                        separate (reverse l) coll'

runSolution'' :: Int -> Int -> [Int] -> ([Int], Int)
runSolution'' l r s = let m = div (r + l) 2 in
                        case runState (runMaybeT $ solution' 0 m []) s of
                            (Just res, []) -> (evalState (separate [1..m] []) res, m)
                            ( _, _:_)      -> runSolution'' m r s
                            _              -> runSolution'' l m s

main = do
    s <- getLine
    let (a, i) = runSolution'' 1 100001 $ map digitToInt s
    putStrLn $ show i
    putStr $ foldr (\a b -> a ++ " " ++ b) "" $ map show a

import Debug.Trace
import Data.Maybe
import Data.Char
import Control.Monad.State

foo :: Int -> Int -> [Int] -> [Int] -> Maybe ([Int], [Int])
foo 0 0 xs ys = Just (xs, reverse ys)
foo 0 o xs ys = foo 0 (o - 1) xs (1:ys)
foo z 0 xs ys = foo (z - 1) 0 xs (0:ys)
foo _ _ [] _  = Nothing
foo z o (0:xs) ys = foo (z - 1) o xs (0:ys)
foo z o (1:xs) ys = foo z (o - 1) xs (1:ys)

solution' :: Int -> Int -> [Int] -> Maybe ([Int], [[Int]])
solution' l r s | r - l <= 1 = return (s, [])
                | otherwise = do
                      let m = div (r + l) 2
                      (s', a) <- solution' l m s
                      (s'', b) <- solution' m r s'
                      (s''', res) <- foo (m - l) (r - m) s'' []
                      return (s''', a ++ b ++ [res])

separate :: [Int] -> State [[Int]] [Int]
separate [x] = return [x]
separate values = do
                    xs <- get
                    put $ tail xs
                    let collect (0:f, a, b) x = (f, x:a, b)
                        collect (1:f, a, b) x = (f, a, x:b)
                        (_, l, r) = foldl collect (head xs, [], []) values
                    right <- separate (reverse r)
                    left <- separate (reverse l)
                    return $ left ++ right

runSolution'' :: Int -> Int -> [Int] -> ([Int], Int)
runSolution'' l r s = let m = div (r + l) 2 in
                        case solution' 0 m s of
                            Just ([], res) -> (evalState (separate [1..m]) $ reverse res, m)
                            Just _         -> if r - m <= 1
                                                then ([], 0)
                                                else runSolution'' m r s
                            Nothing        -> if m - l <= 1
                                                then ([], 0)
                                                else runSolution'' l m s

main = do
    s <- getLine
    let (a, i) = runSolution'' 1 100001 $ map digitToInt s
    putStrLn $ show i
    putStr $ foldr (\a b -> a ++ " " ++ b) "" $ map show a

{-# LANGUAGE NoMonadFailDesugaring #-}

import Debug.Trace
import Data.Maybe
import Control.Monad.Trans.Maybe
import Control.Monad.State

chop = do
    x:xs <- get
    put xs
    return x

helper' :: Int -> Int -> MaybeT (State String) [Int]
helper' 0 zeroes = return $ replicate zeroes 0
helper' ones 0   = return $ replicate ones 1
helper' ones zeroes = do
                    c <- chop
                    case c of
                        '0' -> fmap (0:) $ helper' ones (zeroes - 1)
                        '1' -> fmap (1:) $ helper' (ones - 1) zeroes

solution' :: Int -> Int -> MaybeT (State String) [[Int]]
solution' l r | r - l <= 1 = return []
              | otherwise = do
                  let m = div (r + l) 2
                  a <- solution' l m
                  b <- solution' m r
                  res <- helper' (r - m) (m - l)
                  return (a ++ b ++ [res])

separate :: [Int] -> State [[Int]] [Int]
separate [x] = return [x]
separate values = do
                    fil:xs <- get
                    put xs

                    let collect (0:f, a, b) x = (f, x:a, b)
                        collect (1:f, a, b) x = (f, a, x:b)
                        (_, l, r) = foldl collect (fil, [], []) values
                    right <- separate (reverse r)
                    left <- separate (reverse l)
                    return $ left ++ right

runSolution'' :: Int -> Int -> String -> ([Int], Int)
runSolution'' l r s = let m = div (r + l) 2 in
                        case runState (runMaybeT $ solution' 0 m) s of
                            (Just res, "") -> (evalState (separate [1..m]) $ reverse res, m)
                            (_, _:_)       -> if (r - l) <= 1
                                                then runSolution' (max 0 (l - 20)) s
                                                else runSolution'' m r s
                            _              -> if (r - l) <= 1
                                                then runSolution' (max 0 (l - 20)) s
                                                else runSolution'' l m s

runSolution' :: Int -> String -> ([Int], Int)
runSolution' i s = if (i > 100000)
                    then runSolution' 1 s
                    else case runState (runMaybeT $ solution' 0 i) s of
                     (Just res, "") -> (evalState (separate [1..i]) $ reverse res, i)
                     _ -> runSolution' (i + 1) s

main = do
    s <- getLine
    let (a, i) = runSolution'' 1 100000 s
    putStrLn $ show i
    mapM (putStr.(++ " ").show) a

import System.Environment
import Debug.Trace
import Data.Maybe
import Data.Char
import Control.Monad.Trans.Maybe
import Control.Monad.State

foo :: Int -> Int -> [Int] -> [Int] -> ([Int], [Int])
foo 0 _ xs ys = (xs, reverse ys)
foo _ 0 xs ys = (xs, reverse ys)
foo z o (0:xs) ys = foo (z - 1) o xs (0:ys)
foo z o (1:xs) ys = foo z (o - 1) xs (1:ys)

solution' :: Int -> Int -> MaybeT (State [Int]) [[Int]]
solution' l r | r - l <= 1 = return []
              | otherwise = do
                  let m = div (r + l) 2
                  a <- solution' l m
                  b <- solution' m r
                  s <- get
                  let (s', res) = foo (m - l) (r - m) s []
                  put s
                  return (a ++ b ++ [res])

separate :: [Int] -> State [[Int]] [Int]
separate [x] = return [x]
separate values = do
                    xs <- get
                    put $ tail xs

                    let collect (0:f, a, b) x = (f, x:a, b)
                        collect (1:f, a, b) x = (f, a, x:b)
                        (_, l, r) = foldl collect (head xs, [], []) values
                    right <- separate (reverse r)
                    left <- separate (reverse l)
                    return $ left ++ right

runSolution'' :: Int -> Int -> [Int] -> ([Int], Int)
runSolution'' l r s = let m = div (r + l) 2 in
                        case runState (runMaybeT $ solution' 0 m) s of
                            (Just res, []) -> (evalState (separate [1..m]) $ reverse res, m)
                            (_, _:_)       -> if r - m <= 1
                                                then ([], 0)
                                                else runSolution'' m r s
                            _              -> if m - l <= 1
                                                then ([], 0)
                                                else runSolution'' l m s

main = do
    s <- getLine
    let (a, i) = runSolution'' 1 100001 $ map digitToInt s
    putStrLn $ show i
    putStr $ foldr (\a b -> a ++ " " ++ b) "" $ map show a

{-# LANGUAGE NoMonadFailDesugaring #-}

import Debug.Trace
import Data.Maybe
import Control.Monad.Trans.Maybe
import Control.Monad.State

chop = do
    x:xs <- get
    put xs
    return x

helper' :: Int -> Int -> MaybeT (State String) [Int]
helper' 0 zeroes = return $ replicate zeroes 0
helper' ones 0   = return $ replicate ones 1
helper' ones zeroes = do
                    c <- chop
                    case c of
                        '0' -> fmap (0:) $ helper' ones (zeroes - 1)
                        '1' -> fmap (1:) $ helper' (ones - 1) zeroes

solution' :: Int -> Int -> MaybeT (State String) [[Int]]
solution' l r | r - l <= 1 = return []
              | otherwise = do
                  let m = div (r + l) 2
                  a <- solution' l m
                  b <- solution' m r
                  res <- helper' (r - m) (m - l)
                  return (a ++ b ++ [res])

separate :: [Int] -> State [[Int]] [Int]
separate [x] = return [x]
separate values = do
                    fil:xs <- get
                    put xs

                    let collect (0:f, a, b) x = (f, x:a, b)
                        collect (1:f, a, b) x = (f, a, x:b)
                        (_, l, r) = foldl collect (fil, [], []) values
                    right <- separate (reverse r)
                    left <- separate (reverse l)
                    return $ left ++ right

runSolution'' :: Int -> Int -> String -> ([Int], Int)
runSolution'' l r s = if r - l <= 10
                        then ([], 0)
                        else let m = div (r + l) 2 in
                        case runState (runMaybeT $ solution' 0 m) s of
                            (Just res, "") -> (evalState (separate [1..m]) $ reverse res, m)
                            (_, _:_)       -> runSolution'' m r s
                            _              -> runSolution'' l m s

runSolution' :: Int -> Int -> String -> ([Int], Int)
runSolution' l r s = if l > r
                    then ([], 0)
                    else case runState (runMaybeT $ solution' 0 l) s of
                     (Just res, "") -> (evalState (separate [1..l]) $ reverse res, l)
                     _ -> runSolution' (l + 1) r s

main = do
    s <- getLine
    let (a, i) = runSolution'' 1 101000 s
    putStrLn $ show i
    mapM (putStr.(++ " ").show) a


Xenia the beginner mathematician is a third year student at elementary school. She is now learning the addition operation.The teacher has written down the sum of multiple numbers. Pupils should calculate the sum. To make the calculation easier, the sum only contains numbers 1, 2 and 3. Still, that isn't enough for Xenia. She is only beginning to count, so she can calculate a sum only if the summands follow in non-decreasing order. For example, she can't calculate sum 1+3+2+1 but she can calculate sums 1+1+2 and 3+3.You've got the sum that was written on the board. Rearrange the summans and print the sum in such a way that Xenia can calculate the sum.

The first line contains a non-empty string s — the sum Xenia needs to count. String s contains no spaces. It only contains digits and characters "+". Besides, string s is a correct sum of numbers 1, 2 and 3. String s is at most 100 characters long.

-- just count the 1s, 2s, and 3s

-- find place in book which says that lists don't have spaces (real world haskell)

count str [a,b,c]
  | (null str) = [a,b,c]
  | (head str) == '+' = count (tail str) [ a, b, c]
  | (head str) == '1' = count (tail str) [ a+1, b, c]
  | (head str) == '2' = count (tail str) [ a, b+1, c]
  | (head str) == '3' = count (tail str) [ a, b, c+1]

construct [a,b,c] grr
  | (a + b + c) == 0 = grr  -- base case
  | (a + b + c) == 1 = (grr ++ [(choose a b c)]) -- one left
  | a /= 0 = construct [ a-1, b, c] (grr ++ "1+")
  | b /= 0 = construct [ a, b-1, c] (grr ++ "2+")
  | c /= 0 = construct [ a, b, c-1] (grr ++ "3+")

choose a b c
  | a == 1 = '1'
  | b == 1 = '2'
  | c == 1 = '3'

main = do
  exp <- getLine
  let mine = count exp [0,0,0]
  let ans = construct mine ""
  putStrLn ans

import Data.List

-- Snippet: split
split c s
    | null s = [""]
    | c == (head s) = "" : r
    | otherwise = ((head s) : r1) : rn
    where r@(r1 : rn) = split c (tail s)

main = do
    s <- getLine
    putStrLn $ intercalate "+" $ sort $ split '+' s

import Control.Applicative((<$>))
import Data.List(sort)
main = map (\x -> if x == ' ' then '+' else x) <$> unwords <$> sort <$> words <$> map (\x -> if x == '+' then ' ' else x) <$> getLine >>= putStrLn

import Data.List (sort)

parse :: String -> String
parse (x:_:xs) = x : parse xs
parse xs = xs

create :: String -> String
create [x] = [x]
create (x:xs) = x:'+':create xs
create [] = []

main :: IO ()
main = do
	s <- getLine
	putStr $ create $ sort $ parse s

import Data.List (sort, intersperse, concat)

data Symbol a = Summation | Number Int deriving (Eq, Show, Ord)

showSymbol :: Symbol a -> String
showSymbol Summation = "+"
showSymbol (Number a) = show a

parse :: Char -> Symbol a
parse '+' = Summation
parse x = Number (read [x] :: Int)

isNumber :: Symbol a -> Bool
isNumber (Number a) = True
isNumber _ = False

main :: IO ()
main = do
    args <- getLine
    putStrLn $ concat $ intersperse (showSymbol Summation) $ map showSymbol $ sort $ filter isNumber $ fmap parse args

import Data.List (sort, intercalate)

main :: IO ()
main = do
  line <- getLine
  putStrLn $ intercalate "+" (sort $ splitOn '+' line)

splitOn :: Char -> String -> [String]
splitOn c s =
  case s of
    [] -> []
    _  -> s' : splitOn c (dropWhile (== c) s'')
      where (s', s'') = span (/= c) s

import Data.List.Split
import Data.List

main = do
    s <- getLine
    let
        ns = sort $ map (read :: String -> Int) $ splitOn "+" s
    putStrLn $ intercalate "+" $ map show ns

g1 :: [Int] -> [Int]
g1 (a:s) = (a + 1):s

g2 :: [Int] -> [Int]
g2 (a:b:s) = (a):(b + 1):s

g3 :: [Int] -> [Int]
g3 (a:b:c:s) = (a):(b):(c + 1):s

solve :: String -> [Int]
solve "" = [0, 0, 0]
solve ('+':s) = solve s
solve ('1':s) = g1 (solve s)
solve ('2':s) = g2 (solve s)
solve ('3':s) = g3 (solve s)

gen :: [Int] -> String
gen [0, 0, 0] = ""
gen [0, 0, a] = "+3" ++ (gen [0, 0, a - 1])
gen [0, a, b] = "+2" ++ (gen [0, a - 1, b])
gen [a, b, c] = "+1" ++ (gen [a - 1, b, c])

cuttt (ch:s) = s

main = do
    s <- getLine
    let t = solve s
    let answer = gen t;
    let qq = "sdfsdf"
    --print qq
    --print 5
    putStrLn (cuttt answer)

import Data.List
import Data.Char
main = interact $ intersperse '+' . sort . filter isDigit

import Data.List
import Data.List.Split
import qualified Data.Map as M
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> head
  in solve ls

solve str = str |> splitOn "+" |> sort |> intercalate "+"

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

main = do
    s <- getLine
    putStrLn $ solve s

solve = concat . intersperse "+" . map show . sort . map readI . words . map f

readI :: String -> Int
readI = read

f '+' = ' '
f a = a

import Data.List

getInput :: String -> [Int]
getInput [] = []
getInput (x:xs)
 | x /= '+'  = intx : getInput xs
 | otherwise = getInput xs
 where intx = read (x:[]) :: Int

sortList :: [Int] -> [Int]
sortList = sort

printSum    :: [Int] -> String
printSum [] = ""
printSum (x:xs) = strInt ++ "+" ++ printSum xs
    where strInt = show x

main :: IO ()
main = do n <- getLine
          putStr $ init $ printSum $ sortList $ getInput n

module Main where

import Data.List (sort)

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

-- |
-- >>> f "1+1+3+1+3"
--"1+1+1+3+3"
f :: String -> String
f = m . sort . filter (/='+')

m :: String -> String
m [] = []
m [x] = [x]
m (x:xs) = x : '+' : m xs

import Data.List

main = do
	string <- getLine

	putStrLn . intersperse '+' . sort $ filter (/= '+') string

module Main where

import Data.List
splitBy delimiter = foldr f [[]]
            where f c l@(x:xs) | c == delimiter = []:l
                             | otherwise = (c:x):xs

main::IO()
main = do
        inp <- getLine
        let nums = (splitBy '+' inp)
        putStrLn $ intercalate "+" (sort nums)

import Data.List

main = do
    str <- getLine
    let grep str = _grep str where
        _grep "" = ""
        _grep (x:xs)
            | x /= '+' = x : (grep xs)
            | otherwise = grep xs

    let xs = map read $ words str :: [Int]

    putStrLn (intersperse '+' (sort (grep str)))

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

import Data.List
main = readsolveprint
readsolveprint =  --print $ sort "56847846846"
  interact $ solve.head.take 1.lines
solve :: String->String
solve xs = tail. foldr (g) "" $ sort $ foldr (f) "" xs
 where f a b | a=='+'=b
             | otherwise = a:b ;
       g a b = "+"++ (a:b)

import Data.List

insertPlus :: String -> String
insertPlus []     = []
insertPlus (x:xs) = x :'+' : insertPlus xs

helpfulMaths :: String -> String
helpfulMaths xs = take (length(xs)) (insertPlus $ sort $ filter (\x -> x /= '+') xs)

main = do
    s <- getLine
    putStr $ helpfulMaths s

import Data.List

solve :: String -> String
solve l = intersperse '+' . sort $ filter (/='+') l

main = do
    l <- getLine
    putStrLn $ solve l

import Data.List (intercalate)

solve :: String -> String
solve s  =  intercalate "+"
  $ concat [replicate a "1", replicate b "2", replicate c "3"]
  where
  	a  =  length $ filter (=='1') s
  	b  =  length $ filter (=='2') s
  	c  =  length $ filter (=='3') s

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

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

-- Codeforces 339A

import Data.List

main :: IO ()
main = getLine >>= putStrLn . solve . zip [1..]

solve :: [(Int, Char)] -> String
solve xs = tail $ foldl (\a b -> (a ++ [snd (cs !! ((fst b) `div` 2))] ++ [snd b])) [] ns where
    ns = zip [1..] $ map snd $ sortBy (\a b -> (compare (snd a) (snd b))) $ filter (\x -> (fst x) `mod` 2 == 1) xs
    cs = [(0, ' ')] ++ filter (\x -> (fst x) `mod` 2 == 0) xs

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Applicative
import Control.Arrow
import Data.Char
import qualified Data.Map as M

main = do
  s <- B.split '+' . B.takeWhile (not . isSpace) <$> B.getContents
  let ms = M.toList . M.fromListWith (+) $ map (id &&& const 1) s
      out= concatMap (uncurry $ flip replicate) ms
  B.putStrLn . B.intercalate "+" $ out

import Data.List

separateBy _ [] = []
separateBy c xs =
  case span (/=c) xs of
    (left, []) -> [left]
    (left, (_:right)) -> left:separateBy c right

solve expr = intercalate "+" $ map show $ sort $ map (read :: String -> Int) $ separateBy '+' expr

main = interact solve

import Data.List

main = do
	sum <- getLine
	let notPlus str = filter (\char -> not $ char == '+') str
	let mapStrings str = map (\char -> [char]) str
	let implode arr = intercalate "+" arr
	putStrLn . implode . mapStrings . sort . notPlus $ sum

import Data.List

separate :: String -> [String]
separate xs = words [if x /= '+' then x else ' ' | x <- xs]

main = do
    ints <- fmap (map read . separate) getLine :: IO [Int]
    putStrLn $ intercalate "+" $ map show $ sort ints

import Data.List (sort)

addplus a = tail [if y == 1 then x else '+' | x <- a, y <- [0..1]]
solve a = putStrLn $ addplus (sort (filter (\c -> c /= '+') (a)))
main = getLine >>= solve

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

solve :: String -> String
solve = intersperse '+' . sort . filter (/= '+')

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

-- Helpful Maths
import Data.List
import Data.List.Split

main = do
  contents <- getLine
  putStrLn $ intercalate "+" $ sort $ splitOn "+" contents

import Data.List

main::IO()
main=do
  x <- getLine
  putStrLn $ intersperse '+' $ sort  $ filter (/='+') x

import Data.Text hiding (map, init)
import Data.List (sort)
solve :: String -> String
solve = unpack . intercalate (pack "+") . sort . splitOn (pack "+") . pack . init
main = interact solve

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

main::IO ()
main= do
  intersperse '+' <$> sort <$> filter (/='+') <$> getLine >>=putStrLn

main = do
	equ <- getLine
	let wiou = [a | a <- equ, a /= '+']
	let sorted = quicksort wiou
	putStrLn $ addd sorted []

addd :: String -> String -> String
addd [] s = s
addd (c:s) [] = addd s [c]
addd (c:s) t = addd s (c:'+':t)

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
    let smallerSorted = quicksort [a | a <- xs, a <= x]
        biggerSorted = quicksort [a | a <- xs, a > x]
    in  biggerSorted ++ [x] ++ smallerSorted

import Data.List (sort)
import Data.Char (isDigit)

main :: IO ()
main = getLine >>= putStrLn . tail . foldr (\c s -> '+' : c : s) "" . sort . filter isDigit

import Data.List

main :: IO ()
main = do
  s <- getLine
  s <- return $ fmap (:[]) $ sort $ filter (/='+') s
  putStrLn $ concat $ intersperse "+" s

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

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

reorder :: String -> String
reorder = intercalate "+" . sort . map (:[]) . filter (/='+')

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

import Data.List

splitAlternate:: String -> String
splitAlternate s
  | l == 1 = s
  | otherwise = head s : (splitAlternate(tail(tail s)))
  where l = length s

main = do
  interact $ intersperse '+' . sort . splitAlternate . init

import Control.Applicative
import Data.List (intersperse, sort)

-- misc.
readInt :: String -> Int
readInt = read

split :: (Eq a) => a -> [a] -> [[a]]
split _ [] = []
split x ys = p : (if null qs then [] else split x (tail qs))
    where (p,qs) = break (==x) ys

-- problem
main = putStrLn =<< (intersperse '+' . concatMap show . sort . map readInt . split '+') <$> getLine

import Data.List
main=interact$intercalate "+".map show.(sort::[Int]->[Int]).map read.splitOn '+' ""
splitOn c a (x:xs) | x == c = reverse a : splitOn c "" xs
                   | otherwise = splitOn c (x:a) xs
splitOn _ a [] = [a]

import Data.List

main :: IO ()
main = interact (intersperse '+' . sort . filter (/= '+') . head . lines)

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

module Main where

import Data.List (intercalate, sort)
import Data.Char (digitToInt)

filterList :: String -> [Int]
filterList = sort . fmap digitToInt . filter (/= '+')

main :: IO ()
main = do
  numbers <- fmap filterList getLine
  putStrLn $ intercalate "+" (fmap show numbers)

count :: String -> (Int, Int, Int) -> (Int, Int, Int)
count [] t = t
count (x : xs) (a, b, c)
  | x == '1' = count xs (a + 1, b, c)
  | x == '2' = count xs (a, b + 1, c)
  | x == '3' = count xs (a, b, c + 1)
  | otherwise = count xs (a, b, c)

makeAns :: (Int, Int, Int) -> String
makeAns (0, 0, 1) = "3"
makeAns (0, 1, 0) = "2"
makeAns (1, 0, 0) = "1"
makeAns (0, 0, c) = '3' : '+' : makeAns (0, 0, c - 1)
makeAns (0, b, c) = '2' : '+' : makeAns (0, b - 1, c)
makeAns (a, b, c) = '1' : '+' : makeAns (a - 1, b, c)

main = do
  s <- getLine
  putStrLn $ makeAns $ count s (0, 0, 0)

import Data.List

solve :: String -> String
solve = intersperse '+' . sort . filter (/= '+')

main = getLine >>= putStrLn . solve

module Main where
import Data.List
import Control.Applicative
main = putStrLn =<< tail . foldl (\s n -> s ++ "+" ++ [n]) ""  . sort . filter (/='+') <$> getLine

import Data.List
import Data.Char
main = interact $ (intersperse '+' . sort . foldr (\x xs -> (if isDigit x then [x] else []) ++ xs) [])

import Data.Char
import Data.Text (Text, pack, unpack, split)
import Data.List (sort)

h :: String -> [Text]
h str = sort $ split (== '+') $ pack str

f :: [Text] -> String
f [x] = unpack x
f (x:xs) = (unpack x) ++ "+" ++ f xs

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

import System.IO
import Data.List

solve :: String -> String
solve [a] = [a]
solve (a:as) = a : '+' : solve as

main = getLine >>= (\str -> putStrLn . solve . dropWhile (=='+') $ sort str)

import           Data.List (intersperse, sort)

main = do
  s <- intersperse '+' . sort . filter (/= '+') <$> getLine
  putStrLn s

module Main where
import Data.Char
import Data.Maybe
import Data.Function
import Data.List
import System.Environment
import qualified Data.ByteString.Char8 as C

main = do
	paramStr <- getLine
	let
		param = readIntsFromStr paramStr
		in putStrLn $ id ((intercalate "+") . (map show) . sort $ param)

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

readIntsFromStr :: String -> [Int]
readIntsFromStr str = map readInt (filter p (wordsWhen (=='+') str))
	where p = (/=)""

readInt :: String -> Int
readInt = read

{-# LANGUAGE Safe #-}
{-# Options_GHC -O3 #-}
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.IO.Safe
import Data.Bits
import Data.ByteString.Builder
import Data.Char
import Data.Monoid
import Data.Int
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Char8 as C
import System.IO

qsort :: (Ord e, MArray a e m) => a Int e -> [Int] -> m ()
qsort x rnds = do
  bds@(l',r') <- getBounds x
  let
    srt l r (y:ys) = do
      xm <- readArray x (l + mod y (r - l + 1))
      let
        f i j
          | i > j = return (i, j)
          | otherwise = do
               let g' i = do
                     xi <- readArray x i
                     if xm > xi then g' (succ i) else return i
                   g'' j = do
                     xj <- readArray x j
                     if xm < xj then g'' (pred j) else return j
               i' <- g' i
               j' <- g'' j
               if i' <= j' then do
                 v1 <- readArray x i'
                 v2 <- readArray x j'
                 writeArray x i' v2
                 writeArray x j' v1
                 f (succ i') (pred j')
               else return (i', j')
      (i'', j'') <- f l r
      when (l < j'') $ srt l j'' ys
      when (i'' < r) $ srt i'' r ys
  srt l' r' rnds

getSeed :: IO Int
getSeed = do t <- getCurrentTime; return $ fromInteger $ (`mod` 999983) $ diffTimeToPicoseconds $ utctDayTime t

pmGen :: Int -> Int
pmGen x = fromIntegral (mod ((16807::Int64) * fromIntegral x) 2147483647)

main = do
  seed <- getSeed
  s <- C.getLine
  let a = C.split '+' $ C.takeWhile isPrint s
      randoms = seed : map pmGen randoms
  arr <- newListArray (1, length a) a :: IO (IOArray Int C.ByteString)
  qsort arr randoms
  e <- getElems arr
  C.putStrLn $ C.intercalate (C.pack "+") e

f1 :: String -> String
f1 [] = []
f1 (x:xs) = ('+':x:f1 xs)

f2 :: String -> String
f2 [] = []
f2 (x:xs)
  | x == '+'  = f2 xs
  | otherwise = (x:f2 xs)

msort' :: String -> String
msort' [] = []
msort' [x] = [x]
msort' x = merge' left right
  where left  = msort' $ take m x
        right = msort' $ drop m x
        m = div (length x + 1) 2

merge' :: String -> String -> String
merge' [] [] = []
merge' (x:xs) [] = (x:merge' xs [])
merge' [] (y:ys) = (y:merge' ys [])
merge' (x:xs) (y:ys)
  | x <= y    = (x:merge' xs (y:ys))
  | otherwise = (y:merge' (x:xs) ys)

main = do
  a <- getLine
  putStrLn $ tail $ f1 $ msort' $ f2 a

import Data.List(sort)

main = interact $ join '+' . sort . split '+' . filter (/='\n')

split _ [] = ""
split c (h:ls) = if c==h then split c ls else h : split c ls

join c [h] = [h]
join c (h:ls) = h : c : join c ls

import Data.List (sort)

split :: Char -> String -> [String]
split _ "" = [""]
split c s | null r2 = [r1]
          | otherwise = r1 : split c (tail r2)
  where
    (r1, r2) = span (/= c) s

join :: String -> [String] -> String
join x s = foldr1 (\s1 s2 -> s1 ++ x ++ s2) s

main :: IO ()
main = do
    x <- getLine
    putStrLn $ join "+" $ sort $ split '+' x

import Data.List

splitOn _ [] = []
splitOn c xs = as : splitOn c (dropWhile f bs)
    where (as, bs) = break f xs
          f x = x == c

main = interact $ intercalate "+" .  sort .  splitOn '+' . head . words

import Data.List.Split
import Data.List

main::IO()
main = do
  input <- getLine
  (putStrLn . (intercalate "+") . sort . (splitOn "+")) input

import Data.List

seconds :: [a] -> [a]
seconds [] = []
seconds [x] = [x]
seconds (x:_:xs) = x : seconds xs

main :: IO ()
main = fmap (intersperse '+' . sort . seconds) getLine >>= putStrLn

import Control.Applicative
import Data.Char

main= do
	s<-getLine
	let n1 = length $ filter (=='1') s
	let n2 = length $ filter (=='2') s
	let n3 = length $ filter (=='3') s
	putStrLn $ init $ concat $ map concat  [replicate n1 "1+" , replicate n2 "2+",replicate n3 "3+"]

import Data.List

split:: String->[String]
split s
  | snd breakedString == "" = [fst(breakedString)]
  | otherwise = fst(breakedString):split(tail(snd breakedString))
  where breakedString = break (=='+') s

convert::[[a]] -> [a]
convert [] = []
convert (x:xs) = x ++ convert(xs)

join xs = intersperse '+' (convert([show x | x <- xs]))

main = do
  input <- getLine
  putStrLn(join(sort([read n::Int|n <- split(input)])))

sort [] = []
sort (x:xs) = (sort shorter) ++  (x : sort greater)
    where shorter = [y|y <- xs, y<=x]
          greater = [y|y <- xs, y>x]

cout xs = case xs of [x] -> show x
                     (y:ys) -> (show y) ++ "+" ++ (cout ys)

main = do
    x <- getLine
    putStrLn $ (cout . sort . map (\y -> read [y] :: Int) . filter (/='+')) x

main = do
  m <- getLine
  let n = splitOn '+' m
  let t = s123 n
  let ret = unsplitOn '+' t
  putStrLn ret
splitOn :: Char -> String -> [Int]
splitOn _ [] = []
splitOn c x =  (read (takeWhile (/= c) x)) : (splitOn c (tailo $ dropWhile (/= c) x))
unsplitOn :: Char -> [Int] -> String
unsplitOn x = (tail) . (foldr (\y -> ((x:).((show y)++))) [])
tailo :: [a] -> [a]
tailo [] = []
tailo x = tail x
s123 :: [Int] -> [Int]
s123 x = (filter (==1) x) ++ (filter (==2) x) ++ (filter (==3) x)

import           Data.List                      ( intersperse
                                                , sort
                                                )
main :: IO ()
main = do
    numbers <- filter ('+' /=) <$> getLine
    putStrLn $ intersperse '+' $ sort numbers

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

main :: IO ()
main = getLine >>= putStrLn. intersperse ('+') .sort. filter (/='+')

import Data.List

glue::String->String
glue [x] = [x]
glue [] = []
glue (x:xs) = x:'+': glue xs

answer::String->String
answer = glue . sort . filter (/='+')

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

main :: IO ()
main = someFunc

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

import Data.List (sort, intersperse)

process :: String -> String
process = intersperse '+'.sort.filter (/='+')

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

import Data.List

main = getContents >>=
  putStrLn . intersperse '+' . sort . filter (\c -> c /= '+' && c /= '\n')

{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Data.Either
import           Data.List
import qualified Data.Text           as T
import qualified Data.Text.IO        as TIO
import qualified Data.Text.Lazy      as TL
import qualified Data.Text.Lazy.IO   as TLIO
import qualified Data.Text.Lazy.Read as TLR
import qualified Data.Text.Read      as TR

main :: IO ()
main = do
  input <- TLIO.getContents
  let s = TL.splitOn "+" input
      xs = map fst $ sort.rights $ map TLR.decimal s
  putStrLn (intercalate "+" (map show xs))

toList :: String -> [Integer]
toList input = map read (words input)

{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Data.Either
import           Data.List
import qualified Data.Text      as T
import qualified Data.Text.IO   as TIO
import qualified Data.Text.Read as TR

main :: IO ()
main = do
  input <- TIO.getContents
  let s = T.splitOn "+" input
      xs = map fst $ sort.rights $ map TR.decimal s
  putStrLn (intercalate "+" (map show xs))

toList :: String -> [Integer]
toList input = map read (words input)

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

main :: IO ()
main = do
  s <- getLine
  putStrLn $ pp $ sort $ rush s

pp :: [Int] -> String
pp = intercalate "+" . map show

rush :: String -> [Int]
rush [x] = [read [x]]
rush (h:rest) = read [h] : rush (tail rest)

import Data.List

main :: IO ()
main = getLine >>= putStrLn . intersperse '+' . sort . filter (/='+')
-- intersperse
-- >>= monad uses the result of previous action

import Data.List

solve :: String -> String
solve = intercalate "+" . sort . splitWhen (`elem` "+\n")

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p s = case dropWhile p s of
    [] -> []
    s' -> w : splitWhen p s''
        where (w, s'') = break p s'

main :: IO ()
main = interact solve

import Data.List
import Data.List.Split

main =  putStrLn . intercalate "+" . sort . splitOn "+" =<< getLine

import Data.List.Split
import Data.List
main = interact $ intercalate "+".sort.splitOn "+".last.lines

import qualified Data.Char as Ch
import Data.List

countRes :: [Char] -> Bool
countRes xs = length (filter acceptable xs) > 0
            where acceptable = (`elem` ['H', 'Q', '9'])

printString :: [Char] -> IO ()
printString (x:[]) = putStr [x]
printString (x:xs) = do
                    putStr [x]
                    putStr "+"
                    printString xs

main :: IO ()
main = do
    nStr <- getLine
    printString $ sort (filter (\x -> x `elem` ['1'..'9']) nStr)
    putStrLn ""

import Data.List

getans :: [Int] -> String
getans [] = ""
getans (x:xs)  = (show x) ++ (if (xs == []) then "" else "+") ++ (getans xs)

main = do
    input <- getLine
    putStr $ getans $ sort $ (map read (words (map (\x -> if (x == '+') then ' ' else x) input)) :: [Int])

{-# LANGUAGE OverloadedStrings #-}
import Data.List (sort)
import Control.Monad

import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.IO (stdin)
import Data.Text.Read (decimal)

import Data.List (intercalate)

tread s = case decimal s of
  Right (v, _) -> v
  Left e -> error e

main = do
  aa <- TIO.hGetLine stdin
  let p = T.splitOn "+" aa
  let xs' = sort $ map (read . T.unpack) p :: [Int]

  let ys = intercalate "+" $ map show xs'
  putStrLn ys

module Main (main)
    where

import Data.Char (ord)
import Data.List (sort, intersperse)

main :: IO ()
main = putStrLn . intersperse '+' . sort . extract =<< getLine
    where extract [] = []
          extract (x:_:xs) = x:extract xs
          extract (x:xs) = x:extract xs

import Data.List (sort, foldl', intersperse)

getNumbers :: String -> [Int]
getNumbers [] = []
getNumbers s = number : getNumbers b
  where notPlus = \x -> x /= '+'
        number = read . takeWhile notPlus $ s
        rest = dropWhile notPlus s
        b = if null rest then rest else tail rest

answer :: String -> String
answer s = concat . intersperse "+" . map show . sort . getNumbers $ s

main = interact answer

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

replace :: Char -> Char -> Char
replace a x = if x == a then ' ' else x

insertp :: String -> String -> String
insertp a b = if length a > 0 then a ++ "+" ++ b else b

main :: IO ()
main = do
    line <- getLine
    let s = map (replace '+') line
    let l = sort $ words s
    putStrLn (foldl insertp "" l)

module Main where

import Data.List

(|>) = flip (.)

main = interact $
    lines
    |> head |> takeWhile (/= '\n')
    |> filter (/= '+')
    |> sort
    |> map (\x -> [x])
    |> intercalate "+"

import Data.Text(pack,unpack,split)
import Data.List
main=interact(intercalate"+".sort.map unpack.split(=='+').pack.init)

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

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

-- Sort the expression
sortExpr :: String -> String
sortExpr s = concat (intersperse "+" (map show ( quicksort ( map (read :: String -> Int) (splitOn "+" s) ) )))

main = do
    s <- getLine
    putStrLn $ sortExpr s

import Data.List

solve s = myShow $ sort $ splitOn '+' s

myShow [] = ""
myShow (s:ss) | null ss = s ++ myShow ss
              | otherwise = s ++ "+" ++ myShow ss

main =
  do
  s<-getLine
  putStrLn $solve s

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

 import Data.List
 f x =intersperse '+' (sort [e | e<-(init x),e/='+'])
 main=interact$f

 import Data.List
 f x =intersperse '+' (sort [e | e<-x,e/='+',e/='\n'])
 main=interact$f

import Data.List
import Data.Char

main = interact $ intersperse '+' . sort . filter isDigit . head . lines

main :: IO ()
main = do
  line <- getLine
  print $ foldr (+) 0 $ map (read :: String -> Int) (splitOn '+' line)

splitOn :: Char -> String -> [String]
splitOn c s  =
  case s of
    [] -> []
    _  -> s' : splitOn c (dropWhile (== c) s'')
      where (s', s'') = span (/= c) s

g1 :: [Int] -> [Int]
g1 (a:s) = (a + 1):s

g2 :: [Int] -> [Int]
g2 (a:b:s) = (a):(b + 1):s

g3 :: [Int] -> [Int]
g3 (a:b:c:s) = (a):(b):(c + 1):s

solve :: String -> [Int]
solve "" = [0, 0, 0]
solve ('+':s) = solve s
solve ('1':s) = g1 (solve s)
solve ('2':s) = g2 (solve s)
solve ('3':s) = g3 (solve s)

gen :: [Int] -> String
gen [0, 0, 0] = ""
gen [0, 0, a] = "+3" ++ (gen [0, 0, a - 1])
gen [0, a, b] = "+2" ++ (gen [0, a - 1, b])
gen [a, b, c] = "+1" ++ (gen [a - 1, b, c])

cuttt (ch:s) = s

main = do
    s <- getLine
    let t = solve s
    let answer = gen t;
    print (cuttt answer);

import Data.List
main = interact $ intersperse '+' . sort . filter (/= '+')

import Data.List

main = do
    str <- getLine
    let grep str = _grep str where
        _grep "" = ""
        _grep (x:xs) = (if x == '+' then ' ' else x) : (grep xs)

    let xs = map read $ words str :: [Int]

    putStrLn (drop 4 (intersperse '+' (sort (grep str))))

import Data.List

main = do
    str <- getLine
    let grep str = _grep str where
        _grep "" = ""
        _grep (x:xs) = (if x == '+' then ' ' else x) : (grep xs)

    let xs = map read $ words str :: [Int]

    print (drop 4 (intersperse '+' (sort (grep str))))

import Data.List

insertPlus :: String -> String
insertPlus []     = []
insertPlus (x:xs) = x :'+' : insertPlus xs

helpfulMaths :: String -> String
helpfulMaths xs = take (length(xs)) (insertPlus $ sort $ filter (\x -> x /= '+') xs)

main = do
    s <- getContents
    putStr $ helpfulMaths s

import Data.List

main::IO()
main=do
  x <- getLine
  putStrLn $ show $ intersperse '+' $ sort  $ filter (/='+') x

import Data.Text hiding (map)
import Data.List (sort)
solve :: String -> String
solve = unpack . intercalate (pack "+") . sort . splitOn (pack "+") . pack
main = interact solve

import Data.List

main :: IO ()
main = interact (intersperse '+' . sort . filter (/= '+'))

import Data.List(sort)

main = interact $ join '+' . sort . split '+'

split _ [] = ""
split c (h:ls) = if c==h then split c ls else h : split c ls

join c [h] = [h]
join c (h:ls) = h : c : join c ls

import Data.List

splitOn _ [] = []
splitOn c xs = as : splitOn c (dropWhile f bs)
    where (as, bs) = break f xs
          f x = x == c

main = interact $ intercalate "+" .  sort .  splitOn '+'

main = do
  m <- getLine
  let n = sum $ splitOn '+' m
  print n
splitOn :: Char -> String -> [Int]
splitOn _ [] = []
splitOn c x =  (read (takeWhile (/= c) x)) : (splitOn c (tailo $ dropWhile (/= c) x))
tailo :: [a] -> [a]
tailo [] = []
tailo x = tail x

import Data.List

main = getContents >>=
  print . intersperse '+' . sort . filter (\c -> c /= '+' && c /= '\n')

import Data.List

main = getContents >>=
  print . intersperse '+' . sort . filter ('+'/=)

import Data.List

solve :: String -> String
solve = intercalate "+" . sort . splitWhen (== '+')

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p s = case dropWhile p s of
    [] -> []
    s' -> w : splitWhen p s''
        where (w, s'') = break p s'

main :: IO ()
main = interact solve

import Data.List.Split
import Data.List
main = interact $ intercalate "+".sort.splitOn "+"

import Data.Text(pack,unpack,split)
import Data.List
main=interact(intercalate"+".sort.map unpack.split(=='+').pack)

import Data.List

solve s = myShow $ sort $ splitOn '+' s

myShow [] = ""
myShow (s:ss) | null ss = s ++ myShow ss
              | otherwise = s ++ "+" ++ myShow ss

main = interact $ solve

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

 import Data.List
 import Data.List.Split
 f x =intercalate "+" (sort$splitOn "+" x)
 main=interact$f

 import Data.List
 f x =intersperse '+' (sort [e | e<-x,e/='+'])
 main=interact$f