第五个测试点过不了
查看原帖
第五个测试点过不了
385448
ChenZhanming楼主2024/3/19 19:47

只有第五个测试点过不了,但是已经按照其他帖子说的,去掉了多余的空白字符,还是不行 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

2024/3/19 19:47
加载中...