Skip to content

Commit

Permalink
Normalize will now filter multipliers from every dimension
Browse files Browse the repository at this point in the history
  • Loading branch information
LukasPietzschmann committed Jul 17, 2024
1 parent 532f4d3 commit c038ddb
Show file tree
Hide file tree
Showing 5 changed files with 13 additions and 15 deletions.
12 changes: 3 additions & 9 deletions src/Math/Haskellator/Internal/AstProcessingSteps/Evaluate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ execute :: Expr -- ^ the expression tree to evaluate
-> Either Error (Value Dimension) -- ^ the result or an error
execute expr = do
r <- runAstFold $ execute' expr
return $ r { unit = filterUnwanted $ unit r }
return $ r { unit = filterZeroPower $ unit r }

execute' :: Expr -> SimpleAstFold (Value Dimension)
execute' = partiallyFoldExprM execVal execBinOp execUnaryOp execConversion execVarBinds execVar
Expand All @@ -48,10 +48,10 @@ execBinOp lhs Div rhs = do
let u = subtractUnits (unit lhs) (unit rhs)
return $ Value (value lhs / value rhs) u
execBinOp lhs Pow rhs = case rhs of
Value _ [UnitExp Multiplier _] -> return $ Value (value lhs ** value rhs) ((\u -> u {
Value _ [] -> return $ Value (value lhs ** value rhs) ((\u -> u {
power = power u * (round (value rhs) :: Int)
}) <$> unit lhs)
_ -> throwError $ Error RuntimeError "Exponentiation of units is not supported"
_ -> throwError $ Error RuntimeError "Exponentiation of units is not supported"
execBinOp _ op _ = throwError $ Error ImplementationError $ "Unknown binary operator " ++ show op

execUnaryOp :: Op -> Value Dimension -> SimpleAstFold (Value Dimension)
Expand Down Expand Up @@ -105,11 +105,5 @@ findPair x (y:ys) | dimUnit x == dimUnit y = ([(x, y)], ([], ys))
| otherwise = let (pair, (lr, rr)) = findPair x ys
in (pair, (lr, y:rr))

filterUnwanted :: Dimension -> Dimension
filterUnwanted = filterZeroPower . filterMultiplier

filterZeroPower :: Dimension -> Dimension
filterZeroPower = filter ((/=0) . power)

filterMultiplier :: Dimension -> Dimension
filterMultiplier = filter (not . isMultiplier . dimUnit)
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ import Math.Haskellator.Internal.Utils.Error
-- | Normalize all values inside the tree to their base units
normalize :: Expr -- ^ the 'Expr' tree to normalize
-> Either Error Expr -- ^ the normalized 'Expr' tree
normalize = Right . foldExpr (Val . convertDimensionToBase) BinOp UnaryOp Conversion VarBindings Var
normalize = Right . foldExpr (Val . filterMultiplier . convertDimensionToBase) BinOp UnaryOp Conversion VarBindings Var

-- | Converts a value to its base dimension
-- >>> convertDimensionToBase $ Value 1 [UnitExp Kilometer 2, UnitExp Hour 1]
Expand Down Expand Up @@ -59,3 +59,6 @@ convertUnit s (t:ts) val@(Value v u) = case convertTo (Value 1 s) t of
Nothing -> do
(v', rest) <- convertUnit s ts val
return (v', t:rest)

filterMultiplier :: AstValue -> AstValue
filterMultiplier (Value v u) = Value v $ filter (not . isMultiplier . dimUnit) u
3 changes: 2 additions & 1 deletion src/Math/Haskellator/Internal/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ import Control.Monad.State
import Data.Bifunctor

import Math.Haskellator.Internal.AstProcessingSteps.Evaluate
import Math.Haskellator.Internal.AstProcessingSteps.Normalize
import Math.Haskellator.Internal.DerivedUnits
import Math.Haskellator.Internal.Expr
import Math.Haskellator.Internal.Lexer
Expand Down Expand Up @@ -164,7 +165,7 @@ parseUnitExp = do
either (\x -> fail $ "Invalid unit " ++ x) (\dim -> do {
requireOperator "^";
expr <- parsePrimary;
case execute expr of
case normalize expr >>= execute of
Right (Value v []) -> let e = round v :: Int in return ((\(UnitExp u e') -> UnitExp u $ e' * e) <$> dim)
_ -> fail "Exponentiation of units is not supported"
} <|> return dim) $ parseUnitSymbol i
Expand Down
6 changes: 3 additions & 3 deletions test/Evaluation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,8 +40,8 @@ normalization = testGroup "Normalization" [
@?= Right (BinOp (Val $ Value 1 $ meter 42) Div (Val $ Value 1 $ second 33))
]

evalString :: String -> Either Error Double
evalString = scan >=> parse >=> evaluate

normalizeString :: String -> Either Error Expr
normalizeString = scan >=> parse >=> normalize

evalString :: String -> Either Error Double
evalString = normalizeString >=> evaluate
2 changes: 1 addition & 1 deletion test/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ genInt = do
instance Arbitrary Unit where
-- Multiplier needs to be excluded here to prevent ambiguous cases in our grammar
-- e.g. 2^2 could be either a multiplier with exponent two or a power operation on two multipliers with exponent 1
arbitrary = arbitraryBoundedEnum `suchThat` (/= Multiplier)
arbitrary = arbitraryBoundedEnum `suchThat` (not . isMultiplier)

instance Arbitrary Expr where
arbitrary = let randomValue = do {
Expand Down

0 comments on commit c038ddb

Please sign in to comment.