Haskell Betreiber Handhabung als

Question

Werte ich mich herauszufordern eine einfache Version des Rechners here und kam mit einer Art und Weise diskutiert, zu schreiben Operatoren abzurufen, indem eine Zeichenfolge aufzublicken:

ops = [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))] 

Das hat gut funktioniert.
Wenn ich jedoch versuchte, entweder ("^", (^)), ("mod", (mod)) oder ("div", (div)) zu der Liste hinzuzufügen, wurde ich begrüßt mit:

Die Gruppierung der sechs Operatoren ohne (/) funktionierte ebenfalls gut, gab mir aber alle möglichen Fehler, als ich versuchte, eine Funktion zu erzeugen, die einen der sieben Operatoren zurückgeben konnte (mit if-else, oder.) beispielsweise in zwei verschiedenen Listen nachschlagen). Wiederkehrende jeder der sechs war in Ordnung, oder arbeiten nur mit (+), (-), (*) und (/) hat gut funktioniert auch die einfache Funktion:

findOp op = fromJust $ lookup op ops 

Was könnte ein bequemer Weg sein, Speichern und Abrufen eines dieser sieben Operatoren basierend auf einer Zeichenfolge oder etwas anderem? Oder sollte ich mir vielleicht eine andere Möglichkeit überlegen, wie man den geparsten Input-String des Rechners berechnen kann? (Ich denke, eval und Parsec wurden von diesem Training ausgeschlossen, und ich würde nicht -XNoMonomorphismRestriction, wenn das eine Option wäre)

Hier ist mein elementarer Rechner, der +, -, * und/mit korrekter Priorität analysieren kann und die ich hatte gehofft, fortzusetzen und Spielzeug mit:

import Data.Maybe 

ops = [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))] 

parseLex a = fst $ head a 
findOp op = fromJust $ lookup op ops 

calculate str accum op memory multiplication 
    | operand1 /= "" && nextOp == "" = show (op accum (read operand1) + memory) 
    | nextOp == "+" || nextOp == "-" = 
     calculate tailLex (op accum (read operand1) + memory) (findOp nextOp) 0 False 
    | nextOp == "*" || nextOp == "/" = 
     if multiplication 
     then calculate tailLex (op accum (read operand1)) (findOp nextOp) memory True 
     else calculate tailLex (read operand1) (findOp nextOp) accum True 
    | otherwise = "Parse error. operand1: " ++ operand1 ++ " nextOp: " ++ nextOp 
where lexemes = head $ lex str 
     operand1 = fst lexemes 
     nextOp = parseLex $ lex $ snd lexemes 
     tailLex = tail $ snd lexemes 

main :: IO() 
main = do 
    str <- getLine 
    case parseLex $ lex str of 
    "quit" -> do putStrLn ""; return() 
    ""  -> main 
    otherwise -> do 
     putStrLn (calculate str 0 (+) 0 False) 
     main 

UPDATE:

Hier ist die vollständige caculator Haskell entwickelt, die Antwort unter Verwendung (mit postfix, klammert Parsing und variable/Funktionsdeklaration):

import Data.Maybe 
import Data.List 
import Data.List.Split 
import Text.Regex.Posix 
import System.Console.ANSI 

