只有第五个测试点过不了,但是已经按照其他帖子说的,去掉了多余的空白字符,还是不行 orz。
{-# LANGUAGE LambdaCase #-}
import Prelude hiding (error)
import Data.List (intercalate)
import Control.Applicative ( Alternative(..), optional )
import Control.Monad.State.Lazy ( void, MonadState(get, put) )
import Text.Printf (printf)
type Range = (Int, Int)
type InputStream = (Int, [(Int, Char)])
type ParserResult error object
= Either (Maybe (SyntaxError error)) (Parsed object)
data SyntaxError error = SyntaxError Int error
deriving Show
data Parsed object = Parsed Range object InputStream
deriving Show
newtype Parser error object = Parser {
parse :: InputStream -> ParserResult error object
}
inputPosition :: InputStream -> Int
inputPosition (len, []) = len
inputPosition (_, (position, _):_) = position
parseString :: Parser error object -> String -> ParserResult error object
parseString parser string = parse parser (length string, zip [0..] string)
failWith :: (Int -> SyntaxError error) -> Parser error object
failWith f = Parser $ \input -> Left $ Just $ f (inputPosition input)
instance Functor (Parser error) where
fmap :: (a -> b) -> Parser error a -> Parser error b
mapper `fmap` parser = Parser $ \input -> do
Parsed range result rest <- parse parser input
Right $ Parsed range (mapper result) rest
instance Applicative (Parser error) where
pure :: a -> Parser error a
pure constant = Parser $ \input -> return $
Parsed (inputPosition input, inputPosition input) constant input
(<*>) :: Parser error (a -> b) -> Parser error a -> Parser error b
parser1 <*> parser2 = Parser $ \input -> do
Parsed (from, _) first rest <- parse parser1 input
case parse parser2 rest of
Right (Parsed (_, to) second rest') ->
Right $ Parsed (from, to) (first second) rest'
Left x -> Left x
(*>) :: Parser error a -> Parser error b -> Parser error b
parser1 *> parser2 = Parser $ \input -> do
Parsed _ _ rest <- parse parser1 input
parse parser2 rest
(<*) :: Parser error a -> Parser error b -> Parser error a
parser1 <* parser2 = Parser $ \input -> do
Parsed range result rest <- parse parser1 input
case parse parser2 rest of
Right (Parsed _ _ rest') -> Right $ Parsed range result rest'
Left x -> Left x
instance Alternative (Parser error) where
empty :: Parser error a
empty = Parser $ const $ Left Nothing
(<|>) :: Parser error a -> Parser error a -> Parser error a
parser1 <|> parser2 = Parser $ \input ->
case parse parser1 input of
Right result -> Right result
Left Nothing -> parse parser2 input
x -> x
instance Monad (Parser error) where
return :: a -> Parser error a
return = pure
(>>=) :: Parser error a -> (a -> Parser error b) -> Parser error b
parser >>= newParserGenerator = Parser $ \input -> do
Parsed (from, _) item rest <- parse parser input
case parse (newParserGenerator item) rest of
Right (Parsed (_, to) item' rest') ->
Right $ Parsed (from, to) item' rest'
x -> x
(>>) :: Parser error a -> Parser error b -> Parser error b
(>>) = (*>)
instance MonadState InputStream (Parser error) where
get :: Parser error InputStream
get = Parser $ \input -> Right $
Parsed (inputPosition input, inputPosition input) input input
put :: InputStream -> Parser error ()
put input = Parser $ const $ Right $
Parsed (inputPosition input, inputPosition input) () input
char :: Char -> Parser error Char
char character = Parser $ \(len, stream) -> case stream of
[] -> Left Nothing
(position, inputCharacter) : inputRest ->
if character == inputCharacter then
Right $ Parsed (position, position + 1) character (len, inputRest)
else
Left Nothing
charThat :: (Char -> Bool) -> Parser error Char
charThat condition = Parser $ \(len, stream) -> case stream of
[] -> Left Nothing
(position, inputCharacter) : inputRest ->
if condition inputCharacter then
Right $ Parsed
(position, position + 1)
inputCharacter
(len, inputRest)
else
Left Nothing
that :: Parser error object -> (object -> Bool) -> Parser error object
that parser condition = Parser $ \input -> do
Parsed range result rest <- parse parser input
if condition result
then Right $ Parsed range result rest
else Left Nothing
follows :: (Char -> Bool) -> Parser error Char
follows condition = Parser $ \(len, stream) -> case stream of
[] -> Left Nothing
(position, inputCharacter) : inputRest ->
if condition inputCharacter then
Right $ Parsed
(position - 1, position)
inputCharacter
(len, (position, inputCharacter) : inputRest)
else
Left Nothing
followedBy :: Parser error a -> Parser error b -> Parser error a
followedBy parser1 parser2 = Parser $ \input -> do
Parsed range result rest <- parse parser1 input
case parse parser2 rest of
Right (Parsed {}) -> Right $ Parsed range result rest
Left x -> Left x
notFollowedBy :: Parser error a -> Parser error' b -> Parser error a
notFollowedBy parser1 parser2 = Parser $ \input -> do
Parsed range result rest <- parse parser1 input
case parse parser2 rest of
Right {} -> Left Nothing
_ -> Right $ Parsed range result rest
str :: String -> Parser error String
str = traverse char
separatedBy :: Alternative f => f a1 -> f a2 -> f [a1]
parser `separatedBy` it = (:) <$> parser <*> many (it *> parser)
surroundedBy :: Applicative f => f a -> f b -> f a
parser `surroundedBy` it = it *> parser <* it
one :: Parser error Char
one = charThat (const True)
strict :: Parser error object -> Parser error object
strict parser = Parser $ \input -> case parse parser input of
Right (Parsed range result (len, []))
-> Right $ Parsed range result (len, [])
Right {} -> Left Nothing
x -> x
--------------------------------------------------------------------------------
data Term
= Constant { size :: Int }
| Variable { size :: Int }
deriving Show
data Equation = Equation [Term] [Term]
deriving Show
number :: Parser error String
number = some $ charThat (`elem` ['0'..'9'])
variable :: Parser error Char
variable = charThat (`elem` ['a'..'z'])
termConstant :: Parser error Term
termConstant = Constant . read <$> number
termVariable :: Parser error Term
termVariable = do
c <- optional (read <$> number)
void variable
return $ Variable (case c of Just c -> c; _ -> 1)
termHead :: Parser error Term
termHead = do
op <- optional $ char '+' <|> char '-'
let sign = case op of Just '-' -> -1; _ -> 1
t <- termVariable <|> termConstant
return $ case t of
Variable c -> Variable $ sign * c
Constant c -> Constant $ sign * c
termTail :: Parser error Term
termTail = do
op <- char '+' <|> char '-'
let sign = case op of '-' -> -1; _ -> 1
t <- termVariable <|> termConstant
return $ case t of
Variable c -> Variable $ sign * c
Constant c -> Constant $ sign * c
terms :: Parser error [Term]
terms = (:) <$> termHead <*> many termTail
equation :: Parser error Equation
equation = Equation <$> (terms <* char '=') <*> terms
isVariable :: Term -> Bool
isVariable = \case Variable {} -> True; _ -> False
isConstant :: Term -> Bool
isConstant = \case Constant {} -> True; _ -> False
solve :: Equation -> Double
solve (Equation left right) = c / v where
leftVariable = fromIntegral $ sum (size <$> filter isVariable left)
leftConstant = fromIntegral $ sum (size <$> filter isConstant left)
rightVariable = fromIntegral $ sum (size <$> filter isVariable right)
rightConstant = fromIntegral $ sum (size <$> filter isConstant right)
v = leftVariable - rightVariable
c = rightConstant - leftConstant
removeWhite :: String -> String
removeWhite = filter (`notElem` ['\r', '\n', '\t', ' ', '\0'])
main :: IO ()
main = do
line <- getLine
case parseString equation (removeWhite line) of
Right (Parsed _ equation _) -> do
let variableName = head $ filter (`elem` ['a'..'z']) line
let result :: Double = solve equation
let resultString = printf "%.3f" result
putStrLn $ variableName : '=' : resultString