Bizon the Champion is called the Champion for a reason. Bizon the Champion has recently got a present — a new glass cupboard with n shelves and he decided to put all his presents there. All the presents can be divided into two types: medals and cups. Bizon the Champion has a1 first prize cups, a2 second prize cups and a3 third prize cups. Besides, he has b1 first prize medals, b2 second prize medals and b3 third prize medals. Naturally, the rewards in the cupboard must look good, that's why Bizon the Champion decided to follow the rules:  any shelf cannot contain both cups and medals at the same time;  no shelf can contain more than five cups;  no shelf can have more than ten medals. Help Bizon the Champion find out if we can put all the rewards so that all the conditions are fulfilled.

The first line contains integers a1, a2 and a3 (0 ≤ a1, a2, a3 ≤ 100). The second line contains integers b1, b2 and b3 (0 ≤ b1, b2, b3 ≤ 100). The third line contains integer n (1 ≤ n ≤ 100). The numbers in the lines are separated by single spaces.

Print "YES" (without the quotes) if all the rewards can be put on the shelves in the described manner. Otherwise, print "NO" (without the quotes).

module Main (main)
    where

import Control.Monad (replicateM)

readInts :: String -> [Int]
readInts = map read . words

main :: IO ()
main = putStrLn . toYesNo . solve . map readInts =<< replicateM 3 getLine
    where solve [as,bs,[n]] = n >= shelves (sum as) 5 + shelves (sum bs) 10
          shelves c m = let (q,r) = divMod c m in q + min 1 r
          toYesNo True  = "YES"
          toYesNo False = "NO"

main = do
	as<-getLine
	bs<-getLine
	n<-getLine
	let [a1,a2,a3] =map read $ words as
	let [b1,b2,b3]= map read $ words bs
	putStrLn $ solve a1 a2 a3 b1 b2 b3 (read n)

solve a1 a2 a3 b1 b2 b3 n = if div (a-1) 5 + div (b-1) 10 +2 <=n then "YES" else "NO"
	     where a=a1+a2+a3
	           b=b1+b2+b3

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

solve :: [Int] -> String
solve [a1, a2, a3, b1, b2, b3, n] = let a = a1 + a2 + a3
                                        b = b1 + b2 + b3
                                        na = div (a + 4) 5
                                        nb = div (b + 9) 10
                                    in if na + nb <= n then "YES" else "NO"

import Data.List
import Data.Function
import Data.Char

main = interact $ getAns . map (map read . words) . lines

getAns :: [[Int]] -> String
getAns (ax:bx:(n:_):_)
	| s > n = "NO"
	| otherwise = "YES"
	where s = di 5 ax + di 10 bx
	      di a = ceiling . (/ a) . fromIntegral . sum

import Data.List
import Data.Function
import Data.Char

main = interact $ getAns . map read . words

getAns :: [Int] -> String
getAns (a1:a2:a3:b1:b2:b3:n:_)
	| s > n = "NO"
	| otherwise = "YES"
	where s = ceiling (fromIntegral (a1 + a2 + a3) / 5) + ceiling (fromIntegral (b1 + b2 + b3) / 10)

import Data.List
import Data.Function
import Data.Char

main = interact $ getAns . map read . words

getAns :: [Int] -> String
getAns (a1:a2:a3:b1:b2:b3:n:_)
	| s > n = "NO"
	| otherwise = "YES"
	where s = di 5 (a1 + a2 + a3) + di 10 (b1 + b2 + b3)
	      di a = ceiling . (/ a) . fromIntegral

import Data.List
import Data.Function
import Data.Char

main = interact $ getAns . map read . words

getAns :: [Int] -> String
getAns (a1:a2:a3:b1:b2:b3:n:_)
	| s > n = "NO"
	| otherwise = "YES"
	where ta = a1 + a2 + a3
	      tb = b1 + b2 + b3
	      sa = ta `div` 5 + if ta `mod` 5 == 0 then 0 else 1
	      sb = tb `div` 10 + if tb `mod` 10 == 0 then 0 else 1
	      s = sa + sb

main = do
  [a1, a2, a3] <- fmap (map read . words) getLine
  [b1, b2, b3] <- fmap (map read . words) getLine
  n <- readLn

  putStrLn $ if (a1+a2+a3 + 4) `div` 5 + (b1+b2+b3+9) `div` 10 > n then "NO" else "YES"

main = do
    aux1 <- getLine
    let cups = sum (map read $ words aux1 :: [Int])
    aux2 <- getLine
    let medals = sum (map read $ words aux2 :: [Int])
    aux3 <- getLine
    let shelfs = read aux3
    let neededForCups = if (mod cups 5 == 0) then (div cups 5) else ((div cups 5) + 1)
    let neededForMedals = if (mod medals 10 == 0) then (div medals 10) else ((div medals 10) + 1)
    let ans = if (neededForCups + neededForMedals <= shelfs) then "YES" else "NO"

    putStrLn ans

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

