-- 2022-10-10 01:28:10.472283 UTC
{-# LANGUAGE FlexibleInstances #-}

import Data.Graph (Graph, Vertex, Forest, Tree)
import qualified Data.Maybe
import qualified Data.Graph
import qualified Data.Bits
import qualified Data.Char
import qualified Control.Monad
import qualified Text.Read
import qualified Data.Map
import qualified Data.Tree
import qualified Data.Array
import qualified Data.Set
import qualified Data.Bits
import qualified Data.ByteString.Char8
import qualified Data.ByteString
import qualified Data.List
import qualified Data.List.NonEmpty
import qualified Numeric
import Data.List.NonEmpty (NonEmpty((:|)), (<|))
import Data.Map (Map)
import Data.Set (Set)
import Data.Array (Array, (!))
import Data.ByteString (ByteString)
import Debug.Trace

data GraphForProblems key
    = GraphForProblems {gpGraph :: Graph,
                        gpVertexFromKey :: (key -> Vertex),
                        gpNodeFromVertex :: (Vertex -> key)}
newtype GraphVertex a = GraphVertex a
instance Eq a => Eq (GraphVertex a)
    where (==) (GraphVertex a) (GraphVertex b) = a == b
unwrapGraphVertex :: GraphVertex i -> i
unwrapGraphVertex (GraphVertex i) = i
type IntGraph = GraphForProblems Int
type StringGraph = GraphForProblems String
data GraphEdge a = GraphEdge (GraphVertex a) (GraphVertex a)
instance Show (GraphForProblems key)
    where show (GraphForProblems {gpGraph = gpGraph}) = show gpGraph
instance Ord a => Ord (GraphVertex a)
    where compare (GraphVertex a) (GraphVertex b) = compare a b
edgeSource :: GraphEdge a -> GraphVertex a
edgeSource (GraphEdge a _) = a
edgeDest :: GraphEdge a -> GraphVertex a
edgeDest (GraphEdge _ b) = b
mkGraph :: (Ord key, Show key) =>
           [(node, key, [key])] -> GraphForProblems key
mkGraph nodesAndEdges = GraphForProblems gpGraph gpVertexFromKey gpNodeFromVertex
            where (gpGraph,
                   nodeFromVertex,
                   vertexFromKey) = Data.Graph.graphFromEdges nodesAndEdges
                  gpVertexFromKey k = case vertexFromKey k of
                                          Nothing -> error $ ("vertexFromKey: " <> (show k <> " key not found"))
                                          Just k' -> k'
                  gpNodeFromVertex v = let (_, k, _) = nodeFromVertex v
                                        in k
vertices' :: GraphForProblems a -> [GraphVertex a]
vertices' (GraphForProblems {gpGraph = gpGraph,
                             gpNodeFromVertex = gpNodeFromVertex}) = (GraphVertex . gpNodeFromVertex) <$> Data.Graph.vertices gpGraph
edges' :: GraphForProblems a -> [GraphEdge a]
edges' (GraphForProblems {gpGraph = gpGraph,
                          gpNodeFromVertex = gpNodeFromVertex}) = (\(a,
                                                                     b) -> GraphEdge (GraphVertex $ gpNodeFromVertex a) (GraphVertex $ gpNodeFromVertex b)) <$> Data.Graph.edges gpGraph
dfs' :: GraphForProblems key ->
        [GraphVertex key] -> [Tree (GraphVertex key)]
dfs' (GraphForProblems {gpVertexFromKey = gpVertexFromKey,
                        gpGraph = gpGraph,
                        gpNodeFromVertex = gpNodeFromVertex}) = fmap (fmap (GraphVertex . gpNodeFromVertex)) . (Data.Graph.dfs gpGraph . fmap (gpVertexFromKey . unwrapGraphVertex))
dfsOnSingleVertex :: GraphForProblems key ->
                     GraphVertex key -> Tree (GraphVertex key)
dfsOnSingleVertex g v = case dfs' g [v] of
                            [] -> error "dfsOnSingleVertex: empty result"
                            x : _ -> x
scc' :: GraphForProblems key -> [Tree (GraphVertex key)]
scc' (GraphForProblems {gpGraph = gpGraph,
                        gpNodeFromVertex = gpNodeFromVertex}) = fmap (GraphVertex . gpNodeFromVertex) <$> Data.Graph.scc gpGraph
levels' :: Tree (GraphVertex key) -> [[GraphVertex key]]
levels' = Data.Tree.levels
getSingleEnd :: Eq a =>
                GraphForProblems a -> GraphVertex a -> GraphVertex a