ops :: [([Char], Float -> Float -> Float)] 
ops = [ ("+", (+)) 
     ,("-", (-)) 
     ,("*", (*)) 
     ,("/", (/)) 
     ,("**", (**)) 
     ,("^", (**)) 
     ,("^^", (**)) 
     ,("logbase", (logBase)) 
     ,("div", (div')) 
     ,("mod", (mod')) 
     ,("%", (mod')) 
     ,("rem", (rem')) 
     ,("max", (max)) 
     ,("min", (min))] 

unaryOps :: [([Char], Float -> Float)] 
unaryOps = [ ("abs", (abs)) 
      ,("sqrt", (sqrt)) 
      ,("floor", (floor')) 
      ,("ceil", (ceiling')) 
      ,("round", (round')) 
      ,("log", (log)) 
      ,("cos", (cos)) 
      ,("sin", (sin)) 
      ,("tan", (tan)) 
      ,("asin", (asin)) 
      ,("acos", (acos)) 
      ,("atan", (atan)) 
      ,("exp", (exp)) 
      ,("!", (factorial)) ] 

opsPrecedence :: [([Char], Integer)] 
opsPrecedence = [ ("+", 1) 
       ,("-", 1) 
       ,("*", 2) 
       ,("/", 2) 
       ,("**", 3) 
       ,("^", 3) 
       ,("^^", 3) 
       ,("logbase", 3) 
       ,("div", 4) 
       ,("mod", 4) 
       ,("%", 4) 
       ,("rem", 4) 
       ,("max", 4) 
       ,("min", 4)     
       ,("abs", 7) 
       ,("sqrt", 7) 
       ,("floor", 7) 
       ,("ceil", 7) 
       ,("round", 7) 
       ,("log", 7) 
       ,("cos", 7) 
       ,("sin", 7) 
       ,("tan", 7) 
       ,("asin", 7) 
       ,("acos", 7) 
       ,("atan", 7) 
       ,("exp", 7) 
       ,("!", 7) ]    

floor' :: Float -> Float 
floor' a = fromIntegral $ floor a 

ceiling' :: Float -> Float 
ceiling' a = fromIntegral $ ceiling a 

mod' :: Float -> Float -> Float 
mod' a b = a - b * floor' (a/b) 

div' :: (Num b, RealFrac a) => a -> a -> b 
div' a b = fromIntegral $ truncate (a/b) 

rem' :: Float -> Float -> Float 
rem' a b = a - (fromIntegral (truncate (a/b)) * b) 

round' :: Float -> Float 
round' a = fromIntegral $ round a 

factorial :: Float -> Float 
factorial n = foldl (*) 1 [1..n] 

{-Op Detection and Lookup-} 

isOp :: [Char] -> Bool 
isOp op = case lookup op ops of 
      Just _ -> True 
      Nothing -> False 

isUnaryOp :: [Char] -> Bool 
isUnaryOp op = case lookup op unaryOps of 
       Just _ -> True 
       Nothing -> False 

opPrecedence :: [Char] -> [([Char],[Char])] -> Integer 
opPrecedence op env 
    | not (null $ isInEnv op env) = 6 
    | otherwise    = fromJust $ lookup op opsPrecedence 

findOp :: [Char] -> Float -> Float -> Float 
findOp op = fromJust $ lookup op ops 

findUnaryOp :: [Char] -> Float -> Float 
findUnaryOp op = fromJust $ lookup op unaryOps 

{-String Parsing Functions-} 

trim :: [Char] -> [Char] 
trim str = dropWhile (==' ') (reverse $ dropWhile (==' ') (reverse str)) 

fstLex :: [Char] -> [Char] 
fstLex a = fst $ head (lex a) 

sndLex :: [Char] -> [Char] 
sndLex a = snd $ head (lex a) 

lexWords :: [Char] -> [[Char]] 
lexWords xs = 
    lexWords' xs [] 
    where lexWords' ys temp 
      | null ys = temp 
      | otherwise = let word = fstLex ys 
          in lexWords' (trim $ sndLex ys) (temp ++ [word]) 

{-Mathematical Expression Parsing Functions-} 

toPostfix :: [Char] -> [([Char],[Char])] -> [[Char]] 
toPostfix expression env = toPostfix' expression [] [] "" env 
    where toPostfix' expression stack result previous env 
      | null expression && null stack        = result 
      | null expression && not (null stack)      = result ++ stack 
      | ch == ","             = toPostfix' right stack result ch env 
      | ch == "("             = toPostfix' right (ch:stack) result ch env 
      | ch == ")"             = 
       let popped = takeWhile (/="(") stack 
       in toPostfix' right (drop (length popped + 1) stack) (result ++ popped) ch env 
      | not (null $ isInEnv ch env) 
      && (length $ words $ fst $ head (isInEnv ch env)) == 1  = 
       let variable = head $ isInEnv ch env 
       in toPostfix' (snd variable ++ " " ++ right) stack result ch env 
      | (null $ isInEnv ch env) && not (isOp ch || isUnaryOp ch) = 
       if take 1 ch =~ "(^[a-zA-Z_])" 
       then words ("Parse error : not in scope, " ++ "'" ++ ch ++ "'") 
       else let number = reads ch :: [(Double, String)] 
         in if not (null number) && (null $ snd $ head number) 
          then toPostfix' right stack (result ++ [ch]) ch env 
          else words ("Parse error : " ++ "'" ++ ch ++ "'") 
      | otherwise             = 
       if null result && ch == "-" || (isOp previous || isUnaryOp previous) && ch == "-" 
       then let negative = '-' : (fstLex right) 
          right' = sndLex right 
         in toPostfix' right' stack (result ++ [negative]) (fstLex right) env 
       else toPostfix' right (ch : (drop (length popped') stack)) (result ++ popped') ch env 
     where ch = fstLex expression 
       right = trim (sndLex expression) 
       popped' = popStack ch stack 
        where popStack ch stack' 
          | null stack' = [] 
          | head stack' /= "(" && opPrecedence ch env <= opPrecedence (head stack') env= 
           take 1 stack' ++ popStack ch (drop 1 stack') 
          | otherwise = [] 

evaluate :: [Char] -> [[Char]] -> [Char] 
evaluate op operands = 
    let operand1 = head operands 
     operand1' = reads operand1 :: [(Double, String)] 
     errorMsg = "Parse error in evaluation." 
    in if not (null operand1') && null (snd $ head operand1') 
     then case length operands of 
       1   -> show (findUnaryOp op (read operand1)) 
       otherwise -> let operand2 = head (drop 1 operands) 
           operand2' = reads operand2 :: [(Double, String)] 
          in if not (null operand2') && null (snd $ head operand2') 
            then show (findOp op (read operand1) (read operand2)) 
            else errorMsg 
    else errorMsg 

evalDef :: ([Char],[Char]) -> [[Char]] -> [([Char],[Char])] -> [Char] 
evalDef def args env = 
    evalPostfix (toPostfix (replaceParams (drop 1 $ words (fst def)) args (snd def) "") env) env 
    where replaceParams params values exp temp 
      | length params /= length values = "Parse error : function parameters do not match." 
      | null exp      = init temp 
      | otherwise      = 
       let word = fstLex exp 
        replaced = if elem word params 
            then temp++ values!!(fromJust $ elemIndex word params) ++ " " 
            else temp++ word ++ " " 
       in replaceParams params values (drop (length word) (trim exp)) replaced 

evalPostfix :: [[Char]] -> [([Char],[Char])] -> [Char] 
evalPostfix postfix env 
    | elem "error" postfix = unwords postfix 
    | otherwise = head $ evalPostfix' postfix [] env 
     where evalPostfix' postfix stack env 
       | null postfix = stack 
       | null (isInEnv (head postfix) env) && not (isOp (head postfix) || isUnaryOp (head postfix)) 
          = evalPostfix' (drop 1 postfix) (head postfix : stack) env 
       | otherwise = 
        let op = head postfix 
         numOperands = if isOp op 
             then 2 
             else if isUnaryOp op 
               then 1 
               else let def = isInEnv op env 
                in length (words $ fst $ head def) - 1 
        in if length stack >= numOperands 
         then let retVal = 
            if isOp op || isUnaryOp op 
             then evaluate op (reverse $ take numOperands stack) 
             else let def = isInEnv op env 
              in evalDef (head def) (reverse $ take numOperands stack) env 
          in if not (isInfixOf "error" retVal) 
            then evalPostfix' (drop 1 postfix) (retVal : drop numOperands stack) env 
            else [retVal] 
         else ["Parse error."] 

{-Environment Setting Functions-} 

isInEnv :: [Char] -> [([Char],[Char])] -> [([Char],[Char])] 
isInEnv first []  = [] 
isInEnv first (x:xs) 
    | fstLex first == fstLex (fst x) = [x] 
    | otherwise      = isInEnv first xs 

setEnv :: [Char] -> ([Char], [Char]) 
setEnv str = 
    if elem '=' str 
    then let nameAndParams = let function = takeWhile (/='=') str 
           in unwords $ filter (\x -> x/="(" && x/="," && x/=")") (lexWords function) 
       expression = unwords $ lexWords (tail (dropWhile (/='=') str)) 
      in if not (null nameAndParams) 
       then if fstLex nameAndParams =~ "(^[a-zA-Z_])" 
         then (nameAndParams, expression) 
         else ("error", "Parse error : illegal first character in variable name.") 
       else ("error", "Parse error : null variable name.") 
    else ("error", "Parse error.") 

declare :: [Char] -> [([Char], [Char])] -> IO() 
declare str env = 
    let which = if str =~ "(^ *[a-zA-z_][a-zA-Z0-9_]* *=)" :: Bool 
       then "var" 
       else "def" 
     declarationList = case which of 
          "var" -> splitOn "," str 
          "def" -> [str] 
    in declare' declarationList env which 
    where declare' [] _ _   = mainLoop env 
      declare' (x:xs) env which = 
      let result = setEnv x 
      in if fst result /= "error" 
        then let match = isInEnv (fst result) env 
          env' = if not (null match) 
             then deleteBy (\x -> (==head match)) (head match) env 
             else env 
          newList = if not (null $ snd result) 
             then (result : env') 
             else env' 
         in case which of 
          "def"  -> mainLoop newList 
          otherwise -> if null xs 
              then mainLoop newList 
              else declare' xs newList which 
        else do putStrLn $ snd result 
          mainLoop env 

{-Main Calculation Function-} 

calculate :: [Char] -> [([Char],[Char])] -> [Char] 
calculate str env = 
    evalPostfix (toPostfix str env) env 

helpContents = "\nTo declare variables, type:\n[var] VARIABLE_NAME = VALUE [, more variable declarations..]\n" 
       ++ "Functions and partial functions may be assigned to variables.\n\n" 
       ++ "To declare functions, type:\n" 
       ++ "FUNCTION_NAME VARIABLE_1 [variable_2..] = EXPRESSION\n\n" 
       ++ "Supported math functions:\n" 
       ++ "+, -, *, /, ^, **, ^^\n" 
       ++ "sqrt, exp, log, logbase BASE OPERAND\n" 
       ++ "abs, div, mod, %, rem, floor, ceil, round\n" 
       ++ "pi, sin, cos, tan, asin, acos, atan\n" 
       ++ "! (factorial), min, max and parentheses:()\n\n" 
       ++ "Type env to see a list of environment variables\nand functions. Type cls to clear screen, quit to quit\n" 

main :: IO() 
main = do putStrLn "calc v2.0 (c) 2013 Diagonal Productions\nPlease enter an expression:\n" 
      mainLoop [("pi", show pi), ("min a b", "min a b"), ("max a b", "max a b")] 

mainLoop :: [([Char], [Char])] -> IO() 
mainLoop env = do 
    str <- getLine 
    if elem '=' str 
    then declare str env 
    else case fstLex str of 
      "quit" -> do putStrLn ""; return() 
      ""  -> mainLoop env 
      "env"  -> do putStrLn ("\nEnvironment:\n" ++ show env ++ "\n") 
          mainLoop env 
      "cls"  -> do clearScreen 
          setCursorPosition 0 0 
          mainLoop env 
      "help" -> do putStrLn helpContents 
          mainLoop env 
      otherwise -> do 
      putStrLn $ calculate str env 
      mainLoop env 

Answer 1

Dank Niklas 'Antwort habe ich bemerkt, dass (**) einen anderen Typ als (^) hat und mit meiner einfachen Operatorliste funktioniert. Danach habe ich beschlossen, wie so kurze alternative Definitionen für div und mod, zu schreiben:

mod' :: Float -> Float -> Float 
mod' a b = a - b * floor' (a/b) 

div' :: (Num b, RealFrac a) => a -> a -> b 
div' a b = fromIntegral $ truncate (a/b) 

floor' :: Float -> Float 
floor' a = fromIntegral $ floor a 

Hinzufügen (**) (mod ') und (div') auf meiner Liste, der Compiler kompiliert in Ordnung. (Und da die Operatoren von einer Zeichenkette aus analysiert werden, könnten sie auch ihre ursprünglichen Namen behalten.)

Answer 2

Das Problem ist, dass die Arten von (/), mod und (+) alle sind sehr anders als die Fehlermeldung besagt: (/) Arbeiten auf Fractional s wie Float und Double während mod Arbeiten auf Integrals wie Int und Integer . Auf der anderen Seite (+) kann mit jedem Num verwendet werden. Diese Operatoren sind nicht im selben Kontext austauschbar.

Edit:

Nun, da ich einige Codes sehen kann, sieht es aus wie das Problem durch den Haskell Compiler verursacht wird versucht, die Art der ops Liste zu schließen. Schauen wir uns die Typen der Elemente dieser Liste an:

Prelude> :t ("+", (+)) 
("+", (+)) :: Num a => ([Char], a -> a -> a) 
Prelude> :t ("/", (/)) 
("/", (/)) :: Fractional a => ([Char], a -> a -> a) 
Prelude> :t ("mod", mod) 
("mod", mod) :: Integral a => ([Char], a -> a -> a) 
Prelude>

Beachten Sie, dass jedes dieser Paare einen anderen Typ hat. Aber ich wiederhole nur meine ursprüngliche Antwort. Eine mögliche Lösung besteht darin, einen expliziten Typ für ops anzugeben, sodass Haskell nicht versucht, auf einen zu schließen.

The Bad News:

ich nicht eine einfache Art Signatur finden kann, um das Problem zu beheben.Ich versuchte

ops :: Num a => [(String, a -> a -> a)] 

, die verschiedene Fehler gibt, die offensichtlich in der gleichen Ursache verwurzelt sind.

Answer 3

Bevor Sie eine Lösung präsentieren, lassen Sie mich schnell erklären, warum sich Ihr Compiler über Ihren aktuellen Code beschwert. Um dies zu verdeutlichen, schauen wir uns an den Typ Unterschriften einiger Operatoren:

(+) :: Num a => a -> a -> a 
(/) :: Fractional a => a -> a -> a 
(mod) :: Integral a => a -> a -> a 

Wie Sie sehen können, Haskell verschiedene Arten von Zahlen hat und es stuft sie Typklassen mit: Num etwas, das Sie addieren, subtrahieren, multiplizieren und so weiter, Fractional s sind Zahlen mit wohldefinierter Division, Integral sind ganzzahlige Zahlen. Darüber hinaus sind Fractional und Integral beide Unterklassen von Num. Aus diesem Grund ist diese beiden Arbeiten:

[(+), (mod)] :: Integral a => [a -> a -> a] 
[(+), (/)] :: Fractional a => [a -> a -> a] 

Es ist einfach die „größte gemeinsame Typ“ verwendet, sozusagen, für die Art der Funktionen in der Liste. Sie können nicht einfach mischen Funktionen auf Fractional s mit Funktionen auf Integral s in der gleichen Liste, obwohl!

Sie geben an, dass Sie mit "where lex returns" arbeiten möchten, aber das ist nur eine nicht typisierte Zeichenfolge, und Sie möchten tatsächlich mit Zahlen arbeiten. da Sie möchten jedoch Punktnummer und Zahlen zu verwenden, um der Lage sein, schwimmen, wäre eine sum type eine gute Option sein:

import Safe (readMay) 

data Number = I Integer | D Double 

parseNumber :: String -> Maybe Number 
parseNumber str = 
    if '.' `elem` str then fmap I $ readMay str 
         else fmap D $ readMay str 

Jetzt haben Sie das Problem, dass es ziemlich umständlich ist vernünftig Instanzen Ihrer Operatoren zu definieren. Da der Number Typ bereits in der Attoparsec Bibliothek vorhanden ist, empfehle ich ihn zu verwenden, da er Ihnen einen Parser und eine Num Instanz kostenlos zur Verfügung stellt. Natürlich können Sie dafür immer Ihren eigenen Code erstellen.

import qualified Data.Attoparsec.Text as P 
import qualified Data.Attoparsec.Number as P 
import qualified Data.Text as T 

parseNumber :: String -> Maybe P.Number 
parseNumber str = 
    either (const Nothing) Just $ P.parseOnly P.number (T.pack str) 

myMod :: P.Number -> P.Number -> Maybe P.Number 
myMod (P.I a) (P.I b) = Just . P.I $ a `mod` b 
myMod _ _ = Nothing -- type error! 

myPow :: P.Number -> P.Number -> Maybe P.Number 
myPow x (P.I b) = Just $ x^b 
myPow (P.D a) (P.D b) = Just . P.D $ a ** b 
myPow (P.I a) (P.D b) = Just . P.D $ (fromIntegral a) ** b 

ops :: [(String, (P.Number -> P.Number -> Maybe P.Number))] 
ops = [ ("+", liftNum (+)) 
     , ("-", liftNum (-)) 
     , ("*", liftNum (*)) 
     , ("/", liftNum (/)) 
     , ("mod", myMod) 
     , ("^", myPow) 
     ] 
     where liftNum op a b = Just $ a `op` b 

Sie können nun beliebige Operationen an Ihren wohldefinierten Eingängen definieren. Natürlich müssen Sie jetzt auch mit Typfehlern wie 1.333 mod 5.3 umgehen, aber das ist gut! Der Compiler zwang Sie, das Richtige zu tun :)

Durch die Vermeidung der partiellen read Funktion müssen Sie auch explizit auf Eingabefehler prüfen. Ihr ursprüngliches Programm wäre gerade auf einer Eingabe wie a + a abgestürzt.