main = do
  as <- getints
  bs <- getints
  n  <- getint
  let sumA = sum as
      needA = sumA `div` 5 + (if sumA `mod` 5 == 0 then 0 else 1)
      sumB = sum bs
      needB = sumB `div` 10 + (if sumB `mod` 10 == 0 then 0 else 1)
  if needA + needB > n then putStrLn "NO" else putStrLn "YES"

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = solve =<< forM [1..3] (\i-> sum.map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve [x,y,z] = let s = (+) (ceiling (fromIntegral x / 5)) (ceiling (fromIntegral y / 10)) in putStr $ if s>z then "NO" else "YES"

{-# 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
  as <- getInts
  bs <- getInts
  n <- readLn

  putStrLn $ if (sum as + 4) `div` 5 + (sum bs + 9) `div` 10 <= n then "YES" else "NO"

import Control.Applicative

parse = map read . words

main = do
  cs <- parse <$> getLine
  ms <- parse <$> getLine
  n  <- read <$> getLine
  let c = sum cs
      m = sum ms
      n1 = (n*5 - c) `div` 5
      n2 = (n1*10-m) `div` 10
  putStrLn $
    if n2 >= 0 then "YES" else "NO"

import Control.Applicative

main = do
  cups <- sum . map read . words <$> getLine
  medals <- sum . map read . words <$> getLine
  n <- readLn

  let cs = (cups + 4) `div` 5
      ms = (medals + 9) `div` 10
      s = cs + ms
    in putStrLn $ if s <= n then "YES" else "NO"

import Control.Applicative
import Data.List

process n q1 q2 | sq1+sq2 <= n= "YES"
                | otherwise = "NO"
      where sq1= (div ((sum q1)-1) 5)+1
            sq2= (div ((sum q2)-1) 10)+1

main = do
  q1<-  map read  <$>   words  <$> getLine ::IO [Int]
  q2<-  map read  <$>   words  <$> getLine ::IO [Int]
  n<- read <$> getLine ::IO Int
  putStrLn  $ process n q1 q2

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

solve :: [[Int]] -> Bool
solve [as, bs, [n]] = sum as // 5 + sum bs // 10 <= n

(//) :: Integral a => a -> a -> a
x // y = (x + y - 1) `div` y

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

main = do
  cs <- fmap (sum . map read . words) getLine
  ms <- fmap (sum . map read . words) getLine
  s <- readLn
  putStrLn $ if (cs + 4) `div` 5 + (ms + 9) `div` 10 > s then "NO" else "YES"

main :: IO ()
main = do
  sa <- getLine
  sb <- getLine
  sn <- getLine
  let suma = sum . map read $ words sa
      sumb = sum . map read $ words sb
      tot = ceiling ((/) suma 5) + ceiling ((/) sumb 10)
      n = read sn
      res = if tot <= n then "YES" else "NO"
  putStrLn res

flrDiv :: Integral a => a -> a -> a
flrDiv a b = div (a+b-1) b

readInts :: String -> [Int]
readInts str = map read (words str)

main :: IO ()
main = do

  as <- fmap readInts getLine
  bs <- fmap readInts getLine
  n <- fmap read getLine :: IO Int
  let b = (flrDiv (sum as) 5) + (flrDiv (sum bs) 10) <= n
  putStr $ if b then "YES" else "NO"

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
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 #-}

main :: IO ()
main = do
  x <- sum.map readInt.B.words <$> B.getLine
  y <- sum.map readInt.B.words <$> B.getLine
  n <- readLn
  putStrLn.bool"YES""NO" $ solve n x y

solve :: Int -> Int -> Int -> Bool
solve n x y = (x+4)`div`5 + (y+9)`div`10 <= n

import Control.Applicative
main = do
	a <- (`div` 5) . (+4) . sum . map read . words <$> getLine
	b <- (`div` 10) . (+9) . sum . map read . words <$> getLine
	n <- read <$> getLine
	putStrLn $ if a + b > n then "NO" else "YES"

import Control.Applicative
main = do
	a <-  ceiling . (/5) . sum . map read . words <$> getLine
	b <- ceiling . (/10) . sum . map read . words <$> getLine
	n <- read <$> getLine
	putStrLn $ if a + b > n then "NO" else "YES"

import Control.Applicative

calc a b = div (sum a) b +(if mod (sum a) b>0 then 1 else 0)

main=do
	a<-map read.words <$> getLine::IO [Int]
	b<-map read.words <$> getLine::IO [Int]
	c<- read <$> getLine::IO Int
	putStrLn $ if c>= (calc a  5+ calc b 10) then "YES" else "NO"

import Control.Monad
import Data.List

main = replicateM 3 getLine
   >>= putStrLn . solve . map sum
   where sum = foldl1 (+) . map read .words

solve :: [Float] -> String
solve [a, b, n] = if ceiling(a / 5.0) + ceiling(b / 10.0) <= ceiling(n) then "YES" else "NO"

main :: IO ()
main = interact solve

solve :: String -> String
solve s
    | (a `divUp` 5) + (b `divUp` 10) <= n = "YES"
    | otherwise = "NO"
        where [a, b, n] = (fmap (sum . fmap read . words) . lines) s :: [Int]

divUp :: (Integral a) => a -> a -> a
divUp a b =  (a + b - 1) `div` b

module Main where

main = do
	line1 <- getLine
	line2 <- getLine
	line3 <- getLine
	let a = readIntList line1
	let b = readIntList line2
	let n = read line3 :: Int

	putStr $ result a b n

result a b n = sayYesNo $ ((ceiling' a' 5.0) + (ceiling' b' 10.0)) <= n
	where
		sayYesNo bool = if bool then "YES" else "NO"
		ceiling' s alpha = ceiling (toRational s / alpha)
		a' = sum a
		b' = sum b

readIntList :: String -> [Int]
readIntList = map read . words

parseInput :: String -> ([Int], [Int], Int)
parseInput input = (xs, ys, n) where
    ls = lines input
    xs = map read $ words $ head ls
    ys = map read $ words $ head $ tail ls
    n = read $ last ls

solve xs ys n | m <= n    = "YES"
              | otherwise = "NO"
    where x = sum xs
          y = sum ys
          m = (x + 4) `div` 5 + (y + 9) `div` 10

main :: IO ()
main = do
    input <- getContents
    let (xs, ys, n) = parseInput input
    putStrLn $ solve xs ys n

main = do
	as<-getLine
	bs<-getLine
	n<-getLine
	let [a1,a2,a3] =map read $ words as
	let [b1,b2,b3]= map read $ words bs
	putStrLn $ solve a1 a2 a3 b1 b2 b3 (read n)

solve 0 0 0 0 0 0 _ = "YES"
solve a1 a2 a3 b1 b2 b3 n = if div (a-1) 5 + div (b-1) 10 +2 <=n then "YES" else "NO"
	     where a=if a1+a2+a3 >0 then a1+a2+a3 else 1
	           b=if b1+b2+b3 >0 then b1+b2+b3 else 1

main = do
	as<-getLine
	bs<-getLine
	n<-getLine
	let [a1,a2,a3] =map read $ words as
	let [b1,b2,b3]= map read $ words bs
	putStrLn $ solve a1 a2 a3 b1 b2 b3 (read n)

solve a1 a2 a3 b1 b2 b3 n = if div (a-1) 5 + div (b-1) 10 +2 <=n then "YES" else "NO"
	     where a=if a1+a2+a3 >0 then a1+a2+a3 else 1
	           b=if b1+b2+b3 >0 then b1+b2+b3 else 1

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

main = do
  as <- getints
  bs <- getints
  n  <- getint
  let sumA = sum as
      needA = sumA `div` 5 + (if sumA `mod` 5 == 0 then 0 else 1)
      sumB = sum bs
      needB = sumB `div` 10 + (if sumA `mod` 10 == 0 then 0 else 1)
  if needA + needB > n then putStrLn "NO" else putStrLn "YES"

main :: IO ()
main = do
  sa <- getLine
  sb <- getLine
  sn <- getLine
  let suma = sum . map read $ words sa
      sumb = sum . map read $ words sb
      tot = ceiling ((/) suma 5) + ceiling ((/) sumb 10)
      n = read sn
      res = if tot <= n then "Yes" else "No"
  putStrLn res

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
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 #-}

main :: IO ()
main = do
  x <- sum.map readInt.B.words <$> B.getLine
  y <- sum.map readInt.B.words <$> B.getLine
  n <- readLn
  putStrLn.bool"YES""NO" $ solve n x y

solve :: Int -> Int -> Int -> Bool
solve n x y = (x+4)`div`5 + (x+9)`div`10 <= n

import Control.Applicative

calc a = div (sum a) 5 +(if mod (sum a) 5>0 then 1 else 0)

main=do
	a<-map read.words <$> getLine::IO [Int]
	b<-map read.words <$> getLine::IO [Int]
	c<- read <$> getLine::IO Int
	putStrLn $ if c>= calc a + calc b then "YES" else "NO"

module Main where

main = do
	line1 <- getLine
	line2 <- getLine
	line3 <- getLine
	let a = readIntList line1
	let b = readIntList line2
	let n = read line3 :: Int

	putStr $ result a b n

result a b n = sayYesNo $ ((ceiling' a' 10.0) + (ceiling' b' 10.0)) <= n
	where
		sayYesNo bool = if bool then "YES" else "NO"
		ceiling' s alpha = ceiling (toRational s / alpha)
		a' = sum a
		b' = sum b

readIntList :: String -> [Int]
readIntList = map read . words


Galois is one of the strongest chess players of Byteforces. He has even invented a new variant of chess, which he named «PawnChess».This new game is played on a board consisting of 8 rows and 8 columns. At the beginning of every game some black and white pawns are placed on the board. The number of black pawns placed is not necessarily equal to the number of white pawns placed.   Lets enumerate rows and columns with integers from 1 to 8. Rows are numbered from top to bottom, while columns are numbered from left to right. Now we denote as (r, c) the cell located at the row r and at the column c.There are always two players A and B playing the game. Player A plays with white pawns, while player B plays with black ones. The goal of player A is to put any of his pawns to the row 1, while player B tries to put any of his pawns to the row 8. As soon as any of the players completes his goal the game finishes immediately and the succeeded player is declared a winner.Player A moves first and then they alternate turns. On his move player A must choose exactly one white pawn and move it one step upward and player B (at his turn) must choose exactly one black pawn and move it one step down. Any move is possible only if the targeted cell is empty. It's guaranteed that for any scenario of the game there will always be at least one move available for any of the players.Moving upward means that the pawn located in (r, c) will go to the cell (r - 1, c), while moving down means the pawn located in (r, c) will go to the cell (r + 1, c). Again, the corresponding cell must be empty, i.e. not occupied by any other pawn of any color.Given the initial disposition of the board, determine who wins the game if both players play optimally. Note that there will always be a winner due to the restriction that for any game scenario both players will have some moves available.

The input consists of the board description given in eight lines, each line contains eight characters. Character 'B' is used to denote a black pawn, and character 'W' represents a white pawn. Empty cell is marked with '.'.  It's guaranteed that there will not be white pawns on the first row neither black pawns on the last row.

Print 'A' if player A wins the game on the given board, and 'B' if player B will claim the victory. Again, it's guaranteed that there will always be a winner on the given board.

NoteIn the first sample player A is able to complete his goal in 3 steps by always moving a pawn initially located at (4, 5). Player B needs at least 5 steps for any of his pawns to reach the row 8. Hence, player A will be the winner.

import Control.Monad

getMoves :: [Char] -> Char -> Int
getMoves [] _ = 8
getMoves column c
    | head column == c = 8 - length column
    | head column == '.' = getMoves (tail column) c
    | otherwise = 8

main = do
    rows <- forM [0..7] (\a -> getLine)

    let columns = [[row !! i | row <- rows] | i <- [0..7]]
        bestWhite = minimum [getMoves (columns !! i) 'W' | i <- [0..7]]
        bestBlack = minimum [getMoves (reverse (columns !! i)) 'B' | i <- [0..7]]

    if bestWhite <= bestBlack
        then putStrLn("A")
    else putStrLn("B")

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

z c l = let l' = takeWhile (/= c) l in if any (/='.') l' then 100 else length l'

s cs = minimum (map (z 'W') cs) <= minimum (map (z 'B' . reverse) cs)

p True = "A\n"
p False = "B\n"

main = interact $ p . s . transpose . lines

import Control.Applicative
import Data.List

myfind x n [] = 100
myfind x n (s:ss) | s==x = n+1
                  | s=='.'= myfind x  (n+1) ss
                  | otherwise =100

main= do
	s<- transpose. lines <$> getContents::IO [String]
	let w= minimum $ map (myfind 'W' 0) s
	let b= minimum $ map (myfind 'B' 0) (map reverse s)
	putStrLn $ if w<=b then "A" else "B"

import Control.Applicative
import Data.List

myfind x (s:ss) n = if elem x s then n else myfind x ss (n+1)

main= do
	s<- lines <$> getContents::IO [String]
	let w= (myfind 'W' s 1)-1
	let b= 8 - (myfind 'B' s 1)
	putStrLn $ if w<b then "A" else "B"

import Control.Applicative
import Data.List

myfind x (s:ss) n = if elem x s then n else myfind x ss (n+1)

main= do
	s<- lines <$> getContents::IO [String]
	let w= (myfind 'W' s 1)-1
	let b=   (myfind 'B' (reverse s) 1)-1
	putStrLn $ if w<b then "A" else "B"


You are given a string q. A sequence of k strings s1, s2, ..., sk is called beautiful, if the concatenation of these strings is string q (formally, s1 + s2 + ... + sk = q) and the first characters of these strings are distinct.Find any beautiful sequence of strings or determine that the beautiful sequence doesn't exist.

The first line contains a positive integer k (1 ≤ k ≤ 26) — the number of strings that should be in a beautiful sequence.  The second line contains string q, consisting of lowercase Latin letters. The length of the string is within range from 1 to 100, inclusive.

If such sequence doesn't exist, then print in a single line "NO" (without the quotes). Otherwise, print in the first line "YES" (without the quotes) and in the next k lines print the beautiful sequence of strings s1, s2, ..., sk. If there are multiple possible answers, print any of them.

NoteIn the second sample there are two possible answers: {"aaaca", "s"} and {"aaa", "cas"}.

import Control.Applicative
import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

findBeautiful :: Set.Set Char -> Int -> String -> Maybe [String]
findBeautiful _ _ [] = Nothing
findBeautiful set 1 (x:xs) = Just ([x:xs])
findBeautiful set k (x:xs) = Just ((x:prefix):) <*> findBeautiful (Set.insert x set) (k-1) remainder
	where
		(prefix, remainder) = span (\item -> item == x || item `Set.member` set) xs

main = do
	lns <- getLines 2

	let
		k = read $ lns !! 0 :: Int
		q = lns !! 1
		result = findBeautiful Set.empty k q

	case result of
		Nothing -> putStrLn "NO"
		Just xs -> mapM_ putStrLn $ "YES":xs

import Data.List (intercalate)
answer::Int->String->[String]
answer k q = trimData q $ takeOrNot k $ getTrueNumber $ getNotPrev $ q
getNotPrev::String -> [Bool]
getNotPrev q = map (\x -> not (elem (fst x) (snd x))) $ zip q $ map (\k -> take k q) [0..((length q)-1)]
getTrueNumber::[Bool] -> [Int]
getTrueNumber b = map snd $ filter fst $ zip b [0..]
takeOrNot ::Int -> [Int]-> [Int]
takeOrNot k a | (length a) < k = []
              | otherwise = take k a
trimData::String -> [Int] -> [String]
trimData q n | null n = []
             | (length n) == 1 = [q]
             | otherwise = [a]++trimData b nt
               where nh0 = head n
                     nt = tail n
                     nh1 = head nt
                     (a,b) = splitAt (nh1-nh0) q

printAnswer::[String] -> IO ()
printAnswer a = do
  if (null a)
    then putStrLn "NO"
    else do
           putStrLn "YES"
           putStrLn $ intercalate "\n" a
main = do
  w <- getLine
  let k = read w::Int
  q <- getLine
  printAnswer $ answer k q
  --print $ getNotPrev q

import Control.Monad

main = do
    input <- getLine
    let n = read input
    s <- getLine
    let ans = f s ""
    mapM_ putStrLn (yesOrNo n ans)

f :: String -> String -> [String]
f [] _ = []
f (x:xs) used =
    let xused = (x:used)
    in (x : takeWhile (`elem` xused) xs) : (f (dropWhile (`elem` xused) xs) xused)

yesOrNo :: Int -> [String] -> [String]
yesOrNo _ [] = []
yesOrNo n xs =
    if n-1 < length xs then
        "YES" : listToPrint n xs
    else
        ["NO"]

listToPrint :: Int -> [String] -> [String]
listToPrint n xs = (take (n-1) xs) ++ [rmsp $ unwords $ drop (n-1) xs]

rmsp :: String -> String
rmsp [] = ""
rmsp (x:xs) =
    if x == ' ' then rmsp xs
    else x : rmsp xs

main = do
    k <- getLine >>= return.read
    s <- getLine
    putStr $ solve k s

solve :: Int -> String -> String
solve k s = if k' < k then "NO" else "YES\r\n"
        ++(unlines
            $ (take (k-1) parts)++[concat $ drop (k-1) parts])
    where
        parts = so s []
        k' = length parts

so :: String -> [Char] -> [String]
so [] _ = []
so (x:xs) l = (x:cur):(so (drop (length cur) xs) l')
    where
    l' = x:l
    cur = takeWhile (`elem` l') xs

import Control.Applicative ((<$>))
import Control.Monad (replicateM, liftM, join, mapM_)

break' :: String -> [String] -> [String]
break' [] acc = acc
break' (h:rest) acc
    | any ((== h).last) acc = break' rest $ (h:head acc):tail acc
    | otherwise = break' rest $ [h]:acc

out :: [String] -> Int -> [String]
out tok k | length tok < k = ["NO"]
out tok k = "YES":init ++ [rest]
    where init = take (k - 1) tok
          rest = join $ drop (k - 1) tok

main = do
    let parse = reverse.(map reverse).(flip break' [])

    k <- read <$> getLine
    tok <- parse <$> getLine
    mapM_ putStrLn $ out tok k

import Data.List(nub, elemIndex, group)
import Data.Maybe(fromJust)

answer s n = n <= length (nub s)

splitNAux :: String -> Int -> String -> [String]
splitNAux s n [] = [s]
splitNAux s 0 _ = [""]
splitNAux s 1 _ = [s]
splitNAux s n (x:xs) = a : splitNAux b (n - 1) xs
    where pos = fromJust (elemIndex x s)
          (a, b) = splitAt pos s

splitN s n = splitNAux s n (tail lst)
             where lst = nub s

main = interact $ unlines . callAnswer . lines
       where callAnswer (ns:ss:_) =
                 let n = read ns
                 in
                 if answer ss n then
                     "YES":splitN ss n
                 else
                     ["NO"]

import Data.List

solve :: Int -> String -> Maybe [String]
solve n q = solveHelper [last q] n q
    where
    solveHelper :: [Char] -> Int -> String -> Maybe [String]
    solveHelper used n "" = Nothing
    solveHelper used 1 q = Just [q]
    solveHelper used n (q:qs)
        | q `elem` used = do
            (f:rest) <- solveHelper used n qs
            return ((q:f):rest)

        | otherwise = do
            rest <- solveHelper (q:used) (n-1) qs
            return ([q]:rest)

printAnswer :: Maybe [String] -> IO ()
printAnswer Nothing = putStrLn "NO"
printAnswer (Just xs) = do
    putStrLn "YES"
    putStrLn $ reverse $ intercalate "\n" xs

main = do
    n <- getLine
    q <- getLine
    printAnswer $ solve (read n :: Int) (reverse q)

import Control.Monad

-- doit s n seen current = a way to do it with n left (including current)
doit :: String -> Integer -> [Char] -> String -> Maybe [String]
doit [] 1 _ [] = Nothing
doit str 1 seen current = Just [current ++ str]
doit [] _ _ _ = Nothing
doit (c:cs) n seen current
  | c `elem` seen = doit cs n seen (current ++ [c])
  | otherwise = do
    tmp <- doit cs (n-1) (c:seen) [c]
    return (current:tmp)

main = do
  n <- readLn
  str <- getLine
  putStr $ case doit (tail str) n [head str] [head str] of
               Nothing -> "NO\n"
               Just ans -> unlines ("YES":ans)

import Control.Applicative
import Data.List

del x (y:ys) | x==y = ys
             | otherwise = y: (del x ys)

myprocess s _ 0 (x:xs) = reverse ((x++s): xs)
myprocess s s1 n x=  myprocess (dropWhile (\z-> notElem z s2) (tail s))  s2 (n-1) (((head s):(takeWhile (\z-> notElem z  s2) (tail s))):x)
		where s2 = del (head s ) s1

main= do
	n<- read <$> getLine ::IO Int
	s<-    getLine
	let s1 = map head $ group $ sort s
	putStrLn $ if length s1<n then "NO" else "YES"
	putStrLn $ intercalate "\n"  $ if length s1>=n then myprocess s s1 n [] else []

import Control.Applicative

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

findBeautiful :: Int -> String -> Maybe [String]
findBeautiful _ [] = Nothing
findBeautiful 1 (x:xs) = Just ([x:xs])
findBeautiful k (x:xs) = Just ((x:prefix):) <*> findBeautiful (k-1) remainder
	where (prefix, remainder) = span (== x) xs

main = do
	lns <- getLines 2

	let
		k = read $ lns !! 0 :: Int
		q = lns !! 1
		result = findBeautiful k q

	case result of
		Nothing -> putStrLn "NO"
		Just xs -> mapM_ putStrLn $ "YES":xs

import Data.List(nub, elemIndex, group)
import Data.Maybe(fromJust)

answer s n = n <= length (nub s)

splitNAux :: String -> Int -> String -> [String]
splitNAux s n [] = []
splitNAux s 0 _ = [s]
splitNAux s 1 _ = [s]
splitNAux s n (x:xs) = a : splitNAux b (n - 1) xs
    where pos = fromJust (elemIndex x s)
          (a, b) = splitAt pos s

splitN s n = splitNAux s n (tail lst)
             where lst = concatMap nub (group s)

main = interact $ unlines . callAnswer . lines
       where callAnswer (ns:ss:_) =
                 let n = read ns
                 in
                 if answer ss n then
                     "YES":splitN ss n
                 else
                     ["NO"]

import Data.List(nub, elemIndex)
import Data.Maybe(fromJust)

answer s n = n <= (length $ nub s)

splitNAux :: String -> Int -> String -> [String]
splitNAux s n [] = []
splitNAux s 0 _ = [s]
splitNAux s 1 _ = [s]
splitNAux s n (x:xs) = a : (splitNAux b (n - 1) xs)
    where pos = fromJust (elemIndex x s)
          (a, b) = splitAt pos s

splitN s n = splitNAux s n (tail $ nub s)

main = interact $ unlines . callAnswer . lines
       where callAnswer (ns:ss:_) =
                 let n = read ns
                 in
                 if answer ss n then
                     "YES":splitN ss n
                 else
                     ["NO"]

import Data.List

solve :: Int -> String -> Maybe [String]
solve = solveHelper []
    where
    solveHelper :: [Char] -> Int -> String -> Maybe [String]
    solveHelper used n "" = Nothing
    solveHelper used 1 q = Just [q]
    solveHelper used n (q:qs)
        | q `elem` used = do
            (f:rest) <- solveHelper used n qs
            Just ((q:f):rest)

        | otherwise = do
            rest <- solveHelper (q:used) (n-1) qs
            Just ([q]:rest)

printAnswer :: Maybe [String] -> IO ()
printAnswer Nothing = putStrLn "NO"
printAnswer (Just xs) = do
    putStrLn "YES"
    putStrLn $ reverse $ intercalate "\n" xs

main = do
    n <- getLine
    q <- getLine
    printAnswer $ solve (read n :: Int) (reverse q)

import Control.Applicative
import Data.List

del x (y:ys) | x==y = ys
             | otherwise = y: (del x ys)

myprocess s _ 0 (x:xs) = reverse ((x++s): xs)
myprocess s s1 n x=  myprocess (dropWhile (\z-> notElem z s2) (tail s))  s1 (n-1) (((head s):(takeWhile (\z-> notElem z  s2) (tail s))):x)
		where s2 = del (head s ) s1

main= do
	n<- read <$> getLine ::IO Int
	s<-    getLine
	let s1 = map head $ group $ sort s
	putStrLn $ if length s1<n then "NO" else "YES"
	putStrLn $ intercalate "\n"  $ if length s1>=n then myprocess s s1 n [] else []

import Control.Applicative
import Data.List

myprocess s _ 0 (x:xs) = reverse ((x++s): xs)
myprocess s s1 n x=  myprocess (dropWhile (\z-> notElem z s1) (tail s))  s1 (n-1) (((head s):(takeWhile (\z-> notElem z  s1) (tail s))):x)

main= do
	n<- read <$> getLine ::IO Int
	s<-    getLine
	let s1 = map head $ group $ sort s
	putStrLn $ if length s1<n then "NO" else "YES"
	putStrLn $ intercalate "\n"  $ if length s1>=n then myprocess s (take  n s1) n [] else []


Mr. Kitayuta has kindly given you a string s consisting of lowercase English letters. You are asked to insert exactly one lowercase English letter into s to make it a palindrome. A palindrome is a string that reads the same forward and backward. For example, "noon", "testset" and "a" are all palindromes, while "test" and "kitayuta" are not.You can choose any lowercase English letter, and insert it to any position of s, possibly to the beginning or the end of s. You have to insert a letter even if the given string is already a palindrome.If it is possible to insert one lowercase English letter into s so that the resulting string will be a palindrome, print the string after the insertion. Otherwise, print "NA" (without quotes, case-sensitive). In case there is more than one palindrome that can be obtained, you are allowed to print any of them.

The only line of the input contains a string s (1 ≤ |s| ≤ 10). Each character in s is a lowercase English letter.

If it is possible to turn s into a palindrome by inserting one lowercase English letter, print the resulting string in a single line. Otherwise, print "NA" (without quotes, case-sensitive). In case there is more than one solution, any of them will be accepted.

NoteFor the first sample, insert 'r' to the end of "revive" to obtain a palindrome "reviver".For the second sample, there is more than one solution. For example, "eve" will also be accepted.For the third sample, it is not possible to turn "kitayuta" into a palindrome by just inserting one letter.

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

main = interact $ sol . head . lines

isPar s = reverse s == s

getNS s p c = p1 ++ [c] ++ p2
	where (p1, p2) = splitAt p s

sol x =	maybe "NA" id $ find isPar [getNS x p c | p <- [0 .. length x], c <- ['a' .. 'z']]

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
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 qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  s <- getLine

  let
    check s = and $ zipWith (==) s (reverse s)
    ss = [s | i <- [0..length s], let (s1, s2) = splitAt i s, c <- ['a'..'z'], let s = s1 ++ [c] ++ s2, check s]

  putStrLn $ if null ss then "NA" else head ss

import Control.Applicative

main = getLine >>= putStrLn . solve

solve :: String -> String
solve s = head . (++ ["NA"]) . filter ((==) <*> reverse) $ rs
    where rs = [take i s ++ [c] ++ drop i s | i <- [0..length s], c <- ['a'..'z']]

import Control.Monad
import Control.Applicative
import Data.Monoid
import qualified Data.Map as M
import qualified Data.IntMap as I

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

toOutput :: Maybe String -> String
toOutput = maybe "NA" id

solve :: String -> Maybe String
solve s = getFirst $ mconcat $ map (toPal s) [0..length s]

toPal :: String -> Int -> First String
toPal s i = First ans
          where
            ans = if isPal newString
                  then (Just newString)
                  else Nothing
            newString = take i s ++ [c'] ++ drop i s
            c' = if i == length newString `div` 2
                 then 'a'
                 else newString !! (length newString - 1-i)

isPal s = s == reverse s

main = interact $ a . filter h . concat . f . concat . lines
f x = map (g [] x) ['a'..'z']
g l [] c = [l ++ [c]]
g l s@(x:xs) c = (l ++ c:s):(g (l ++ [x]) xs c)
h s = s == (reverse s)
a [] = "NA"
a x = head x

main = interact $ a . filter h . concat . f . lines
f [x] = map (g [] x) ['a'..'z']
g l [] c = [l ++ [c]]
g l s@(x:xs) c = (l ++ c:s):(g (l ++ [x]) xs c)
h s = s == (reverse s)
a [] = "NA"
a x = head x

import Data.Functor ((<$>))
import Data.List (inits, tails)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = putStrLn =<< fromMaybe "NA" . solve <$> getLine

solve :: String -> Maybe String
solve xs = listToMaybe [ as ++ [b] ++ cs | (as, cs) <- zip (inits xs) (tails xs), b <- ['a'..'z'], isPalindrome $ as ++ [b] ++ cs ]

isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = all (uncurry (==)) $ zip xs (reverse xs)

import Data.Functor ((<$>))
import Data.List (inits, tails)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = putStrLn =<< fromMaybe "NA" . solve <$> getLine

solve :: String -> Maybe String
solve xs = listToMaybe [ as ++ [b] ++ cs | (as, cs) <- zip (inits xs) (tails xs), b <- ['a'..'z'], isPalindrome $ as ++ [b] ++ cs ]

isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = xs == reverse xs

main = do
  str <- getLine
  case mkPalindrome str of
    Just str' -> putStrLn str'
    Nothing -> putStrLn "NA"

mkPalindrome :: String -> Maybe String
mkPalindrome str = if isPalindrome s1
                   then Just s1
                   else if isPalindrome s2
                        then Just s2
                        else Nothing
  where
    len = length str
    front = take (len `div` 2) str
    back  = drop (len `div` 2) str
    ((s1f, s1b), (s2f, s2b)) = insertCharIfNec front (reverse back)
    s1 = s1f ++ reverse s1b
    s2 = s2f ++ reverse s2b

insertCharIfNec :: String -> String -> ((String, String), (String, String))
insertCharIfNec (a:as) (b:bs)
    | a == b = let ((s1f, s1b), (s2f, s2b)) = insertCharIfNec as bs
               in ((a:s1f, b:s1b), (a:s2f, b:s2b))
    | otherwise = ((b:a:as, b:bs),
                   (a:as, a:b:bs))
insertCharIfNec "" "" = (("", "y"), ("", "y"))
insertCharIfNec "" s = ((s, s), (s, s))

isPalindrome :: String -> Bool
isPalindrome str = go front back
  where
    len = length str
    front = take (len `div` 2) str
    back  = take (len `div` 2) (reverse str)
    go (a:as) (b:bs) | a == b = go as bs
                     | otherwise = False
    go [] [] = True

main = getLine >>= putStrLn . solve
solve [] = "a"
solve [x] = [x, x]
solve (x:xs) | (x == last xs) && (st /= "NA")  = x : st ++ [last xs]
             | (x == last xs) && (st == "NA") = "NA"
             | isPalindrome v1 = v1
             | isPalindrome v2 = v2
             | otherwise = "NA"
    where st = solve $ init xs
          v1 = x:xs++[x]
          v2 = last xs : x : xs
          isPalindrome s = s == reverse s

import Control.Applicative
import System.IO

inserts :: a -> [a] -> [[a]]
inserts x []       = [[x]]
inserts x l@(y:ys) = (x:l) : ((fmap (y:)) $ inserts x ys)

isPalin :: Eq a => [a] -> Bool
isPalin s = reverse s == s

main :: IO()
main = do
  s <- getLine
  case filter isPalin $ concat $ fmap ($ s) $ fmap inserts ['a'..'z'] of
    [] -> putStrLn "NA"
    (x:xs) -> putStrLn x

#!/usr/bin/env runghc
import Data.Maybe
main = getContents >>= mapM_ putStrLn . solve . lines
solve = map f
f::String->String
f s
  | null a = "NA"
  | otherwise = fromJust . head $ a
  where
  a = dropWhile isNothing . map g $ [0..n]
  n = length s
  g::Int->Maybe String
  g i
    | n-i>i  = p $ t ++ ((s!!(n-i-1)) : d)
    | n-i<i  = p $ t ++ ((s!!(n-i)) : d)
    | otherwise = p $ t ++ ('a' : d)
    where (t,d) = splitAt i s
p::String->Maybe String
p s = if s==reverse s then Just s else Nothing

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
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 qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  s <- getLine

  let
    check s = and $ zipWith (==) s (reverse s)
    ss = [s | i <- [0..length s], let (s1, s2) = splitAt i s, c <- ['a'..'z'], let s = s1 ++ [c] ++ s2, check s]

  print ss
  putStrLn $ if null ss then "NA" else head ss

main = interact $ a . filter h . concat . f
f x = map (g [] x) ['a'..'z']
g l [] c = [l ++ [c]]
g l s@(x:xs) c = (l ++ c:s):(g (l ++ [x]) xs c)
h s = s == (reverse s)
a [] = "NA"
a x = head x


Calvin the robot lies in an infinite rectangular grid. Calvin's source code contains a list of n commands, each either 'U', 'R', 'D', or 'L' — instructions to move a single square up, right, down, or left, respectively. How many ways can Calvin execute a non-empty contiguous substrings of commands and return to the same square he starts in? Two substrings are considered different if they have different starting or ending indices.

The first line of the input contains a single positive integer, n (1 ≤ n ≤ 200) — the number of commands. The next line contains n characters, each either 'U', 'R', 'D', or 'L' — Calvin's source code.

Print a single integer — the number of contiguous substrings that Calvin can execute and return to his starting square.

NoteIn the first case, the entire source code works, as well as the "RL" substring in the second and third characters.Note that, in the third case, the substring "LR" appears three times, and is therefore counted three times to the total result.

module Main where

import Data.List

move :: (Int, Int) -> Char -> (Int, Int)
move (x, y) 'U' = (x, y - 1)
move (x, y) 'D' = (x, y + 1)
move (x, y) 'L' = (x - 1, y)
move (x, y) 'R' = (x + 1, y)

identity :: [Char] -> Bool
identity moves = (foldl move (0, 0) moves) == (0, 0)

solve :: String -> Int
solve moves = length . filter id $ [identity ps | s <- ss, ps <- tail (inits s)]
    where ss = init $ tails moves

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

import Data.List
import Data.List.Split

solve s = length [(i, j) | i <- [0..(n-1)], j <- [i..(n-1)], f i j]
    where n = length s
          val 'U' = (1, 0)
          val 'D' = (-1, 0)
          val 'L' = (0, 1)
          val 'R' = (0, -1)
          tsum (a, b) (c, d) = (a+c, b+d)
          subsum i j = foldl tsum (0, 0) $ map val $ take (j-i+1) $ drop i s
          f i j = (subsum i j) == (0, 0)

main = do
    str1 <- getLine
    str2 <- getLine
    putStrLn $ show $ solve str2

import Data.Char

allSubstrings :: String -> [String]
allSubstrings s = concat $ map allPrefixes $ allSuffixes s

allSuffixes :: String -> [String]
allSuffixes [] = []
allSuffixes s = let x : xs = s in s : allSuffixes xs

allPrefixes :: String -> [String]
allPrefixes s = map reverse $ allSuffixes $ reverse $ s

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

charShift :: Char -> (Int,Int)
charShift 'U' = (1, 0)
charShift 'R' = (0, 1)
charShift 'D' = (-1, 0)
charShift 'L' = (0, -1)

strShift :: String -> (Int,Int)
strShift [] = (0,0)
strShift (x:xs) =
    let (x1,y1) = charShift x
        (x2,y2) = strShift xs
    in (x1 + x2, y1 + y2)

count :: String -> Int
count s = foldl (\answer subStr -> answer + (if strShift subStr == (0,0) then 1 else 0)) 0 $ allSubstrings s

main = do
    contents <- getContents
    let contentsWords = words contents
    let [_,source] = contentsWords
    print $ count source

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Main where
import qualified Data.Map    as Map
import           Data.Monoid

move ::Num a=>Char -> (a, a)
move 'D' = ( 0,-1)
move 'U' = ( 0, 1)
move 'L' = (-1, 0)
move 'R' = ( 1, 0)
move _   = ( 0, 0)

solution::forall a.Integral a=>String->a
solution = combine where
  psum (a,b)           = (Sum a, Sum b)
  unsum (Sum a, Sum b) = (a, b)
  start = psum ((0, 0)::(a,a))
  points = map ((,1) .unsum) . scanl (<>) start . map (psum . move)
  comb2 a = a * (a - 1) `div` 2::a
  combine = sum . map comb2 . Map.elems . Map.fromListWith (+) . points

main:: IO ()
main = getLine >> getLine >>= print . (solution::String->Integer)

module Main where
import Data.List
import Control.Applicative

f (u,d,l,r) [] = u==d && l==r
f (u,d,l,r) (a:as)
    | a == 'U' = f (u+1, d, l, r) as
    | a == 'D' = f (u, d+1, l, r) as
    | a == 'L' = f (u, d, l+1, r) as
    | a == 'R' = f (u, d, l, r+1) as

main = do
    getLine
    print =<< length . filter (f (0,0,0,0)) .  concat . map (init. tails )  . tail . inits <$> getLine

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

update :: (Int,Int) -> Char -> (Int,Int)
update (a,b) c
  | c == 'U' = (a+1,b)
  | c == 'D' = (a-1,b)
  | c == 'L' = (a,b-1)
  | c == 'R' = (a,b+1)

main :: IO ()
main = do
  n <- readLn :: IO Int
  str <- getLine
  let things = scanl update (0,0) str
      m_things = M.fromListWith (+) [(t,1) | t <- things]
      m_oper = M.map (\n -> div (n*(n-1)) 2) m_things
      ans = M.fold (+) 0 m_oper :: Int
  print ans
  return ()

import Data.List (group, sort)

main :: IO ()
main = print . solve . parse . lines =<< getContents

type Input = String

parse :: [String] -> Input
parse [_, s] = s
parse _ = undefined

delta :: Char -> (Int, Int)
delta 'U' = (0, 1)
delta 'R' = (1, 0)
delta 'D' = (0, -1)
delta 'L' = (-1, 0)
delta _ = undefined

solve :: Input -> Int
solve = sum . map count . group . sort . scanl step (0, 0)
    where step (x, y) c = let (x', y') = delta c in (x + x', y + y')
          count a = let n = length a in n * (n - 1) `div` 2


Kavi has $$$2n$$$ points lying on the $$$OX$$$ axis, $$$i$$$-th of which is located at $$$x = i$$$.Kavi considers all ways to split these $$$2n$$$ points into $$$n$$$ pairs. Among those, he is interested in good pairings, which are defined as follows:Consider $$$n$$$ segments with ends at the points in correspondent pairs. The pairing is called good, if for every $$$2$$$ different segments $$$A$$$ and $$$B$$$ among those, at least one of the following holds:  One of the segments $$$A$$$ and $$$B$$$ lies completely inside the other.  $$$A$$$ and $$$B$$$ have the same length. Consider the following example:  $$$A$$$ is a good pairing since the red segment lies completely inside the blue segment.$$$B$$$ is a good pairing since the red and the blue segment have the same length.$$$C$$$ is not a good pairing since none of the red or blue segments lies inside the other, neither do they have the same size.Kavi is interested in the number of good pairings, so he wants you to find it for him. As the result can be large, find this number modulo $$$998244353$$$.Two pairings are called different, if some two points are in one pair in some pairing and in different pairs in another.

The single line of the input contains a single integer $$$n$$$ $$$(1\le n \le 10^6)$$$.

Print the number of good pairings modulo $$$998244353$$$.

NoteThe good pairings for the second example are:   In the third example, the good pairings are:

-- dp(n) = 2^(n- 1) + D(n) + D(n - 1)  + 2 * D(D - 2)  + 4 * D(n - 3) + 8 * D(n - 4) + ... + 2^(n-2)D(1) - 2^(n-1)

-- dp(3) = 2 + 2 + 2 * 1
-- dp(2) = 2 + 1
-- dp(1) =
--
--
import Data.Int (Int64)
import qualified Data.Array as A

main = do
    n <- read <$> getLine
    print $ solve n

m = 998244353
solve :: Int -> Int
solve n = foldl1 (\x y -> let t = x + y in if t < m then t else t - m) (map calc [1..n])
     where calc k = mul (if x >= 0 then x else x + m) (minv (mpow A.! k - 1) m) + d
             where d = if n `rem` k == 0 then 1 else 0
                   x = mpow A.! (n - 1) -  mpow A.! ((n - 1) `rem` k)

mpow = A.listArray (0,1000000) l
    where l = 1:map (\x -> let t = 2 * x in if t < m then t else t - m) l

minv :: Int -> Int -> Int
minv 1 _ = 1
minv a b = b + fromIntegral (quot (1 - t * fromIntegral  b) (fromIntegral a))
         where t = fromIntegral (minv (b `rem` a) a) :: Int64

mul :: Int -> Int -> Int
mul a b = fromIntegral (x * y `rem` fromIntegral m)
        where x = fromIntegral a :: Int64
              y = fromIntegral b :: Int64

import Data.Maybe
import Data.Int
import Data.Foldable
import qualified Data.ByteString.Char8 as C
import Data.Array.Base
import Data.Array.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

kMod :: Int
kMod = 998244353

toInt64 :: Int -> Int64
toInt64 = fromIntegral

fromInt64 :: Int64 -> Int
fromInt64 = fromIntegral

newtype Mint = Mint { mint :: Int }
  deriving (Eq, Ord)
instance Num Mint where
  (Mint a) + (Mint b) = Mint (let c = a + b in if c >= kMod then c - kMod else c)
  (Mint a) - (Mint b) = Mint a + Mint (kMod - b)
  (Mint a) * (Mint b) = Mint $ fromInt64 $ (toInt64 a * toInt64 b) `mod` (toInt64 kMod)
  fromInteger n = Mint (fromIntegral $ n `mod` fromIntegral kMod)
instance Show Mint where show = show . mint

main :: IO ()
main = do
  n <- fmap parseInt C.getLine
  prime <- newArray_ (0, n) :: IO (IOUArray Int Int)
  tau <- newArray_ (0, n) :: IO (IOUArray Int Int)
  unsafeWrite tau 1 1
  forM_ [2..n] $ \i -> do
    p <- unsafeRead prime i
    if p /= 0
      then do
        t1 <- unsafeRead tau p
        let f y = if y `mod` p == 0 then let (a, b) = f (y `div` p) in (a, b + 1) else (y, 0)
            (x, c) = f i
        t2 <- unsafeRead tau x
        unsafeWrite tau i ((c + 1) * t2)
        return ()
      else do
        unsafeWrite tau i 2
        forM_ [2 * i, 3 * i .. n] $ \j -> do
          unsafeWrite prime j i
  let func :: Int -> IO (Mint, Mint)
      func 1 = return (1, 0)
      func x = do
        (f', t') <- func (x - 1)
        t <- fmap (Mint . (subtract 1)) $ unsafeRead tau x
        return $ (2 * f' - t' + t, t)
  result <- fmap fst $ func n
  putStrLn $ show result

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

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

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

md :: Int64
md = 998244353

newtype MInt = MInt Int64 deriving Eq

instance Show MInt where
    show (MInt a) = show a

instance Num MInt where
    (MInt a) + (MInt b) =
        let r = a + b in
            MInt $ if r >= md then r - md else r
    (MInt a) * (MInt b) = MInt $ (a * b) `mod` md
    abs = id
    signum (MInt a) = MInt $ signum a
    fromInteger a = MInt $ fromInteger (a `mod` fromIntegral md)
    negate (MInt 0) = 0
    negate (MInt a) = MInt $ md - a

instance Fractional MInt where
  recip a = a ^ (md - 2)
  fromRational x =
        let a = numerator x `mod` fromIntegral md
            b = denominator x `mod` fromIntegral md
        in
            MInt (fromInteger a) / MInt (fromInteger b)

solve :: Int -> MInt
solve n =
    let ds = [t | i <- [1..n], t <- [i,i+i..n]]
        da = accumArray (\t _ -> t + 1) 0 (1,n) (zip ds (repeat ())) :: UArray Int Int
        d = map fromIntegral $ elems da
    in
        fst $ foldl' (\(_, s) t -> (s + t, s + s + t)) (0,0) d

main = do
    n <- parseInt <$> BS.getLine
    print $ solve n

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed

p :: Int
p = 998244353

data LoopVal = LoopVal !Int !Int

step :: LoopVal -> Int -> LoopVal
step (LoopVal _ai psum) currFactors = let
  nai = rem (currFactors - 1 + psum) p
  npsum = rem (nai + psum) p
  in  LoopVal nai npsum

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  let
    factors :: UArray Int Int
    factors = accumArray (\ct _ -> ct + 1) 0 (1, n)
      $ [(j, ()) | i <- [1 .. n], j <- [i, 2*i .. n]]
    LoopVal ans _ = foldl' step (LoopVal 1 1) $ elems factors
  --putInts $ elems factors
  putInts [ans]

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Gennady owns a small hotel in the countryside where he lives a peaceful life. He loves to take long walks, watch sunsets and play cards with tourists staying in his hotel. His favorite game is called "Mau-Mau".To play Mau-Mau, you need a pack of $$$52$$$ cards. Each card has a suit (Diamonds — D, Clubs — C, Spades — S, or Hearts — H), and a rank (2, 3, 4, 5, 6, 7, 8, 9, T, J, Q, K, or A).At the start of the game, there is one card on the table and you have five cards in your hand. You can play a card from your hand if and only if it has the same rank or the same suit as the card on the table.In order to check if you'd be a good playing partner, Gennady has prepared a task for you. Given the card on the table and five cards in your hand, check if you can play at least one card.

The first line of the input contains one string which describes the card on the table. The second line contains five strings which describe the cards in your hand. Each string is two characters long. The first character denotes the rank and belongs to the set $$$\{{\tt 2}, {\tt 3}, {\tt 4}, {\tt 5}, {\tt 6}, {\tt 7}, {\tt 8}, {\tt 9}, {\tt T}, {\tt J}, {\tt Q}, {\tt K}, {\tt A}\}$$$. The second character denotes the suit and belongs to the set $$$\{{\tt D}, {\tt C}, {\tt S}, {\tt H}\}$$$. All the cards in the input are different.

If it is possible to play a card from your hand, print one word "YES". Otherwise, print "NO". You can print each letter in any case (upper or lower).

NoteIn the first example, there is an Ace of Spades (AS) on the table. You can play an Ace of Diamonds (AD) because both of them are Aces.In the second example, you cannot play any card.In the third example, you can play an Ace of Diamonds (AD) because it has the same suit as a Four of Diamonds (4D), which lies on the table.

import Data.Set

main = do
  n <- getLine
  l <- fmap (Prelude.map show) getLine :: IO [String]
  let s = fromList l
  putStrLn( if (Data.Set.member (show $ (head n)) s) || (Data.Set.member (show $ (last n)) s) then "YES" else "NO" )

{-# LANGUAGE Strict #-}

module Main where

import           Data.List (elem)
import           System.IO

some :: String -> [String] -> Bool
some _ [] = False
some oneCard (x:xs) = elem (head oneCard) x || elem (last oneCard) x || some oneCard xs

main :: IO ()
main = do
  oneCard <- getLine
  myCards <- getLine
  let myCard = words myCards
  case some oneCard myCard of
    True -> putStrLn "YES"
    _    -> putStrLn "NO"

import System.IO (readFile, getLine)
import Data.Char (digitToInt)
import Data.List (intercalate)

data Suite = D | C | S | H deriving (Show, Eq)
data Rank = Rank Int deriving (Show, Eq, Ord)
data Card = Card Suite Rank deriving (Show, Eq)

checkCard :: Card -> Card -> Bool
checkCard (Card s r) (Card s2 r2) | s == s2 = True
                                  | r == r2 = True
                                  | otherwise = False

rankFromChar c | c == 'T' = Rank 10
               | c == 'J' = Rank 11
               | c == 'Q' = Rank 12
               | c == 'K' = Rank 13
               | c == 'A' = Rank 14
               | otherwise = Rank (digitToInt c)

suiteFromChar c | c == 'D' = D
                | c == 'C' = C
                | c == 'S' = S
                | c == 'H' = H

cardFromString s = let second x = head (tail x) in Card (suiteFromChar $ second s) (rankFromChar $ head s)

cardsFromString s = map cardFromString (words s)

calculate :: Card -> [Card] -> Bool
calculate tbl hold = any (checkCard tbl) hold

main = do
    tbl_s <- getLine
    hold_s <- getLine
    case calculate (cardFromString tbl_s) (cardsFromString hold_s) of
        True -> putStrLn "Yes"
        False -> putStrLn "No"

{-# LANGUAGE BlockArguments #-}

import Control.Arrow

main = do { x <- getLine; y <- getLine; putStrLn $ solve x (words y) }

canPlay :: String -> String -> String
canPlay x y | x!!0 == y!!0 || x!!1 == y!!1 = "YES"
            | x!!0 /= y!!0 && x!!1 /= y!!1 = "NO"

canPlayAgg :: String -> String -> String -> String
canPlayAgg a b "YES" = "YES"
canPlayAgg a b "NO" = canPlay a b

solve :: String -> [String] -> String
solve a b = foldr (canPlayAgg a) "NO" b

main = getContents >>= putStrLn . solve . words

solve ([x1,x2]:s)
    | any (\[s1,s2] -> x1 == s1 || x2 == s2) s = "YES"
    | otherwise = "NO"

import Control.Monad

main = getTwoLines >>= putStrLn . canPlay

getTwoLines :: IO (String, String)
getTwoLines = liftM2 toTuple getLine getLine
  where toTuple a b = (a, b)

canPlay :: (String, String) -> String
canPlay ([tRank, tSuit], hand) =
  case any canPlay' cards of
    True -> "yes"
    _ -> "no"
  where cards = words hand
        canPlay' [hRank, hSuit] = tRank == hRank || tSuit == hSuit

import Text.Printf
import Data.List
import Data.Functor
import Control.Monad
import Prelude

main :: IO ()
main = do
    myCard@[myRank, mySuit] <- getLine
    cards <- words <$> getLine
    let answer = any (\[rank, suit] -> rank == myRank || suit == mySuit) cards
    printf "%s" $ if answer then "YES" else "NO"

import Control.Monad

cardsForPlayer = 5
cardsForStartGame = cardsForPlayer + 1

getSuit = ["D", "C", "S", "H"]
getRank = ["2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K", "A"]

getAllPairs :: [String] -> [String] -> [String]
getAllPairs xs zs = liftM2 (++) xs zs

pickCards :: [Int] -> [String] -> [String]
pickCards pick cards = aggregateCards pick cards []
  where aggregateCards [] _ res = res
        aggregateCards (x:xs) cards res =
          let card = cards!!x
              cardsWithoutPicked = (take x cards) ++ (drop (x+1) cards)
          in aggregateCards xs cardsWithoutPicked (card:res)

makeGameState :: [String] -> (String, [String])
makeGameState (x:xs) = (x, xs)

randomCards = [3, 5, 6, 12, 15, 40]

solve :: (String, [String]) -> String
solve (tableCard, (x:xs))
  | head tableCard == head x || last tableCard == last x = "YES"
  | xs == [] = "NO"
  | otherwise = solve (tableCard, xs)

getList :: IO [String]
getList = do
  line <- getLine
  return $ words line

main :: IO ()
main = do
   cardOnTable <- getLine
   playerCards <- getList
   putStrLn $ solve (cardOnTable, playerCards)

import Data.List
main = interact $ solve . lines
solve [t,h] | not (null (intersect t (concat (words h)))) = "YES"
            | otherwise = "NO"

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified  Data.Set as S

main = do

	n1<-  S.fromList <$> getLine
	n2<-  S.fromList <$> getLine
	putStrLn  $ if S.disjoint n1 n2 then "NO" else "YES"

--ghc 7.10

isCompatible :: String -> String -> Bool
isCompatible (suit1:rank1:_) (suit2:rank2:_) = (suit1 == suit2) || (rank1 == rank2)
isCompatible _ _ = False

isPlay :: String -> [String] -> Bool
isPlay tCard hCards = any (isCompatible tCard) hCards

output = ["NO","YES"]

main = do
    tCard <- getLine
    line <- getLine
    let hCards = words line
    putStrLn $ output !! (fromEnum $ isPlay tCard hCards)

solve t cs  | xs /= [] || ys /= []  = "YES"
            | otherwise             = "NO"
            where
                xs = filter (==head t) [head c | c <- cs]
                ys = filter (==last t) [last c | c <- cs]

main = do
    t <- getLine
    line <- getLine
    let cs = words line
    putStrLn $ solve t cs

import Data.Set

main = do
  n <- getLine
  l <- fmap (Prelude.map show) getLine :: IO [String]
  let s = fromList l
  putStrLn( show $ if (Data.Set.member (show $ (head n)) s) || (Data.Set.member (show $ (last n)) s) then "YES" else "NO" )

{-# LANGUAGE Strict #-}

module Main where

import           Data.List (elem)
import           System.IO

some :: String -> [String] -> Bool
some _ [] = False
some oneCard (x:xs) = elem (head oneCard) x || elem (last oneCard) x || some oneCard xs

main :: IO ()
main = do
  oneCard <- getLine
  myCards <- getLine
  let myCard = words myCards
  case some oneCard myCard of
    True -> print "YES"
    _    -> print "NO"


Grandma Laura came to the market to sell some apples. During the day she sold all the apples she had. But grandma is old, so she forgot how many apples she had brought to the market.She precisely remembers she had n buyers and each of them bought exactly half of the apples she had at the moment of the purchase and also she gave a half of an apple to some of them as a gift (if the number of apples at the moment of purchase was odd), until she sold all the apples she had.So each buyer took some integral positive number of apples, but maybe he didn't pay for a half of an apple (if the number of apples at the moment of the purchase was odd).For each buyer grandma remembers if she gave a half of an apple as a gift or not. The cost of an apple is p (the number p is even).Print the total money grandma should have at the end of the day to check if some buyers cheated her.

The first line contains two integers n and p (1 ≤ n ≤ 40, 2 ≤ p ≤ 1000) — the number of the buyers and the cost of one apple. It is guaranteed that the number p is even. The next n lines contains the description of buyers. Each buyer is described with the string half if he simply bought half of the apples and with the string halfplus if grandma also gave him a half of an apple as a gift. It is guaranteed that grandma has at least one apple at the start of the day and she has no apples at the end of the day.

Print the only integer a — the total money grandma should have at the end of the day. Note that the answer can be too large, so you should use 64-bit integer type to store it. In C++ you can use the long long integer type and in Java you can use long integer type.

NoteIn the first sample at the start of the day the grandma had two apples. First she sold one apple and then she sold a half of the second apple and gave a half of the second apple as a present to the second buyer.

half (a, b) p = (2 * a, b + a * p)
halfplus (a, b) p = (2 * a + 1, b + a * p + div p 2)

solve [] p = (0, 0)
solve (x:xs) p
    | (x == "half") = half (solve xs p) p
    | otherwise = halfplus (solve xs p) p

main = do
    content <- getContents
    let w = words content
    let p = read (w !! 1) :: Integer
    let res = solve (drop 2 w) p
    putStrLn . show . snd $ res

import Control.Monad (replicateM)
import Data.Int (Int64)

main = do
  [n, p] <- fmap (map read . words) getLine
  hs <- replicateM n getLine

  let
    p' = fromIntegral p :: Int64
    count n [] = p'*n `div` 2
    count n (h:hs) =
      (p'*n `div` 2) + if h == "half" then count (2*n) hs else count (2*n+1) hs

  print $ count (1 :: Int64) $ tail $ reverse hs

import Data.List

data Divisional = Divisional {numerator :: Integer, denominator :: Integer}
                deriving (Show)

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

readBuyer :: Integer -> [String] -> IO([String])
readBuyer 0 buyers = return buyers
readBuyer a buyers = do
    buyer <- getLine
    readBuyer (a - 1) (buyer:buyers)

traceApple :: Integer -> Integer
traceApple a = 2 * a

tracePApple :: Integer -> Integer
tracePApple a = (2 * a) + 1

traceMoney :: Integer -> Integer -> Integer -> Integer
traceMoney money apple price = money + (apple * price * 2)

tracePMoney :: Integer -> Integer -> Integer -> Integer
tracePMoney money apple price = money + (apple * price * 2 + price)

solution :: Integer -> Integer -> Integer -> [String] -> Integer
solution _ currentMoney _ [] = currentMoney
solution currentApple currentMoney p ("halfplus":xs) = solution (tracePApple currentApple) (tracePMoney currentMoney currentApple p) p xs
solution currentApple currentMoney p ("half":xs) = solution (traceApple currentApple) (traceMoney currentMoney currentApple p) p xs

main :: IO()
main = do
    args <- getLine
    let (n:p:[]) = readInteger `map` (words args)
    buyers <- readBuyer (n - 1) []
    putStrLn $ show $ solution 1 (div p 2) (div p 2) buyers

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function
-- import           Data.Array
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Char8 as C
-- import           Data.ByteString.Char8 ()
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

myread = read :: String -> Int
toint64 = fromIntegral :: Int -> Int64
main = do
  [n,p] <- map myread.words <$> getLine
  ns <- replicateM n getLine
  print $ solve (toint64 p) ns

solve :: Int64 -> [String] -> Int64
solve p ns = p`div`2 * go 0 0 (map ((==4).length) $ reverse ns) where
  go :: Int64 -> Int64 -> [Bool] -> Int64
  go v w [] = w
  go v w (True:xs) = go (v*2) (w+(v*2)) xs
  go v w (False:xs) = go (v*2+1) (w+(v*2+1)) xs

half (a, b) p = (2 * a, b + a * p)
halfplus (a, b) p = (2 * a + 1, b + a * p + div p 2)

solve [] p = (0, 0)
solve (x:xs) p
    | (x == "half") = half (solve xs p) p
    | otherwise = halfplus (solve xs p) p

main = do
    content <- getContents
    let w = words content
    let p = read (w !! 1) :: Int
    let res = solve (drop 2 w) p
    putStrLn . show . snd $ res

import Control.Monad (replicateM)

main = do
  [n, p] <- fmap (map read . words) getLine
  hs <- replicateM n getLine

  let
    count n [] = p*n `div` 2
    count n (h:hs) =
      (p*n `div` 2) + if h == "half" then count (2*n) hs else count (2*n+1) hs

  print $ count 1 $ tail $ reverse hs

import Data.List

data Divisional = Divisional {numerator :: Integer, denominator :: Integer}
                deriving (Show)

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

readBuyer :: Integer -> [String] -> IO([String])
readBuyer 0 buyers = return buyers
readBuyer a buyers = do
    buyer <- getLine
    readBuyer (a - 1) (buyer:buyers)

traceApple :: Integer -> Integer
traceApple a = 2 * a

tracePApple :: Integer -> Integer
tracePApple a = (2 * a) + 1

traceMoney :: Integer -> Integer -> Integer -> Integer
traceMoney money apple price = money + (apple * price * 2)

tracePMoney :: Integer -> Integer -> Integer -> Integer
-- tracePMoney money apple price = money + (price * (apple * 4)) - price
tracePMoney money apple price = result
    where actualPrice = price * 2
          appleBought = apple * 2
          bonus = price
          result = actualPrice * appleBought - bonus

solution :: Integer -> Integer -> Integer -> [String] -> Integer
solution _ currentMoney _ [] = currentMoney
solution currentApple currentMoney p ("halfplus":xs) = solution (tracePApple currentApple) (tracePMoney currentMoney currentApple p) p xs
solution currentApple currentMoney p ("half":xs) = solution (traceApple currentApple) (traceMoney currentMoney currentApple p) p xs

main :: IO()
main = do
    args <- getLine
    let (n:p:[]) = readInteger `map` (words args)
    buyers <- readBuyer (n - 1) []
    putStrLn $ show $ solution 1 (div p 2) (div p 2) buyers