getSingleEnd g vertex = edgeDest $ (head $ (Prelude.filter ((== vertex) . edgeSource) $ edges' g))
getSingleLeaf :: Tree (GraphVertex a) -> GraphVertex a
getSingleLeaf = last . Data.Tree.flatten
flatten' :: Tree (GraphVertex a) -> [GraphVertex a]
flatten' = Data.Tree.flatten
elemTreeInt :: GraphVertex Int -> Tree (GraphVertex Int) -> Bool
elemTreeInt = elem
minimumTree :: Tree Int -> Int
minimumTree = minimum
mapTree :: (a -> b) -> Tree a -> Tree b
mapTree = fmap
newtype OutDegreeTable
  = OutDegreeTable {unOutDegreeTable :: (Array Vertex Int)}
linearGraph :: OutDegreeTable -> Bool
linearGraph (OutDegreeTable {unOutDegreeTable = unOutDegreeTable}) = twoOnes && restTwos
                where values = Data.Array.elems unOutDegreeTable
                      numValues = length values
                      twoOnes = 2 == length (Prelude.filter (== 1) values)
                      restTwos = (numValues - 2) == length (Prelude.filter (== 2) values)
cycleGraph :: OutDegreeTable -> Bool
cycleGraph (OutDegreeTable {unOutDegreeTable = unOutDegreeTable}) = allTwos
               where values = Data.Array.elems unOutDegreeTable
                     allTwos = all (== 2) values
starGraph :: OutDegreeTable -> Bool
starGraph (OutDegreeTable {unOutDegreeTable = unOutDegreeTable}) = onlyOneCenter && restOnes
              where values = Data.Array.elems unOutDegreeTable
                    numValues = length values
                    onlyOneCenter = 1 == length (Prelude.filter (== numValues - 1) values)
                    restOnes = (numValues - 1) == length (Prelude.filter (== 1) values)
outdegree' :: GraphForProblems a -> OutDegreeTable
outdegree' (GraphForProblems {gpGraph = gpGraph}) = OutDegreeTable{unOutDegreeTable = unOutDegreeTable}
               where unOutDegreeTable = Data.Graph.outdegree gpGraph
safeElems2 :: [a] -> Maybe (a, a)
safeElems2 [x1, x2] = Just (x1, x2)
safeElems2 _ = Nothing
safeElems3 :: [a] -> Maybe (a, a, a)
safeElems3 [x1, x2, x3] = Just (x1, x2, x3)
safeElems3 _ = Nothing
safeElems4 :: [a] -> Maybe (a, a, a, a)
safeElems4 [x1, x2, x3, x4] = Just (x1, x2, x3, x4)
safeElems4 _ = Nothing
safeElems5 :: [a] -> Maybe (a, a, a, a, a)
safeElems5 [x1, x2, x3, x4, x5] = Just (x1, x2, x3, x4, x5)
safeElems5 _ = Nothing
compareLength :: Int -> [b] -> Ordering
compareLength 0 ([]) = EQ
compareLength 0 _ = LT
compareLength i (_ : xs) | i < 0 = error "compareLength: negative length comparison does not make sense"
                         | otherwise = compareLength (i - 1) xs
consumeNElems :: Int -> [b] -> Maybe ([b], [b])
consumeNElems 0 ([]) = Just ([], [])
consumeNElems 0 xs = Just ([], xs)
consumeNElems _ ([]) = Nothing
consumeNElems i (x : xs) | i < 0 = error "consumeNElems: negative length comparison does not make sense"
                         | otherwise = do {(ys, zs) <- consumeNElems (i - 1) xs;
                                           return (x : ys, zs)}
groupTups2 :: [a] -> Maybe ([(a, a)])
groupTups2 = go []
    where go acc ([]) = Just (reverse acc)
          go acc (x : (y : rest)) = go ((x, y) : acc) rest
          go _ _ = Nothing
groupTups3 :: [a] -> Maybe ([(a, a, a)])
groupTups3 = go []
    where go acc ([]) = Just (reverse acc)
          go acc (x : (y : (z : rest))) = go ((x, y, z) : acc) rest
          go _ _ = Nothing
safeHeadTail :: [a] -> Maybe (a, [a])
safeHeadTail (l1 : l2) = Just (l1, l2)
safeHeadTail _ = Nothing
safeTwoHeadTail :: [a] -> Maybe (a, a, [a])
safeTwoHeadTail (l1 : (l2 : l3)) = Just (l1, l2, l3)
safeTwoHeadTail _ = Nothing
safeThreeHeadTail :: [a] -> Maybe (a, a, a, [a])
safeThreeHeadTail (l1 : (l2 : (l3 : l4))) = Just (l1, l2, l3, l4)
safeThreeHeadTail _ = Nothing
safeFourHeadTail :: [a] -> Maybe (a, a, a, a, [a])
safeFourHeadTail (l1 : (l2 : (l3 : (l4 : l5)))) = Just (l1,
                                                        l2,
                                                        l3,
                                                        l4,
                                                        l5)
safeFourHeadTail _ = Nothing
safeFiveHeadTail :: [a] -> Maybe (a, a, a, a, a, [a])
safeFiveHeadTail (l1 : (l2 : (l3 : (l4 : (l5 : l6))))) = Just (l1,
                                                               l2,
                                                               l3,
                                                               l4,
                                                               l5,
                                                               l6)
safeFiveHeadTail _ = Nothing
singleLine :: [ByteString] -> Maybe ByteString
singleLine [l] = Just l
singleLine _ = Nothing
class PrettyPutStrLn a
    where prettyPutStrLn :: a -> IO ()
          prettyPutStrLn a = prettyPutStr a >> putStrLn ""
          prettyPutStr :: a -> IO ()
instance PrettyPutStrLn Int
    where prettyPutStr = putStr . show
instance PrettyPutStrLn Integer
    where prettyPutStr = putStr . show
instance PrettyPutStrLn ([Char])
    where prettyPutStr = putStr
instance PrettyPutStrLn ([[Char]])
    where prettyPutStr a = mapM_ putStrLn (init a) >> putStr (last a)
instance PrettyPutStrLn Double
    where prettyPutStr d = putStrLn $ Numeric.showFFloat (Just 6) d ""
instance PrettyPutStrLn a => PrettyPutStrLn (a, a)
    where prettyPutStr (a,
                        b) = (prettyPutStr a >> putStrLn " ") >> prettyPutStr b
type ProblemInputOutputParser a = [ByteString] ->
                                  Maybe (a, [ByteString])
data Point = Point Double Double deriving (Eq, Ord)
instance Show Point
    where show (Point x y) = show (x, y)
data PointLiesInside = LiesInside | LiesOutside deriving Eq
liesInsideToBool :: PointLiesInside -> Bool
liesInsideToBool (LiesInside) = True
liesInsideToBool (LiesOutside) = False
data Line2D = Line2D Point Point deriving (Ord, Show)
data Slope = InfiniteSlope | FiniteSlope Double deriving Show
slopeOfLine :: Line2D -> Slope
slopeOfLine (Line2D (Point x0 y0)
                    (Point x1 y1)) | x0 == x1 = InfiniteSlope
                                   | otherwise = FiniteSlope $ ((y1 - y0) / (x1 - x0))
instance Eq Line2D
    where (==) l1 (Line2D p1 p2) = isInLine p1 l1 && isInLine p2 l1
data LinePointTest
    = AboveOrLeft | BelowOrRight | InLine
    deriving Eq
mkLineFromTwoPoints :: Point -> Point -> Line2D
mkLineFromTwoPoints p1 p2 | p1 == p2 = error $ ("p1 == p2: p1 = " <> (show p1 <> (" p2 = " <> show p2)))
                          | p1 < p2 = Line2D p1 p2
                          | otherwise = Line2D p2 p1
mkLineWithSlopeAndPoint :: Double -> Point -> Line2D
mkLineWithSlopeAndPoint slope (Point x
                                     y) = Line2D (Point x y) (Point (0 / 1) (y - (slope * x)))
offsetOfLine :: Line2D -> Double
offsetOfLine (l@(Line2D (Point x0 y0) _)) = y0 - (slope * x0)
                 where slope = case slopeOfLine l of
                                   InfiniteSlope -> error "offsetOfLine: InfiniteSlope"
                                   FiniteSlope s -> s
pointsInSameLine :: Point -> Point -> Point -> Bool
pointsInSameLine (Point x1 y1) (Point x2 y2) (Point x3
                                                    y3) = ((y3 - y1) * (x2 - x1)) == ((x3 - x1) * (y2 - y1))
hasHigherX :: Point -> Point -> Bool
hasHigherX (Point x1 _) (Point x2 _) = x1 > x2
hasHigherY :: Point -> Point -> Bool
hasHigherY (Point _ y1) (Point _ y2) = y1 > y2
isPointAboveLine :: Point -> Line2D -> LinePointTest
isPointAboveLine (Point x3 y3) (Line2D (Point x1 y1)
                                       (Point x2 y2)) = if l == 0
                                                         then InLine
                                                         else if l > 0
                                                               then AboveOrLeft
                                                               else BelowOrRight
                     where l = ((y3 - y1) * (x2 - x1)) - ((x3 - x1) * (y2 - y1))
isInLine :: Point -> Line2D -> Bool
isInLine p = (== InLine) . isPointAboveLine p
linesIntersect :: Line2D -> Line2D -> Bool
linesIntersect (l1@(Line2D (Point x1 _) _)) (l2@(Line2D (Point x2
                                                               _)
                                                        _)) = case (slopeOfLine l1,
                                                                    slopeOfLine l2) of
                                                                  (InfiniteSlope,
                                                                   InfiniteSlope) -> x1 == x2
                                                                  (InfiniteSlope,
                                                                   FiniteSlope _) -> True
                                                                  (FiniteSlope _,
                                                                   InfiniteSlope) -> True
                                                                  (FiniteSlope slope1,
                                                                   FiniteSlope slope2) -> slope1 /= slope2
class Show a => PolygonShape a
    where isInside :: a -> Point -> PointLiesInside
          isInside polygon point = if and $ (fmap f $ linesOfWithComparisons polygon)
                                    then LiesInside
                                    else LiesOutside
                       where f (lineEq,
                                lineComps) = isPointAboveLine point lineEq `elem` lineComps
          shapeIntersectsAnother :: PolygonShape b => a -> b -> Bool
          shapeIntersectsAnother shapeA shapeB = f shapeA pointsB || f shapeB pointsA
                                     where pointsA = shapeCenter shapeA <| shapeCorners shapeA
                                           pointsB = shapeCenter shapeB <| shapeCorners shapeB
                                           f shape = any ((== LiesInside) . isInside shape)
          linesOfWithComparisons :: a -> NonEmpty (Line2D, [LinePointTest])
          shapeCorners :: a -> NonEmpty Point
          shapeCenter :: a -> Point
data Rectangle
    = Rectangle Point Point Point Point
    deriving (Eq, Show)
mkRectangle :: Point -> Point -> Point -> Point -> Maybe Rectangle
mkRectangle p1 p2 p3 p4 = do {Control.Monad.guard $ ((p1 /= p2) && ((p1 /= p3) && (p1 /= p4)));
                              Control.Monad.guard $ ((p2 /= p3) && (p2 /= p4));
                              Control.Monad.guard $ (p3 /= p4);
                              return $ Rectangle pymin pxmin pymax pxmax}
                where points = [p2, p3, p4]
                      pymin = foldl (\(acc@(Point accx accy)) (p@(Point x
                                                                        y)) -> if y < accy
                                                                                then p
                                                                                else if y > accy
                                                                                then acc
                                                                                else if x > accx
                                                                                then p
                                                                                else acc) p1 points
                      pxmin = foldl (\(acc@(Point accx accy)) (p@(Point x
                                                                        y)) -> if x < accx
                                                                                then p
                                                                                else if x > accx
                                                                                then acc
                                                                                else if y < accy
                                                                                then p
                                                                                else acc) p1 points
                      pymax = foldl (\(acc@(Point accx accy)) (p@(Point x
                                                                        y)) -> if y > accy
                                                                                then p
                                                                                else if y < accy
                                                                                then acc
                                                                                else if x < accx
                                                                                then p
                                                                                else acc) p1 points
                      pxmax = foldl (\(acc@(Point accx accy)) (p@(Point x
                                                                        y)) -> if x > accx
                                                                                then p
                                                                                else if x < accx
                                                                                then acc
                                                                                else if y > accy
                                                                                then p
                                                                                else acc) p1 points
isInsideRect :: Rectangle -> Point -> PointLiesInside
isInsideRect = isInside
instance PolygonShape Rectangle
    where linesOfWithComparisons (Rectangle p1
                                            p2
                                            p3
                                            p4) = Data.List.NonEmpty.fromList [(mk p1 p2,
                                                                                [AboveOrLeft,
                                                                                InLine]),
                                                                               (mk p2 p3,
                                                                                [BelowOrRight,
                                                                                InLine]),
                                                                               (mk p3 p4,
                                                                                [BelowOrRight,
                                                                                InLine]),
                                                                               (mk p4 p1,
                                                                                [AboveOrLeft,
                                                                                InLine])]
                                     where mk = mkLineFromTwoPoints
          shapeCorners (Rectangle p1
                                  p2
                                  p3
                                  p4) = Data.List.NonEmpty.fromList [p1, p2, p3, p4]
          shapeCenter (Rectangle _
                                 (Point x1 y1)
                                 _
                                 (Point x2
                                        y2)) = Point (x1 + ((x2 - x1) / 2)) (y1 + ((y2 - y1) / 2))
data Triangle = Triangle Point Point Point deriving (Eq, Show)
mkTriangle :: Point -> Point -> Point -> Maybe Triangle
mkTriangle p1 p2 p3 = do {Control.Monad.guard $ ((p1 /= p2) && ((p1 /= p3) && (p2 /= p3)));
                          return $ Triangle p1 p2 p3}
instance PolygonShape Triangle
    where linesOfWithComparisons (Triangle p1
                                           p2
                                           p3) = Data.List.NonEmpty.fromList [(mk p1 p2, []),
                                                                              (mk p2 p3, []),
                                                                              (mk p3 p1, [])]
                                     where mk = mkLineFromTwoPoints
          shapeCorners (Triangle p1 p2 p3) = Data.List.NonEmpty.fromList [p1,
                                                                          p2,
                                                                          p3]
          shapeCenter _ = error "SHAPECENTER OF TRIANGLE NOT IMPLEMENTED YET"
hasHorizontalLineAbove :: Triangle -> Maybe Line2D
hasHorizontalLineAbove (triangle@(Triangle p1
                                           p2
                                           p3)) = case Data.Maybe.mapMaybe horizontalLine triangleLines of
                                                      [l] -> case Prelude.filter (BelowOrRight ==) $ map (flip isPointAboveLine l) trianglePoints of
                                                                 [_] -> Just l
                                                                 [] -> Nothing
                                                                 _ -> error "INVALID CASE MORE THAN ONE BELOW VS ABOVE TEST hasHorizontalLineAbove"
                                                      [] -> Nothing
                                                      _ -> error "INVALID CASE MORE THAN ONE HORIZONTAL LINE hasHorizontalLineAbove"
                           where trianglePoints = [p1, p2, p3]
                                 triangleLines = map fst $ (Data.List.NonEmpty.toList $ linesOfWithComparisons triangle)
                                 horizontalLine (l@(Line2D (Point _ y1)
                                                           (Point _ y2))) | y1 == y2 = Just l
                                                                          | otherwise = Nothing
distanceBetweenPoints :: Point -> Point -> Double
distanceBetweenPoints (Point x1 y1) (Point x2
                                           y2) = sqrt $ (((x1 - x2) ^ (2 :: Int)) + ((y1 - y2) ^ (2 :: Int)))
distanceBetweenPointsOfLine :: Line2D -> Double
distanceBetweenPointsOfLine (Line2D p1
                                    p2) = distanceBetweenPoints p1 p2
ifEvenOdd :: Int -> a -> a -> a
ifEvenOdd n a a' | (n `mod` 2) == 0 = a
                 | otherwise = a'
ifZero :: Int -> a -> a -> a
ifZero 0 a _ = a
ifZero _ _ a = a
sumOfIntsToN :: Int -> Int
sumOfIntsToN n = (n * (n - 1)) `div` 2
sumOfEvensToN :: Int -> Int
sumOfEvensToN n = n * (n + 1)
sumOfOddsToN :: Int -> Int
sumOfOddsToN n = n * n
countElemsThat :: (a -> Bool) -> [a] -> Int
countElemsThat f = length . Prelude.filter f
range :: Int -> Int -> [Int]
range a b = [a..b]
modError :: Integral a => a -> a -> a
modError a b | toInteger b == 0 = error "modError: division by zero"
             | otherwise = a `mod` b
mod10To9Plus7 :: Integral a => a -> a
mod10To9Plus7 = (`mod` 1000000007)
bigExponentiation :: Integer -> Int -> Integer
bigExponentiation = (^)
squares :: Set Int
squares = Data.Set.fromList $ map (\i -> i ^ (2 :: Int)) [1..1000000000]
shiftLError :: Int -> Int -> Int
shiftLError i j | j < 0 = error "shiftLError: negative shift"
                | otherwise = Data.Bits.shiftL i j
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
parseTwoInts :: ProblemInputOutputParser (Int, Int)
parseTwoInts ws = safeTwoHeadTail ws >>= (\(nBs,
                                            mBs,
                                            remainingTkns) -> do {(n,
                                                                   _) <- Data.ByteString.Char8.readInt nBs;
                                                                  (m,
                                                                   _) <- Data.ByteString.Char8.readInt mBs;
                                                                  return ((n, m), remainingTkns)})
unpackParser f (x1, x2) = f x1 x2
parser = parseTwoInts
solve :: Int -> Int -> Integer
solve = \a b -> mod10To9Plus7 (bigExponentiation (toInteger a) b)
applyFunctionWithParserUntilExhausted solver parser = go
                                          where go ([]) = return ()
                                                go inputBs = do case parser inputBs of
                                                                    Nothing -> error "UNEXPECTED ERROR WHILE PARSING"
                                                                    Just (result,
                                                                          remainingTkns) -> do {prettyPutStrLn $ solver result;
                                                                                go remainingTkns}
main :: IO ()
main = Data.ByteString.getContents >>= (applyFunctionWithParserUntilExhausted (unpackParser solve) parser . (tail . Data.ByteString.Char8.words))


module Main where

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

maxDigitSum = 9 * 10

digitSum :: Int -> Int
digitSum 0 = 0
digitSum n = m + digitSum d
    where (d, m) = n `divMod` 10

solve :: Int -> [Int]
solve n = sortUnique [x | sum <- [1 .. maxDigitSum]
                     , sum < n
                     , let x = n - sum
                     , x + digitSum x == n]

sortUnique :: Ord a => [a] -> [a]
sortUnique = map head . group . sort

main :: IO ()
main = do
  n <- read <$> getLine
  let xs = solve n
  print $ length xs
  mapM_ print xs


main :: IO()
main = print . solve (initValids [1] [] 0) . map read . words =<< getLine

initValids :: [Integer] -> [Integer] -> Int -> [Integer]
initValids ones zeros 64 = []
initValids ones zeros i  = zeros ++ initValids (map (\x -> x * 2 + 1) ones)
                                    ((map (\x -> x * 2) ones) ++ (map (\x -> x * 2 + 1) zeros))
                                    (i + 1)

solve :: [Integer] -> [Integer] -> Int
solve [] _ = 0
solve (v:vs) [a, b] | a <= v && v <= b = 1 + solve vs [a, b]
                    | otherwise = solve vs [a, b]


import Data.Char

h :: Int -> Int -> String -> String

h 0 _ s = s
h _ 0 s = s
h x y "Malvika"  = h (x-1) (y-1)  "Akshat"
h x y "Akshat"  = h (x-1) (y-1) "Malvika"

main = do
 line <- getLine
 let a = (read (takeWhile (/= ' ') line) :: Int)
 let b = (read (drop 1 (dropWhile (/= ' ') line)) :: Int)
 putStrLn (h a b "Malvika" )


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

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

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

main = do
  n <- readLn
  xs <- getInts

  let
    x = xs !! (length xs - 2)
    y = last xs

  putStrLn $
    if n == 1
      then
        case xs of
          [15] -> "DOWN"
          [0] -> "UP"
          otherwise -> show (-1)
      else
        if x < y
           then if y == 15 then "DOWN" else "UP"
           else if y == 0 then "UP" else "DOWN"


import Data.List

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

solve [a, b, c] = maybe (-1) (+1) $ findIndex (== c) (longdiv a b)

longdiv a b = go [] (a `rem` b) b
  where
  go seen a b
    | r `elem` seen = [r | r == 0]
    | otherwise = q:go (r:seen) r b
    where (q, r) = (if a < b then a * 10 else a) `quotRem` b


import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe

main = do
	[a,b,c]<- map (fst.fromJust.C.readInt).C.words <$> C.getLine ::IO [Int]
	let d = div c a
	let e = length $ take 1 [1| e<-[d,d-1..0],mod (c-e*a) b==0]
	putStrLn $ if e==1 then "Yes" else "No"


-- http://codeforces.com/contest/818/problem/B

-- enable C pre-processor
{-# LANGUAGE CPP #-}

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

#ifdef DEBUG
import Debug.Trace
#endif

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

main = do
    [n,m] <- getInts
    leaders <- getInts
    case solve leaders n m of
        Nothing -> print (-1)
        Just answer -> forM_ answer (\i -> putStr (show i) >> putChar ' ')

solve :: [Int] -> Int -> Int -> Maybe [Int]
solve leaders n m =
#ifdef DEBUG
    if feasible (trace (show (elems $ getSteps leaders n)) (getSteps leaders n))
#else
    if feasible (getSteps leaders n)
#endif
    then Just $ restore (getSteps leaders n) n
    else Nothing

getSteps :: [Int] -> Int -> Array Int Int
getSteps leaders n = accumArray f (-1) (1,n) [(l,s) | (l,l') <- zip leaders (tail leaders), let d = l' - l, let s = if d <= 0 then d + n else d] where
    f prev curr
        | prev == -1 || prev == curr = curr
        | otherwise = -2

feasible :: Array Int Int -> Bool
feasible cand = allUnique && noDup where
    es = (filter (/= -1) . elems) cand
    allUnique = all (/= (-2)) es
    noDup = nub es == es -- O(n^2)

restore :: Array Int Int -> Int -> [Int]
restore ary n = merge ([1..n] \\ es) es where
    es = elems ary
    merge [] answer = answer
    merge xss@(x:xs) (y:ys)
        | y == -1 = x : merge xs ys
        | otherwise = y : merge xss ys


import Control.Applicative( (<$>))

main = do
    [xa_, ya_, xb_, yb_, xc_, yc_] <- map (read::String->Integer) .
						words <$> getLine
    let
	distanceEq =
	    (xb_-xa_)^2 + (yb_-ya_)^2 == (xc_-xb_)^2 + (yc_-yb_)^2

    putStr $ if distanceEq
		then let
			deltaX = xc_-xa_
			deltaY = yc_-ya_
		    in if
			xa_+(deltaX`quot`2) == xb_ &&
			ya_+(deltaY`quot`2) == yb_
			then "No"
			else "Yes"
		else "No"


import Control.Monad (liftM)
import Data.Array ((!), accumArray)
import Data.Char (isAlpha)
import Prelude hiding (reads)

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

seqPlus :: Num a => a -> a -> a
seqPlus x y  =  seq z z
  where
    z  =  x + y

solve :: String -> Integer
solve s  =  solve' n m 10 - case (isAlpha $ head s, head s) of
    (True, _)  ->  solve' n (m - 1) 9
    (False, '?')  ->  solve' (n - 1) m 10
    _  ->  0
  where
    d  =  accumArray seqPlus 0 ('0', 'J') $ zip s $ repeat 1
    n  =  d ! '?'
    m  =  fromIntegral $ length $ filter (> 0) $ map (d !) ['A'..'J']
    solve' n m k  =  10^n * product [k - m + 1 .. k]

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


import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

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

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

solve :: String -> [Int]
solve = map length . filter ((== 'B') . head) . group

main :: IO ()
main = do
    n <- readInt <$> getLine
    line <- (head . words) <$> getLine
    let answer = solve line
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "
    printf "\n"


import Data.List

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

keyboard :: String
keyboard = "qwertyuiopasdfghjkl;zxcvbnm,./"

removeMaybe :: Maybe a -> a
removeMaybe (Just a) = a

solve :: [String] -> String
solve (d:s:_) = if d == "R" then (solve' (-1) s) else (solve' 1 s)

solve' :: Int -> String -> String
solve' d "" = ""
solve' d (c:s) = (keyboard !! ((removeMaybe (elemIndex c keyboard)) + d)) : (solve' d s)


main = do
  s <- getLine
  let ns = words s
      n = read (ns !! 0) :: Integer
      c1 = read (ns !! 1) :: Integer
      c2 = read (ns !! 2) :: Integer

  s <- getLine
  let adults = (toInteger . length . filter (\t -> t == '1')) s
      total = (toInteger . length) s

  let cost x = c1 + c2 * (x - 1) ^ 2

  let f ngroups = let mingroup = (total `div` ngroups) :: Integer
                      cntmax   = (total `mod` ngroups) :: Integer
                  in (ngroups - cntmax) * (cost mingroup) + cntmax * (cost (mingroup + 1))

  putStrLn (show $ (foldl1 min) $ map f [1..adults])


import Data.List
import Data.Array

lst x
	|div x 10>0 = lst (mod x 10)
	|otherwise = x

drop10 n
	|mod n 10 == 0 =drop10 (div n 10)
	|otherwise = n

calcZ n c
	|mod n 10 ==0 = calcZ (div n 10) (c+1)
	|otherwise=c

getBig x y
	|calcZ x 0>=y = x
	|l==0 = x*(10^(y-(calcZ x 0)))
	|l==2 = x*5*(10^(y-1))
	|l==4 = x*5*(10^(y-1))
	|l==5 = x*2*(10^(y-1))
	|l==6 = x*5*(10^(y-1))
	|l==8 = x*5*(10^(y-1))
	|otherwise = x*(10^y)
	where
		l=lst x

solve x y = div g k--(g,d,k,div g k)
	where
		g=getBig x y
		d=div g x
		k=gcd d (drop10 g)

main=do
	[x,y]<-fmap words getLine
	print (solve (read x::Integer)  (read y::Integer))


import Data.List

countDigs :: Int -> Int
countDigs 0 = 0
countDigs n = countDigs (n `div` 7) + 1

getValue :: [Int] -> Int
getValue [] = 0
getValue (x:xs) = (getValue xs) * 7 + x

doesFit :: [Int] -> Int -> Int -> Int -> Bool
doesFit xs n m digsN = (getValue . reverse $ tn) < n && (getValue . reverse $ tm) < m
                            where tn = take digsN xs
                                  tm = drop digsN xs

getDist :: Int -> Int -> Int
getDist n m | digsM + digsN > 7 = 0
            | otherwise = sum [ 1 | xs <- nub . map (take $ digsN + digsM) . permutations $ [0..6], doesFit xs n m digsN]
            where digsM | m == 1 = 1
                        | otherwise = countDigs (m - 1)
                  digsN | n == 1 = 1
                        | otherwise = countDigs (n - 1)

main :: IO ()
main = do
        inpStr <- getLine
        let (n:m:[]) = map (read::String->Int) $ words inpStr
        putStrLn . show $ getDist n m


{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified Data.Ratio as Rat

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

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

sol 1 _ h v = v == 0
sol _ 1 h v = h == 0
sol n m h v
  | even n && even m = even h
  | even m = h >= div m 2 && (even $ h - (div m 2))
  | otherwise = v >= div n 2 && (even $ v - (div n 2))

solve :: IO ()
solve = do
  [n,m,h] <- readInts :: IO [Int]
  let v = (div (n*m) 2) - h
    in putStrLn $ if sol n m h v then "YES" else "NO"

main = do
  t <- readLn :: IO Int
  replicateM_ t $ solve

----------------------------------------------------------------------------------------
readrows :: (Integral b) => b -> IO [String]
readrows 0 = return []
readrows n = do
  row <- getLine
  l <- readrows $ n-1
  return (row : l)

readintrows :: (Integral a, Integral b) => b -> IO [[a]]
readintrows 0 = return []
readintrows n = do
  row <- readInts
  l <- readintrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs


import Control.Arrow ((***))
import Control.Monad (forM_, when)
import Control.Monad.ST (ST)
import Data.Array.ST (STUArray, runSTUArray, newArray, readArray, writeArray)
import Data.Array.Unboxed (UArray, assocs)
import Data.Int (Int64)

isqrt :: (Integral a, Integral b) => a -> b
isqrt = floor . sqrt . fromIntegral

threshold :: Integral a => a
threshold = fromIntegral threshold'
threshold' :: Int
threshold' = 1000000

primeList :: Integral a => [a]
primeList = map fromIntegral $ primeList'
primeList' :: [Int]
primeList' = primesToN threshold

-- primesToN
sieveToN :: Int -> UArray Int Bool
sieveToN n = runSTUArray sieve
  where
    sieve = do
      a <- newArray (2, n) True :: ST s (STUArray s Int Bool)
      forM_ [4, 6 .. n] $ \j ->
        writeArray a j False
      forM_ [3, 5 .. isqrt n] $ \i -> do
        ai <- readArray a i
        when ai $
          forM_ [i * i, i * (i + 2) .. n] $ \j ->
            writeArray a j False
      return a

primesToN :: (Integral a, Integral b) => a -> [b]
primesToN n = map (fromIntegral . fst) $ filter snd $ assocs $ sieveToN n'
  where
    n' = fromIntegral n

sieveFromMToN :: Int64 -> Int64 -> UArray Int64 Bool
sieveFromMToN m n = runSTUArray sieve
  where
    n' = isqrt n
    primes = if n' > threshold then primesToN n' else takeWhile (<=n') primeList
    sieve = do
      a <- newArray (m, n) True :: ST s (STUArray s Int64 Bool)
      forM_ primes $ \i -> do
        let s = max i $ div (m + i - 1) i
        when (i * s <= n) $
          forM_ [i * s, i * (s + 1) .. n] $ \j ->
            writeArray a j False
      return a

primesFromMToN :: (Integral a, Integral b) => a -> a -> [b]
primesFromMToN m n
  | m' <= n'  = map (fromIntegral . fst) $ filter snd $ assocs $ sieveFromMToN m' n'
  | otherwise = []
  where
    m' = fromIntegral $ max 2 m
    n' = fromIntegral n

gao a b c = if null ls then -1 else minimum $ zipWith max ls [b - a + 1, b - a ..]
  where
    primeList = primesFromMToN a b
    go [] _ = []
    go _ [] = []
    go x@(h:t) y@((p,q):r)
      | p < h     = go x r
      | otherwise = (h,q): go t y
    ls = scanl1 max [e - i + 1 | (i, e) <- go [a .. b] $ zip primeList $ drop (c-1) primeList]

main = do
  [a, b, c] <- fmap (map read . words) getLine
  print $ gao a b c


import Control.Applicative
import Data.List

main = do
  [r, g, b] <- reverse . sort . map read . words <$> getLine
  if (g + b) * 2 >= r
    then print (div (r + g + b) 3)
    else print (g + b)


import Data.Char (digitToInt, intToDigit)

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

solve :: String -> String
solve ('9':cs) = '9' : solve' cs
solve cs = solve' cs

solve' :: String -> String
solve' cs = [ if c < '5' then c else intToDigit (9 - digitToInt c) | c <- cs ]


calc :: Int -> Int -> (Int, Int, Int, Int)
calc x y
	| x > 0 && y > 0 = (0, l, l, 0)
	| x > 0 && y < 0 = (0, -l, l, 0)
	| x < 0 && y > 0 = (-l, 0, 0, l)
	| x < 0 && y < 0 = (-l, 0, 0, -l)
	| otherwise      = (0, 0, 0, 0)
	where
		l = abs x + abs y

handle :: [String] -> [[String]]
handle [sx, sy] = [map show [x1, y1, x2, y2]]
	where
		(x1, y1, x2, y2) = calc (read sx) (read sy)

main :: IO ()
main = interact $ unlines . map unwords . handle . words


answer::Integer -> Integer -> Integer -> Int
answer t s q = length (takeWhile (it0 q t s) (iterate (it q s) (0::Integer) ))
it::Integer -> Integer -> Integer -> Integer
it q s x = q*(s+x)
it0::Integer -> Integer -> Integer -> Integer->Bool
it0 q t s x = q*(t-s)>x*(pred q)
main = do
  w <- getLine
  let ww = words w
  let t = read (ww !! 0)::Integer
  let s = read (ww !! 1)::Integer
  let q = read (ww !! 2)::Integer
  print $ answer t s q


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

a -% b = (a - b) `mod` 1000000007

a *% b = (a * b) `mod` 1000000007

a ^% e
  | e == 0 = 1
  | odd e = p *% p *% a
  | otherwise = p *% p
  where
    p = a ^% (e `div` 2)

main = do
  n <- read <$> getLine
  print $ foldr (*%) 1 [1 .. n] -% (2 ^% (n - 1)) -- foldr (*%) 1 (replicate (n - 1) 2)


main = do
    n <- getLine
    print $ 2 ^ ((read n) + 1) - 2


module Main where

double :: Integer -> Double
double a = fromIntegral a :: Double

main :: IO ()
main = do
    line <- getLine
    let [r, x, y, x', y'] = map (\c -> read c :: Integer) (words line)
    let result = d / (double (2*r)) where
        d = sqrt $ double $ (x - x')^2 + (y - y')^2
    print (ceiling result)


import Control.Applicative

main :: IO ()
main = do
    input <- zip [0..] . map (read :: String -> Int) . words <$> getLine
    let triangle = [(a_val, b_val) |
          (a_ind, a_val) <- input,
          (b_ind, b_val) <- input,
          (c_ind, c_val) <- input,
          b_ind /= a_ind && a_ind /= c_ind && b_ind /= c_ind,
          c_val >= b_val && c_val >= a_val,
          a_val + b_val > c_val
          ]
        segment = [(a_val, b_val) | (a_ind, a_val) <- input,
          (b_ind, b_val) <- input,
          (c_ind, c_val) <- input,
          b_ind /= a_ind && a_ind /= c_ind, b_ind /= c_ind,
          (c_val >= b_val && c_val >= a_val && a_val + b_val == c_val) ]
    if not (null triangle)
        then putStrLn "TRIANGLE"
        else
            if not (null segment)
                then putStrLn "SEGMENT"
                else putStrLn "IMPOSSIBLE"


import Data.List (scanl)

main :: IO ()
main = do
  a:b:_ <- fmap (map read . words) getLine
  s <- getLine
  putStrLn  $ if rush (a,b) s then "Yes" else "No"

rush :: (Integer, Integer) -> String -> Bool
rush (a,b) s = let loop = scanl travel (0,0) s
                   travel (x,y) 'U' = (x,y+1)
                   travel (x,y) 'D' = (x,y-1)
                   travel (x,y) 'L' = (x-1, y)
                   travel (x,y) _ = (x+1, y)
                   (dx, dy) = last loop
                   check (x,y)
                     | dx /= 0 && dy /= 0 = let x' = a - x
                                                y' = b - y
                                                c1 = (x' `mod` dx == 0) && (y' `mod` dy == 0)
                                                c2 = (x' `div` dx == y' `div` dy) && (x'`div`dx >= 0)
                                            in c1 && c2
                     | dx == 0 && dy /= 0 = (x == a) && ((b - y) `mod` dy == 0) && ((b - y) `div` dy >= 0)
                     | dy == 0 && dx /= 0 = (y == b) && ((a - x) `mod` dx == 0) && ((a - x) `div` dx >= 0)
                     | otherwise = (y == b) && (x == a)

                in
                   any check loop


main :: IO()
main =  do
        l <- getLine
        putStrLn . output . solve . input $ l

input :: String -> Int
input = read

solve :: Int -> Int
solve n = (n `div` z n + 1) * z n - n
    where
        z x = if x `mod` 10 == x then 1 else 10 * z (x `div` 10)

output :: Int -> String
output = show


module Main (main) where

import Data.List (sum, group, sort, length, reverse)
import Data.Char (ord)

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

main :: IO ()
main = do
  ([n, k]) <- readInts
  letters <- getLine :: IO String
  let sorted1 = (map (+ 1) . map (\x -> x - (ord 'a')) . map ord . map head . group . sort) letters
  let (result1, _) = foldl (\(acc, prev) weight ->
                              if (prev + 1 < weight)
                              then (weight:acc, weight)
                              else (acc, prev)
                           )
                     ([], -1)
                     sorted1
  let resultd = reverse result1
  if ((length resultd) >= k)
  then print $ sum . take k $ resultd
  else print $ -1


import Char (digitToInt, ord)

solve :: [String] -> Int
solve [a, b]
  | k^n > s  =  n
  | otherwise  =  n + 1
  where
    n  =  max (length a) (length b)
    k  =  maximum (map digitToInt (a ++ b)) + 1
    s  =  from k a + from k b
    from k s  =  from' 0 s
      where
        from' acc []  =  acc
        from' acc (c:s)  =  from' (k * acc + ord c - ord '0') s

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


main = do
  x@[a, b, c] <- fmap (map read . words) getLine
  print $ a * b + b * c + c * a - sum x + 1


main = do
  [a,c] <- fmap (map untrit . map read . words) getLine
  print $ trit $ untor a c
untrit n | q == 0 && r == 0 = []
         | otherwise = r : untrit q
    where (q,r) = n `divMod` 3
trit (n:ns) = n + 3 * trit ns
trit _ = 0
untor (a:as) (c:cs) = ((c-a) `mod` 3) : untor as cs
untor [] cs = cs
untor as [] = map ((`mod` 3) . negate) as


module Main where
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List

readInt = maybe undefined (fromIntegral . fst) . B.readInteger
readInts = fmap readInt . B.words

solve :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
solve x y l r = maximum $ (0:) $ (zipWith (\a b -> a - b - 1) =<< drop 1) $ (++ [r + 1]) $ (l - 1:) $ sort  [x^a + y^b | a <- [0..fk x], b <- [0..fk y], let n = x^a + y^b, l <= n && n <= r]
  where
    fk :: Int64 -> Int64
    fk k = floor $ logBase (fromIntegral k) (fromIntegral r)

main = do
  x:y:l:r:_ <- fmap readInts B.getLine
  print $ solve x y l r


import Data.Function
import Data.List
import Control.Arrow

main = putStrLn  =<< (\x -> let t = round(sqrt $ fromIntegral x) in  (show *** show >>> (\(x,y)->x++" "++y))  $  minimumBy (compare `on` uncurry subtract) $  map (\a -> (uncurry min &&& uncurry max) $ (x`div`a, a) )  $ filter (\a -> x`mod`a == 0) $ [t,t-1..1] ) <$> (readLn :: IO Int)


answer::Int -> String -> Int
answer n s | null s = 0
           | l == '4' = k + (answer (n+1) i)
           | l == '7' = 2*k + (answer (n+1) i)
             where i = init s
                   l = last s
                   k =  (iterate (*2) 1) !! n
main = getLine >>= print.(answer 0)


import Data.List (nub)

main = do
  getLine
  nums <- fmap (read :: String -> Int) <$> words <$> getLine

  let ans = reverse . nub $ reverse nums
  print $ length ans
  putStrLn . unwords . fmap show $ ans


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

genAllVariant :: [Int] -> [[Int]]
genAllVariant [] = [[]]
genAllVariant (x:xs) = if x == 0
                         then r
                         else ((x - 1) : (take len (repeat 9))) : r
  where
    len = length xs
    r   = map (x:) (genAllVariant xs)

getBestFromTwo :: [Int] -> [Int] -> [Int]
getBestFromTwo [] [] = []
getBestFromTwo a@(a0:as) b@(b0:bs)
  | (sum a) > (sum b) = a
  | (sum a) < (sum b) = b
  | a0 > b0           = a
  | a0 < b0           = b
  | otherwise         = a0 : getBestFromTwo as bs

delNull :: String -> String
delNull "0" = "0"
delNull (x:xs) = if x == '0'
                   then delNull xs
                   else x:xs

toString :: [Int] -> String
toString num = delNull $ map intToDigit num

solve :: [Int] -> [Int]
solve num = foldr getBestFromTwo num (genAllVariant num)

parseInput :: String -> [Int]
parseInput str = map digitToInt $ head $ words str

main :: IO ()
main = interact $ (toString . solve . parseInput)


module Main where

import Data.List
import Data.Char

transitions = [
 [1, 2, 3, 4, 5, 6],
 [1, 6, 3, 5, 2, 4],
 [1, 4, 3, 2, 6, 5],
 [1, 5, 3, 6, 4, 2],

 [2, 3, 4, 1, 5, 6],
 [2, 6, 4, 5, 3, 1],
 [2, 1, 4, 3, 6, 5],
 [2, 5, 4, 6, 1, 3],

 [3, 4, 1, 2, 5, 6],
 [3, 6, 1, 5, 4, 2],
 [3, 2, 1, 4, 6, 5],
 [3, 5, 1, 6, 2, 4],

 [4, 1, 2, 3, 5, 6],
 [4, 6, 2, 5, 1, 3],
 [4, 3, 2, 1, 6, 5],
 [4, 5, 2, 6, 3, 1],

 [5, 2, 6, 4, 3, 1],
 [5, 1, 6, 3, 2, 4],
 [5, 4, 6, 2, 1, 3],
 [5, 3, 6, 1, 4, 2],

 [6, 2, 5, 4, 1, 3],
 [6, 3, 5, 1, 2, 4],
 [6, 4, 5, 2, 3, 1],
 [6, 1, 5, 3, 4, 2]]

-- generatePermutations :: [a] -> [[a]]
-- generatePermutations (x:xs) =
--     let ret = generatePermutations xs in
--     foldl (\acc x -> insertNext ++ acc) []  ret
--         where insertNext item = scanl (\acc ys -> acc) [] item

rotatedlyEqual :: String -> String -> Bool
rotatedlyEqual src dest  = any (\tran -> dest == getColoring tran) transitions
    where getColoring orders = map (\n -> src!!(n-1)) orders

generateColorings :: String -> [String]
generateColorings clrs = map (getColoring ) $ permutations [1..length(clrs)]
    where getColoring orders = map (\n -> clrs!!(n-1)) orders

stringTrim :: String -> String
stringTrim = filter (not . isSpace)

main :: IO ()
main = interact (show . length . collectUniq [] . generateColorings . stringTrim )
    where
      collectUniq :: [String] -> [String] -> [String]
      collectUniq acc [] = acc
      collectUniq acc (clring:xs) = case (contains clring acc) of
                                  True -> collectUniq acc xs
                                  False -> collectUniq (clring:acc) xs
          where contains a ys = any (\x -> rotatedlyEqual a x) ys


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

import Data.Function (on)
import Data.List (maximumBy, intercalate)

run :: Int -> Int -> (Double, [Int])
run n x | gcd x y == 1 && x < y = (fromIntegral x / fromIntegral y, [x, y])
        | otherwise = (0.0, [0, n]) where y = n - x

main = do
    (read -> n :: Int) <- getLine
    putStrLn $ intercalate " " $ map show $ snd $ maximumBy (compare `on` fst) $ map (run n) [1..n]


main = do
    [n, t] <- fmap (map read . words) getLine
    a <- getLine

    let
        f [] = []
        f ('B':'G':s) = 'G':'B':(f s)
        f (a:s) = a:(f s)

    putStrLn $ iterate f a !! t


-- 88A
import Data.List
import Maybe
import Array
--import Char
akks = ["C","C#","D","D#","E","F","F#","G","G#","A","B","H"]
f a (x:xs) = if (a == x) then (xs ++ [x]) else f a (xs ++ [x])
long (x:xs) b | (x == b) = 1
              | otherwise = 1 + long xs b
what [a,b,c] | ((long p b == 4) && (long p c == 7)) = Just "major"
             | ((long p b == 3) && (long p c == 7)) = Just "minor"
             | otherwise = Nothing
	where p = f a akks
{-
permutations [] = [[]]
permutations xs  = [x:ps | x <- xs, ps <- permutations (xs\\[x])]
-}
toAkk [] l ak = (ak:l)
toAkk (' ':xs) l ak = toAkk xs (ak:l) ""
toAkk (x:xs) l ak = toAkk xs l (ak ++ [x])

analyse [] = "strange"
analyse (x:xs) | (x /= Nothing) = fromJust x
               | otherwise = analyse xs

main = do
			s <- getLine
			putStrLn $ analyse $ map (what) (permutations $ toAkk s [] [])


main :: IO()
main = do
    n <- readLn :: IO Int
    let s = truncate . sqrt . fromIntegral $ n*2 :: Int
    if s*(s+1) == 2*n then putStrLn "YES" else putStrLn "NO"


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

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

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

main = do
  [a, b, c] <- getInts

  let
    x = (b-c+a) `div` 2
    y = b-x
    z = a-x

  putStrLn $
    if even (b-c+a) && all (>= 0) [x, y, z]
     then unwords $ map show [x, y, z]
     else "Impossible"


{-# 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

type Array1 a = Array Int a
type Array2 a = Array (Int,Int) a
type UArray1 a = UArray Int a
type UArray2 a = UArray (Int,Int) a
type RecFun m a b = (a -> m b) -> a -> m b

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

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

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

instance Functor Identity where
    fmap f = runIdentity >>> f >>> Identity

instance Monad Identity where
    return = Identity
    x >>= f = f (runIdentity x)

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

class IArray UArray e => Unboxable e where
    newSTUArray_ :: forall s i. Ix i => (i, i) -> ST s (STUArray s i e)
    readSTUArray :: forall s i. Ix i => STUArray s i e -> i -> ST s e
    writeSTUArray :: forall s i. Ix i => STUArray s i e -> i -> e -> ST s ()

instance Unboxable Int where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

instance Unboxable Char where
    newSTUArray_ = newArray_
    readSTUArray = readArray
    writeSTUArray = writeArray

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

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

fibs = 1:1:zipWith (+) fibs (tail fibs)

primeArray :: Int -> UArray1 Bool
primeArray n = runSTUArray $ do
    arr <- newArray (0,n) True
    writeArray arr 0 False
    writeArray arr 1 False
    forM_ (2:[3,5..n]) $ \i -> do
        b <- readArray arr i
        when b $ forM_ [2*i,3*i..n] $ \j -> writeArray arr j False
    return arr

binSearch f a b = go a b
    where
    go i j | i + 1 == j = i
           | f m        = go m j
           | otherwise  = go i m
        where m = div (i+j) 2

fixMemoArray :: (Ix a) => (a,a) -> RecFun Identity a b -> Array a b
fixMemoArray b f = arr
    where
    g y = Identity $ arr ! y
    arr = listArray b [ runIdentity $ f g x | x <- range b ]

fixMemoUArray :: (Ix a,Unboxable b) => (a,a) -> (forall s . RecFun (ST s) a b) -> UArray a b
fixMemoUArray b f = runSTUArray $ do
    arr <- newSTUArray_ b
    forM_ (range b) $ \x -> f (\y -> readSTUArray arr y) x >>= writeSTUArray arr x
    return arr

casti = fromIntegral

modulo = 10^9 + 7

newtype Modulo = Modulo { getInteger :: Integer } deriving(Eq,Ord)
instance Num Modulo where
    Modulo a + Modulo b = Modulo ((a+b) `mod` modulo)
    Modulo a - Modulo b = Modulo ((a-b) `mod` modulo)
    Modulo a * Modulo b = Modulo ((a*b) `mod` modulo)
    abs (Modulo a) = Modulo (abs a)
    signum (Modulo a) = Modulo (signum a)
    fromInteger i = Modulo i
instance Fractional Modulo where
    recip m = m ^ (modulo - 2)
    fromRational = undefined

instance Show Modulo where
    show (Modulo i) = show i

solve :: Int -> Int -> Int -> Modulo
solve n 0 0 | odd  n = 1
solve n 0 1 | even n = 1
solve n 0 _ = 0
solve n m 0 = sum ([ f (n-k) (m-1) | k <- [0..n], even k]++[ g (n-k) (m-1) | k <- [0..n], odd  k])
solve n m 1 = sum ([ f (n-k) (m-1) | k <- [0..n], odd  k]++[ g (n-k) (m-1) | k <- [0..n], even k])

f :: Int -> Int -> Modulo
f 0 0 = 0
f i j = comb (i+j) j
g :: Int ->  Int -> Modulo
g 0 0 = 1
g _ _ = 0
comb n k = fact n * recip ( fact k * fact (n-k))

fact n = factMemo ! n
factMemo = fixMemoArray (0,200000) $ \ f i -> case i of
    0 -> pure 1
    n -> (casti n*) <$> f (n-1)

main = do
    [n,m,g] <- readsLine
    print $ solve n m g


import Data.List
import Data.Maybe

solve s | isPrefixOf "dot" s = "dot"++ (repl $ fromJust $ stripPrefix "dot" s)
        | isPrefixOf "at" s = "at"++ (repl $ fromJust $ stripPrefix "at" s)
        | otherwise = repl s
repl [] = ""
repl s | s=="at" = "at"
       | s=="dot"="dot"
       | isPrefixOf "dot" s = "."++(repl $ fromJust $ stripPrefix "dot" s)
       | isPrefixOf "at" s = "@"++(repl $ fromJust $ stripPrefix "at" s)
       | otherwise = take 1 s ++ (repl $ tail s)

main = do
	s<-getLine
	let a =solve s
	let b = (takeWhile (/='@') a) ++ "@" ++ (unrepl (tail (dropWhile (/='@') a)))
	putStrLn $ b

unrepl [] = ""
unrepl (s:ss) | s=='@' = "at"++ (unrepl ss)
              | otherwise = [s]++ (unrepl ss)


main=readLn>>=putStr.(presidents!!).pred
presidents = words "Washington  Adams Jefferson Madison Monroe Adams Jackson"
           ++ ["Van Buren"]
           ++ words "Harrison Tyler Polk  Taylor  Fillmore  Pierce  Buchanan  Lincoln Johnson  Grant  Hayes  Garfield  Arthur  Cleveland Harrison  Cleveland  McKinley  Roosevelt Taft  Wilson  Harding  Coolidge  Hoover  Roosevelt  Truman  Eisenhower  Kennedy Johnson Nixon Ford Carter Reagan"


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

kbonacci k s = if k < 100
               then 0 : (id $ klittle s (1 : (take (fromIntegral (k - 1)) . repeat $ 0)))
               else 0 : (id $ klarge s 1)
    where klittle s lst = let
            next = sum . take (fromIntegral k) $ lst
            in if s < next then []
               else next : klittle s (next : lst)
          klarge s n = if s < n then []
                       else n : klarge s (n + n)

solve n [] = []
solve n (x:xs) = if n >= x then x : solve (n - x) xs
                 else solve n xs

main = do
  [s, k] <- map read <$> (words <$> getLine) :: IO [Integer]
  let kb = kbonacci k s
      as = solve s $ reverse kb
  print $ length as
  forM_ as $ putStr . ((++ " ") . show)
  putStrLn ""


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

getIntList = fmap read . words <$> getLine

putIntList = putStrLn . unwords . fmap show

main = sol <$> getIntList >>= putIntList

sol [n,k] = if k <= length fs then product qs:ps else [-1]
    where
    fs = primeFactors n
    (ps,qs) = splitAt (k-1) fs

-- | Prime numbers
primes :: Integral a => [a]
primes = 2 : filter ((==1) . length . primeFactors) [3,5..]

primeFactors :: Integral a => a -> [a]
primeFactors 1 = []
primeFactors n = factor n primes

factor :: Integral a => a -> [a] -> [a]
factor n (p:ps)
  | p*p > n        = [n]
  | n `mod` p == 0 = p : factor (n `div` p) (p:ps)
  | otherwise      = factor n ps


{-# LANGUAGE ScopedTypeVariables #-}
module Main where

main :: IO ()
main = do
    line <- getLine >> getLine
    let nums :: [Integer] = map read . words $ line
    --let nums = [0,1,0,0,0,1,0,0,0,0]
    putStrLn . show . solve $ nums

solve :: [Integer] -> Integer
solve xs = case foldl f [] xs of
    [] -> 0
    [_] -> 1
    xs -> product $ tail $ xs
    where
        f []      0 = []
        f (a:acc) 0 = (a+1) : acc
        f acc     1 = 1     : acc


import Data.Char
main = do getLine >>= putStr . (\i -> if i then "YES" else "NO") . or . zipWith (==) "AEIOUY" . repeat . toUpper . last . filter isAlpha
{-

-}


main = interact $ show . sol . map read . words

sol [x1, y1, x2, y2] = max difx dify
    where
    difx = abs $ x1-x2
    dify = abs $ y1-y2


import Data.Char

getInt :: IO Int
getInt = do
  line <- getLine
  return (read line :: Int)

toInt str = (read str :: Int)
toStr i = show(i)

removeZero digit = [ x | x <- digit, x /= '0' ]

main = do
  a <- getInt
  b <- getInt
  let c = a + b
  let strc = toStr c
  let ans1 = removeZero strc
  let stra = toStr a
  let strb = toStr b
  let removea = removeZero stra
  let removeb = removeZero strb
  let aa = toInt removea
  let bb = toInt removeb
  let cc = aa + bb
  let ans2 = toStr cc
  if ans1 == ans2
    then putStrLn "YES"
    else putStrLn "NO"


#!/usr/bin/env runghc
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c:cs) = (:solve cs)$ unwords . map show $ [r,b,k]
  where
    [r1,c1,r2,c2] = map read . words $ c
    r = a+b
      where
        a = if r1==r2 then 0 else 1
        b = if c1==c2 then 0 else 1
    b
      | odd (a+b) = 0
      | a==b = 1
      | otherwise = 2
      where
        a = abs (r1-r2)
        b = abs (c1-c2)
    k = max (abs (r1-r2)) (abs (c1-c2))


import Data.Int (Int64)

modVal :: Int64
modVal = 998244353

cv :: Int64 -> Int64
cv n = rem n modVal

pm :: Int64 -> Int64 -> Int64
--powMod
pm x' y' = go x' y' 1  where
  go _ 0 acc = acc
  go x y acc
    | even y     = go (cv (x*x)) (quot y 2) acc
    | otherwise  = go (cv (x*x)) (quot y 2) (cv (acc*x))

frac :: Int64 -> Int64 -> Int64
frac x y = cv (x * pm y (modVal - 2))

choose :: Int64 -> Int64 -> Int64
choose n k = go 0 1  where
  go ck acc
    | k == ck    = acc
    | otherwise  = go (ck+1) $ frac (cv (acc * (n-ck))) (ck+1)

solve :: (Int64, Int64) -> Int64
solve (n, k) = cv $ sum [choose (div n i - 1) (k - 1) | i <- [1 .. div n k]]

parse :: String -> [(Int64, Int64)]
parse inp = [(n, k) | [n, k] <- map (map read . words) $ lines inp]

main :: IO ()
main = interact (unlines . map (show . solve) . parse)


solve xs | s > 0 && s `mod` 5 == 0  = s `div` 5
         | otherwise                = -1
         where s = sum xs

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


import Data.List
import Data.Int
import Control.Applicative
import qualified Data.ByteString.Char8 as B

main = do
    (n:k:_) <- readInp <$> B.getLine
    putStrLn $ show $ solve n k
    where readInp = fmap readInt. B.words
          readInt = fromIntegral. maybe 0 fst. B.readInteger

solve :: Int64 -> Int64 -> Int64
solve n k = (getKth (fromIntegral k)). sort. addBig $ smalldivs
    where smalldivs = [x | x <- [1..isqrt n], rem n x == 0]
          isqrt = floor. sqrt. fromIntegral
          addBig = concatMap (\x -> nub [x, quot n x])
          getKth k lst = if (length lst < k) then -1 else lst !! (k-1)


import Control.Monad

score [] p0 p1 = (p0,p1)
score ((x,y):xys) p0 p1
  | x == 'r' && y == 'r' =  score xys p0 p1
  | x == 'r' && y == 'p' =  score xys p0 (p1+1)
  | x == 'r' && y == 's' =  score xys (p0+1) p1
  | x == 'p' && y == 'r' =  score xys (p0+1) p1
  | x == 'p' && y == 'p' =  score xys p0 p1
  | x == 'p' && y == 's' =  score xys p0 (p1+1)
  | x == 's' && y == 'r' =  score xys p0 (p1+1)
  | x == 's' && y == 'p' =  score xys (p0+1) p1
  | x == 's' && y == 's' =  score xys p0 p1

parse [] = []
parse (c:cs)
  | c == '[' = 'p':parse (drop 1 cs)
  | c == '(' = 'r':parse (drop 1 cs)
  | c == '8' = 's':parse (drop 1 cs)

main = do
  aa <- getLine
  bb <- getLine
  let xs = parse aa
  let ys = parse bb
  let (p0,p1) = score (zip xs ys) 0 0
  putStrLn $ case () of _
                         | p0 == p1 -> "TIE"
                         | p0 > p1 -> "TEAM 1 WINS"
                         | p0 < p1 -> "TEAM 2 WINS"


{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

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

unique :: Ord a => [a] -> [a]
unique = map head . group . sort

inRange :: (Int, Int) -> Bool
inRange (y, x) = 1 <= y && y <= 8 && 1 <= x && x <= 8

solve :: [(Int, Int)] -> [(Int, Int)] -> IO ()
solve statues xs
  | null xs                             = putStrLn "LOSE"
  | any (== (1, 8)) xs || null statues  = putStrLn "WIN"
  | otherwise                           = solve statues' xs'
 where
  statues'  = do
    (y, x) <- statues
    guard $ y <= 7
    return (y + 1, x)
  xs'       = unique $ do
    (y, x) <- xs
    filter ((&&) <$> (`notElem` statues') <*> (`notElem` statues)) $
      filter inRange $ (,) <$> [y - 1, y, y + 1] <*> [x - 1, x, x + 1]

main :: IO ()
main = do
  (concat -> statues) <- forM [1 .. 8] $ \y -> do
    row   <- getLine
    return $ do
      (x, c) <- zip [1 ..] row
      guard $ c == 'S'
      return (y, x)
  solve statues [(8, 1)]

{-
SSSSSSSA
.....SS.
....S...
...S....
..S.....
.S......
S.......
M.......
-}


-- 846B

import Data.List (sort)

main = do
  (n:k:m:_) <- fmap (map read . words) getLine
  interact $ show . bf n k m . sort . map read . words

bf :: Int -> Int -> Int -> [Int] -> Int
bf n k m xs = let s = sum xs in
  maximum $ 0:[i*(k+1) + program (n-i) (m-(i*s)) xs | i <- [0..n], m >= i*s]

program :: Int -> Int -> [Int] -> Int
program n m (c:cs) | c <= m =
  let cost  = min (c*n) m
      score = cost `div` c * (if null cs then 2 else 1)
  in score + (program n (m - cost) cs)
program _ _ _ = 0


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	getLine
	s <- getLine
	let
		ps = solve 0 s
		mi = minimum ps
	print $ last ps - mi

solve p [] = [p]
solve p (c:s) = p : solve ( f p ) s
	where
		f = if c == '+' then succ else pred


{-# 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 = getLine >>= putStrLn . which "Yes" "No" . solve

solve (a:b:c:rest)
	| a == '.' = solve (b:c:rest)
	| b == '.' = solve (b:c:rest)
	| c == '.' = solve (b:c:rest)
	| a /= b && b /= c && c /= a = True
	| otherwise = solve (b:c:rest)
solve _ = False


module Main where
import Data.Char
import System.Environment

main = do
	paramStr <- getLine
	let
		params = (readIntsFromStr paramStr)
		commonDivider = gcd' ((params!!0)*(params!!3)) ((params!!1)*(params!!2))
		height = (div (params!!2 * params!!1) commonDivider)
		width = (div (params!!3 * params!!0) commonDivider)
		in putStrLn $ id (show (abs (height - width)) ++ "/" ++ show (max height width))

gcd' :: Int -> Int -> Int
gcd' a b
	| (mod a b == 0) = b
	| otherwise = gcd b (mod a b)

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

readInt :: String -> Int
readInt = read

readDoublesFromStr :: String -> [Double]
readDoublesFromStr str = map readDouble (filter p (wordsWhen (==' ') str))
	where p = (/=)""

readDouble :: String -> Double
readDouble = read

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


main = interact $ show . (\x -> (x+2*m)`mod`m) . sol . map read . words
    where m = 1000000007

sol :: [Integer] -> Integer
sol (x:y:n:_) = case n `mod` 6 of 1 -> x
                                  2 -> y
                                  3 -> y-x
                                  4 -> -x
                                  5 -> -y
                                  0 -> -y+x


main = interact (s.map read.words)
s [x,y] = if fromIntegral(floor l)==l || (i*b)==1 then "black" else "white"
    where
        l=sqrt(fromIntegral(x*x+y*y))
        b=if even (floor l) then 1 else -1
        i=if (x*y)>0 then 1 else -1


import Data.Char
main=interact$show.b.lines.map toLower
b [x,y] = a x y
a [] _ = 0
a (x:c) (y:d)
 |x == y = a c d
 |x<y = -1
 |1>0 = 1


module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  data Point = Point { x :: Int, y :: Int } deriving (Ord, Eq)

  instance Show Point where
    show (Point x y) = show x ++ " " ++ show y

  fromPair :: [Int] -> Point
  fromPair (x:y:[]) = Point x y

  minus :: Point -> Point -> Point
  minus (Point x1 y1) (Point x2 y2) = Point (x1 - x2) (y1 - y2)

  plus :: Point -> Point -> Point
  plus (Point x1 y1) (Point x2 y2) = Point (x1 + x2) (y1 + y2)

  solutions :: Point -> Point -> Point -> Point
  solutions p1 p2 p3 = (p1 `minus` p2) `plus` p3

  main :: IO()
  main = do
    p1 <- getLine >>= return . fromPair . (map readInt) . words
    p2 <- getLine >>= return . fromPair . (map readInt) . words
    p3 <- getLine >>= return . fromPair . (map readInt) . words
    let ans = [
          solutions p1 p2 p3,
          solutions p1 p3 p2,
          solutions p2 p1 p3,
          solutions p2 p3 p1,
          solutions p3 p1 p2,
          solutions p3 p2 p1
             ]
        sans = S.fromList ans
        lsans = S.toList sans
    print $ length $ lsans
    forM_ lsans print


import Data.List (group)

ok :: String -> Bool
ok s =
  all (\ x -> x == 1) $ map (\ l -> length l) $ group s

main = do
  chess <- getContents
  if ok chess
    then putStrLn "YES"
    else putStrLn "NO"


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

getInt :: IO Int
getInt = (read::String->Int) <$> getLine

getIntList :: IO [Int]
getIntList = map (read::String->Int) . words <$> getLine

main = do
    _ <- getInt
    ws <- getIntList
    putStrLn $ sol ws

sol :: [Int] -> String
sol ws = if ed ws then "YES" else "NO"
    where
    ed ws = if n1 > 0 then even n1 else even n2
    n1 = length (filter (==100) ws)
    n2 = length ws - n1


import Control.Applicative

process::Int->Int
process c |c >=0 = c
          |c> -10 = 0
          |otherwise  = max (read $ init cc)  (read (( init (init cc) )++ [last cc]))
      where cc = show c

main=do

     q<-  read <$>  getLine::IO Int
     print $ process q


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

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

main = do
  n <- fmap read getLine
  let (m, mx) = solve n
  putStrLn $ show m ++ " " ++ show mx

min1Week x | x <= 5 = 0
           | x == 6 = 1
           | otherwise = 2
max1Week x = min x 2

solve n = (2*(n`div`7) + min1Week (n`mod`7),2*(n`div`7) + max1Week (n`mod`7))


func :: Integer -> Integer -> (Integer, Integer)
func a b = if a==0 || b==0 then (a,b)
           else if a>=2*b then func (a `mod` (2*b)) b
           else if b>=2*a then func a (b `mod` (2*a))
           else (a,b)

main :: IO ()
main = do
    nm <- getLine
    let n:m:_ = (map read (words nm)) :: [Integer] in
        let (a,b) = func n m
            in putStrLn $ show a ++ " " ++ show b
    return ()


main = readLn >>= print . (+9) . length . takeWhile (>=10) . mkLs

mkLs n = n : (mkLs $ rm0 $ n + 1)

rm0 n
    | n `mod` 10 == 0 = rm0 $ n `div` 10
    | otherwise = n


import Control.Monad
import Data.IORef
import Data.List

main :: IO ()
main = do
    inp <- getLine
    let [n, k] = (map (read::String -> Int)) (words inp)
    inpp <- getLine
    let parsed = sortBy (\(_, x) (_, y) -> compare x y)  (zip [1, 2..] ((map (read::String -> Int)) (words inpp)))
    ptr <- newIORef (snd (head parsed) - 1)
    ll <- newIORef ([])
    forM_ parsed (\(n, x) -> do
                    cur <- readIORef ptr
                    if (x > cur) then modifyIORef ll (n:) >> writeIORef ptr x
                    else return ())
    ans <- readIORef ll
    if (length ans >= k) then putStr "YES\n" >> putStrLn (foldr (\x z -> (show x) ++ " " ++ z) [] (take k ans))
    else putStr "NO"
    return ()


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

solve xs
    | any (==0) $ map ((`mod` 360) . sum) $ expand xs = "YES"
    | otherwise = "NO"

expand [] = [[]]
expand (x:xs) = map (x:) xs' ++ map (-x:) xs'
    where xs' = expand xs


import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric
import Data.Maybe(fromJust)

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input = answer
    where
    (a', _:input') = splitAt (fromJust $ elemIndex '.' input) input
    (d', _:b_s) = splitAt (fromJust $ elemIndex 'e' input') input'
    b = read b_s

    a = dropWhile ('0' ==) a'
    d = reverse . dropWhile ('0' ==) $ reverse d'
    combined = a ++ d
    normedb = b+(length a)

    add_dot place [] = replicate place '0'

    add_dot place (x:xs)
        | place == 0 = '.':x:xs
        | otherwise = x:(add_dot (place-1) xs)

    answer::String
    answer = case answer' of
        "" -> "0"
        '.':_ -> '0':answer'
        otherwise -> answer'
        where
            answer' = add_dot normedb combined


module Main where

d '0' = "O-|-OOOO"
d '1' = "O-|O-OOO"
d '2' = "O-|OO-OO"
d '3' = "O-|OOO-O"
d '4' = "O-|OOOO-"
d '5' = "-O|-OOOO"
d '6' = "-O|O-OOO"
d '7' = "-O|OO-OO"
d '8' = "-O|OOO-O"
d '9' = "-O|OOOO-"

main = getLine >>= mapM_ putStrLn . map d . reverse


main =
  interact $ solve . lines
solve :: [String] -> String
solve (_:regex:_) =
  let pokemon = ["vaporeon", "jolteon", "flareon", "espeon", "umbreon", "leafeon", "glaceon", "sylveon"] in
   head $ take 1 $ filter (\x -> length x == length regex) $ filter (f regex) pokemon
   where
     f :: String -> String -> Bool
     f reg pokemon =
       not $ or $ zipWith (\x -> \y -> x /= y && x /= '.') reg pokemon


--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[n], xs@[_,_,_]] <- replicateM 2 ri
        return (n, xs)
    mapM_ (putStrLn.showYN.solve) tcs

showYN False = "NO"
showYN True  = "YES"

solve (n,xs) = (==[1,2,3]) . L.sort . take 3 . map fst . iterate nextUnlock $ (n,ys)
  where
    ys = zip inds xs

nextUnlock (n,ys) = (nn,ys)
  where
    nn = maybe n snd . L.find ((==n).fst) $ ys

inds = [1..] :: [Int]


main = interact$ f.head.lines
f [] = "YES"
f ('1':'4':'4':xs) = f xs
f ('1':'4':xs) = f xs
f ('1':xs) = f xs
f _ = "NO"


import Data.List

main = interact $ process . map read . words
process x = if (test x) then "Alice" else "Bob"
test (n:y) = m <= div n 2
    where m = length $ head $ group $ sort y


module Main where

import qualified Data.Text.IO as T
import qualified Data.Text as T

main = do
  t <- T.getLine
  putStrLn
    $ show
    $ (\[n,k] -> sol n k 1 (n*k + k))
    $ map read
    $ words
    $ T.unpack t

sol :: Int -> Int -> Int -> Int -> Int
sol n k i res | n == 1       = k+1
              | i > k-1      = res
              | mod n i == 0 = if res' < res
                               then sol n k (i+1) res'
                               else sol n k (i+1) res
              | True         = sol n k (i+1) res
  where res' = k * (div n i) + i


main = do
	a<-getLine
	b<-getLine
	putStrLn $solve a b

solve a b | a == reverse b = "YES"
          | otherwise = "NO"


main = do
  [x,y] <- fmap (map read . words) getLine :: IO [Integer]
  print (solve y x)

solve m n = sum $ map f [1..n]
    where
      f x | x `mod` 5 == 0 = (m - ((5 - (x `mod` 5))`mod` 5)) `div` 5
          | otherwise = ((m - (5 - (x `mod` 5))) `div` 5) + 1


import qualified Data.ByteString.Lazy.Char8 as BS
import Control.Monad
import Data.List
import Data.Maybe
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: Int -> Int
solve k =
    let
        g = gcd k (100 - k)
    in
        k `div` g + (100 - k) `div` g

main = do
    s <- BS.getContents
    forM_ (parseInt <$> tail (BS.lines s)) (print . solve)


import Control.Applicative( (<$>))

main = do
    [c_,v0_,v1_,a_,l_] <- map read . words <$> getLine
    let
	stride d = min (v0_+d*a_) v1_

	count1st toRead = let
				toRead' = c_-v0_
			    in
				if toRead' <= 0
				then 1
				else count 1 toRead'

	count day toRead = let
				toRead' = toRead+l_-stride day
			in
			    if toRead' <= 0
				then day+1
				else count (day+1) toRead'
    print $ count1st c_


main :: IO ()
main = (getLine >> getLine) >>= (\s -> print (count 'L' s + count 'R' s + 1))
  where count el = length . filter (el==)


{-# OPTIONS_GHC -O2 #-}

import Data.Char (ord)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

parseInts = fmap parseInt . words

main = do
  n <- fmap parseInt getLine
  a:as <- fmap parseInts getLine
  let s = sum as + a
      pid = (a, 1) : filter (\(x, _) -> 2 * x <= a) (zip as [2 ..])
      p = fmap snd pid
      v = sum (fmap fst pid)
  if 2 * v > s
    then do
      print (length pid)
      putStrLn (unwords (fmap show p))
    else print 0


-- 40B

solve :: [Int] -> Int
solve [n, m, x]  =  solve' (n - 2 * (x - 1)) (m - 2 * (x - 1))
  where
    solve' 1 1  =  1
    solve' n m
      | n > 0 && m > 0  =  m + n - 2
      | otherwise  =  0

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


import Data.Map (Map)
import qualified Data.Map as M
import Control.Applicative

main = getLine >> do
  cs <- reverse.words <$> getLine
  if solve cs
     then putStrLn "YES"
     else putStrLn "NO"

type Card = String

[x,y]===[z,w] = x==z || y==w

solve cards = evalState (dp cards) $ M.empty
   where
     dp :: [Card] -> State (Map [Card] Bool) Bool
     dp [_] = return True
     dp [c0,c1] = return $ c0===c1
     dp [c0,c1,c2] = return $ c0===c1 && c0===c2
     dp cs@(c0:c1:c2:c3:rest) = do
       memo <- get
       case M.lookup cs memo of
         Just ans -> return ans
         Nothing
           | c0===c1 && c0===c3 -> do
               ans1 <- dp $ c0:c2:c3:rest
               ans3 <- dp $ c1:c2:c0:rest
               let ans = ans1 || ans3
               modify (M.insert cs ans)
               return ans
           | c0===c1 -> do
               ans1 <- dp $ c0:c2:c3:rest
               modify (M.insert cs ans1)
               return ans1
           | c0===c3 -> do
               ans3 <- dp $ c1:c2:c0:rest
               modify (M.insert cs ans3)
               return ans3
           | otherwise -> return False

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

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

get :: State s s
get = State $ \s -> (s,s)
put :: s -> State s ()
put s = State $ \_ -> ((),s)

modify :: (s -> s) -> State s ()
modify f = get >>= put.f

evalState :: State s a -> s -> a
evalState = (fst.).runState
execState :: State s a -> s -> s
execState = (snd.).runState


solve :: Integer -> Integer -> String
solve a b = case compare a b of
    LT -> solve' a b
    EQ -> "Equal"
    GT -> alt (solve' b a)
    where alt "Masha" = "Dasha"
          alt "Dasha" = "Masha"
          alt "Equal" = "Equal"
solve' a b = case compare a' b' of
    LT -> "Masha"
    EQ -> "Equal"
    GT -> "Dasha"
    where g = lcm a b
          a' = div g a - 1
          b' = div g b
main = putStrLn . (\[a,b] -> solve (read a) (read b)) . words =<< getLine


import Prelude
import Control.Monad
import Data.List
import qualified Data.Map as M
import qualified Data.Array as A
import Data.Functor
import Data.Maybe

other a xs = fromMaybe 0 (lookup a xs)

main :: IO ()
main = do
  getLine
  str <- fmap (map (\xs -> (head xs, length xs)) . group . sort) getLine
  let r = other 'R' str
      g = other 'G' str
      b = other 'B' str
      ans3 = ((r >= 1 && g >= 1 && b >= 1) || (r >= 2 && g >= 2) || (r >= 2 && b >= 2) || (g >= 2 && b>= 2))
      ansB = (g == 0 && r == 0) || (b == 0 && r == 1 && g == 1)
      ansG = (r == 0 && b == 0) || (g == 0 && r == 1 && b == 1)
      ansR = (g == 0 && b == 0) || (r == 0 && b == 1 && g == 1)
      ansBG = r >= 2 && (b > 0 || g > 0)
      ansBR = g >= 2 && (b > 0 || g > 0)
      ansGR = b >= 2 && (g > 0 || r > 0)
      sol = if ans3 then "BGR" else if ansB then "B" else if ansG then "G" else if ansR then "R" else if ansBG then "BG" else if ansBR then "BR" else if ansGR then "GR" else ""
  putStrLn sol
  return ()


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

main = do
		[b,s,m]<- map read <$> words <$> getLine::IO [Int]
		bb<- minimum <$> map read <$> words <$> getLine::IO Int
		aa<- maximum  <$> map read <$> words <$> getLine::IO Int
		print $ if bb>=aa then m else (div m bb)*aa +mod m bb


import System.IO

main :: IO ()
main = interact (show . (uncurry compute) . get_two_ints . words)

get_two_ints :: [String] -> (Int, Int)
get_two_ints (x:y:_) = (read x :: Int, read y :: Int)
get_two_ints _ = undefined

compute :: Int -> Int -> Integer
compute n k =
   let m = fromIntegral (n-k) :: Integer
       k' = fromIntegral k :: Integer
   in  mod (k'^(k'-1) * m^m) (10^9+7)


import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

agregar x m = Map.insertWith (+) x 1 m
quitar :: Integer -> (Map.Map Integer Integer) -> (Map.Map Integer Integer)
quitar x m = Map.insertWith (+) x (-1) m

asdasd [] = Map.fromList []
asdasd (x:xs) = agregar x (asdasd xs)

can n [] k = n <= 0
can n (x:xs) k =
  can (n-(div x k)) xs k

doit n w k =
  if k == 0 || can n w k then
    k
  else
    doit n w (k-1)

solve::String -> String
solve ss =
    let (n:m:s) = Prelude.map toint $ words ss in
    let w = map snd $ Map.toList $ asdasd s in
    let r = doit n w 200 in
    show r ++ "\n"

main = interact solve


import Control.Applicative
import Data.Char

main= do
	r<-     getLine
	let s = map (\z-> (ord z)- (ord '0')) r
	let s1 = (s!!0)*10000 + (s!!2) *1000 +(s!!4) *100 +(s!!3) *10 +s!!1
	let s2=  show ((fromIntegral s1)^5)
	let s3= length s2
	putStrLn $ drop (s3-5) s2


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

type Case = Int

parse (a:b:c:d:_:e:f:_:g:h:[]) = fromGregorian (read (a:b:c:d:[])) (read (e:f:[])) (read (g:h:[]))

main = do
  f <- getLine
  t <- getLine
  let a = parse f -- fromGregorian 1900 01 01
  let b = parse t -- fromGregorian 2038 12 31
  print $ abs (diffDays a b)


module Main where
import Control.Monad

nz x = round $ (log $ fromIntegral x) / log 10.0
bn nz = foldr (\_ acc -> (\x y -> x*10+y ) <$> acc <*> [0,1]) [1] [0..nz-1]
ton n =  let z = nz n in  (sum $  map ( length . bn) [0..z-1])   +   (length $ filter (<=n) $ bn z )

main =  (readLn :: IO Int) >>=  print . ton


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

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

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

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

solve :: (Integer, Integer) -> ByteString
solve (a, b) = BS.pack . show $ maximum [ solve2 (a, b) (interval10 n) | n <- [1..10]]
  where
    interval10 i = (10 ^ (i-1), 10 ^ i - 1)

solve2 :: (Integer, Integer) -> (Integer, Integer) -> Integer
solve2 (a, b) (c, d)
    | inRange (lo, hi) target = target * (d - target)
    | otherwise               = 0
  where
    lo = a `max` c
    hi = b `min` d
    target = ((d `div` 2) `min` hi) `max` lo

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import Data.Int
import Data.List
import GHC.Arr (Ix)

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
{-# INLINE rep #-}

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

implies :: Bool -> Bool -> Bool
p `implies` q = not p || q
{-# INLINE implies #-}
infixr 1 `implies`

main = do
  [cs, m] <- words <$> getLine
  let len = length cs
  print $ solve (read m) len $ listArray (0,len-1) [read[c]|c<-sort cs]

solve :: Int -> Int -> UArray Int Int -> Int64
solve m len arr = runST $ do

  dp <- newArray ((0,0), (2^len-1,m-1)) 0 :: ST s (STUArray s (Int,Int) Int64)

  writeArray dp (0,0) 1

  rep (2^len) $ \used -> do
    rep m $ \r -> do
      a <- unsafeRead dp $ used * m + r
      when (a /= 0) $ do
        rep len $ \i -> do
          let !digit = unsafeAt arr i
          unless (testBit used i || used == 0 && digit == 0) $ do
            when (i > 0 && digit == unsafeAt arr(i-1) `implies` testBit used (i-1)) $ do
              unsafeModify dp (setBit used i * m  + rem (10 * r + digit) m) (a+)

  readArray dp (2^len-1,0)


main=readLn>>=print.solve

solve n = (!!(n-1)).filter isEmirp $ primes

isEmirp n = (n/=m)&&(isPrime m)
   where m = read.reverse.show$n

primes  = 2 : filter isPrime [3,5..]
isPrime n = all ((0/=) . mod n) $ takeWhile (\x -> x*x <= n) primes


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

upperBound :: (Integral i) => (i -> Bool) -> i -> i -> i
upperBound p low high = go low high
   where
     go !low !high
       | high <= low = low
       | p mid       = go mid high
       | otherwise   = go low (mid - 1)
      where
        mid = (low + high + 1) `quot` 2
{-# INLINE upperBound #-}

modulus :: Int
modulus = 1000000007

infixl 6 +%

(+%) :: Int -> Int -> Int
x +% y = case x + y of xy -> if xy < modulus then xy else xy - modulus
{-# INLINE (+%) #-}

main :: IO ()
main = interact $ show.solve.sort.map read.words

solve :: [Int] -> Int
solve [r,g] = foldl1' (+%) $ map (unsafeAt arr) [0..r]
   where
     !n = r + g
     !hMax = upperBound (\i->i*(i+1)`div`2<=n) 0 1000
     !arr = runSTUArray $ do
       buf <- newArray (0,r) 0 :: ST s (STUArray s Int Int)
       buf' <- newArray (0,r) 0 :: ST s (STUArray s Int Int)

       let go !h !total dp next
             | h < hMax = do
                 rep (h+1) $ \r' -> do
                   if total - r'+ (h+1) <= g
                   then unsafeRead dp r' >>= unsafeWrite next r'
                   else unsafeWrite next r' 0
                 for (h+1) (<=r) (1+) $ \r' -> do
                   if total - r'+(h+1) <= g
                   then do
                     (+%) <$> unsafeRead dp (r'-(h+1)) <*> unsafeRead dp r' >>= unsafeWrite next r'
                   else unsafeRead dp (r'-(h+1)) >>= unsafeWrite next r'
                 go (h+1) (total+h+1) next dp
             | otherwise = return dp

       unsafeWrite buf 0 1
       go 0 0 buf buf'


mm :: Integer
mm = 10 ^ 9 + 7

addMod :: Integer -> Integer -> Integer
addMod a b
    | a + b < mm = a + b
    | otherwise = a + b - mm

scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' _ q [] = seq q [q]
scanl' f q (x : xs) = seq q (q : scanl' f (f q x) xs)

solve :: Int -> Integer
solve n = let dynamic mem = scanl' addMod (last mem) mem
          in (!! pred n) . (!! n) . iterate dynamic $ [1]

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


import Data.List

f :: Int->String
f n
  |n<0="NO"
  |n `mod` 7==0="YES"
  |otherwise=f (n-3)

main = do
       a<-getLine
       b<-getLine
       let xs=map read (words b)::[Int]
           ys=sort $ nub xs
       print $ (length ys)-(if (head ys)==0 then 1 else 0)


import Control.Monad
main = do
 [n,m,k]<-liftM(map read.words)getLine
 a<-replicateM n getLine
 putStrLn$show$kitten a k m
kitten a k m=length$filter(c a k)[0..m-1]
c a k x=k<=(length$filter(\y->y!!x=='Y')a)


import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
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=   readsolveprint
readsolveprint::IO()
readsolveprint = (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInteger).C.words<$>C.getLine))
solve [x] =  print $ slv1 x
slv1 0 = 1
slv1 x = let y = x `mod` 4 in if y == 0 then 6 else if  y == 1 then 8 else if  y == 2 then 4 else 2


main = interact (show . solve . concat . lines)
solve "1 of week" = 52
solve "2 of week" = 52
solve "3 of week" = 52
solve "4 of week" = 52
solve "5 of week" = 53
solve "6 of week" = 53
solve "7 of week" = 52
solve "1 of month" = 12
solve "2 of month" = 12
solve "3 of month" = 12
solve "4 of month" = 12
solve "5 of month" = 12
solve "6 of month" = 12
solve "7 of month" = 12
solve "8 of month" = 12
solve "9 of month" = 12
solve "10 of month" = 12
solve "11 of month" = 12
solve "12 of month" = 12
solve "13 of month" = 12
solve "14 of month" = 12
solve "15 of month" = 12
solve "16 of month" = 12
solve "17 of month" = 12
solve "18 of month" = 12
solve "19 of month" = 12
solve "20 of month" = 12
solve "21 of month" = 12
solve "22 of month" = 12
solve "23 of month" = 12
solve "24 of month" = 12
solve "25 of month" = 12
solve "26 of month" = 12
solve "27 of month" = 12
solve "28 of month" = 12
solve "29 of month" = 12
solve "30 of month" = 11
solve "31 of month" = 7


main :: IO()
main =
  do [n, k] <- map read.words <$> getLine
     putStrLn.show $ iterate f n !! k

f :: Int -> Int
f x | x `mod` 10 == 0 = x `div` 10
    | otherwise = x - 1


import Data.Bits
import Data.Word

infixl 6 +.
infixl 7 *.
infixr 8 ^.

m = 10^9 + 7 :: Word64

a +. b = (a + b) `mod` m
a *. b = a * b `mod` m
a ^. b = a ^ b `mod` m

dependency (a, b) = (a ^. 2, (a + 1) *. b)

g 0 x _ = x

g n x ((a, b):rest) = g n' x' rest
    where
        n' = n `unsafeShiftR` 1
        x' =
            if n `testBit` 0
            then a *. x +. b
            else x

solve [a1, b1, n, x] = g n x $ iterate dependency (a1, b1)

main = interact $ unlines . map (show . solve . map read . words) . lines


module Main where
ispalindrome x = x == reverse x
--minsame x = minimum $  map (\xs ->  length $ takeWhile (==head xs) xs)  [x, reverse x ]
main = getLine >>= \x -> print $ (length x) -  if not $ ispalindrome x  then 0 else  if all (==head x) x then length x else 1


import Control.Applicative
import Data.List

myShow :: [(Int, Int)] -> IO ()
myShow [] = return ()
myShow (x:xs) = do
                    putStrLn $ show (fst x) ++ " " ++ show (snd x)
                    myShow xs

main :: IO ()
main = do
        n <- read <$> getLine
        onlyCards <- map (read :: String -> Int) . words <$> getLine
        let sortedCards = sort $ zip onlyCards [1..]
            firstH = take (n `div` 2) sortedCards
            secondH = reverse $ drop (n `div` 2) sortedCards
            res = map (\x -> (snd . fst $ x, snd . snd $ x)) $ zip firstH secondH
        myShow res


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

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

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

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

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

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

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

f s t
  | substr s t = "automaton"
  | sort s == sort t = "array"
  | substr (sort s) (sort t) = "both"
  | otherwise = "need tree"

substr _ [] = True
substr (x:xs) (y:ys)
  | x == y = substr xs ys
  | otherwise = substr xs (y:ys)
substr _ _ = False


import Data.List
t=transpose
m=minimum
d l=maximum l-m l
main=interact$show.m.map(d.map(foldl(\r x->r*10+fromEnum x-48)0).t).permutations.t.tail.lines