significant-figures 0.1.0.1 → 0.2.0.0

raw patch · 7 files changed

+268/−126 lines, 7 filesdep +tasty-quickcheckdep −HUnitdep ~tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-quickcheck

Dependencies removed: HUnit

Dependency ranges changed: tasty-hunit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−1
• significant-figures.cabal +4/−3
• src/Data/SigFig/Evaluate.hs +15/−5
• src/Data/SigFig/Parse.hs +36/−97
• src/Data/SigFig/PrettyPrint.hs +95/−0
• src/Data/SigFig/Types.hs +15/−11
• tests/SigFigTest.hs +90/−9

@@ -1,5 +1,17 @@ # Revision history for significant-figures -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0 -- 2022-09-22++* **BREAKING** Rename `Leaf` to `Literal`.+* **BREAKING** Parser parses expressions for both base and exponent in+  exponentiation. The evaluation step is now the step that errors when the+  exponent is not an integer. This allows support for more valid expressions.+* added pretty printing module, used in property-testing++## 0.1.0.1 -- 2022-09-06++* Add README to front page++## 0.1.0.0 -- 2022-09-05  * First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               significant-figures-version:            0.1.0.1+version:            0.2.0.0 synopsis:           Calculate expressions involving significant figures. description:        This library provides a module "Data.SigFig" that helps with the parsing and evaluation of expressions involving significant figures. Significant figures are a method, often used in chemistry, of assessing and controlling the precision/uncertainty from measured values in calculations.                     . @@ -27,6 +27,7 @@                    ,Data.SigFig.Parse                    ,Data.SigFig.Types                    ,Data.SigFig.Util+                   ,Data.SigFig.PrettyPrint   other-extensions: OverloadedStrings                    ,BlockArguments                    ,ImportQualifiedPost@@ -57,7 +58,7 @@   build-depends:    base                    ,text                    ,tasty ^>=1.4.2.3-                   ,tasty-hunit-                   ,HUnit+                   ,tasty-hunit ^>= 0.10.0.0+                   ,tasty-quickcheck ^>= 0.10.2                    ,HasBigDecimal                    ,significant-figures

@@ -22,10 +22,19 @@ import Data.Text qualified as T import Control.Arrow (second) import Text.Printf (printf)+import GHC.Real (denominator, numerator)  isMeasured (Measured _ _) = True isMeasured (Constant _) = False +toNNInt (Measured sf (BigDecimal v s)) =+  if s == 0 && v >= 0 then Just v else Nothing+toNNInt (Constant a) =+  if denominator a == 1 && a >= 0 then Just (numerator a) else Nothing+exprNNInt e+  | Just n <- toNNInt e = pure n+  | otherwise = Left "non-integer exponent"+ -- | Like 'evaluate', but assume the result is a valid term and crash otherwise. evaluate' :: Expr -> Term evaluate' s = case evaluate s of@@ -34,10 +43,10 @@  -- | Given an expression tree, evaluate it and return either an error or result. evaluate :: Expr -> Either Text Term-evaluate (Leaf a) = Right a+evaluate (Literal a) = Right a evaluate (Prec1 xs) = case xs of   [] -> Left "should not happen"-  [(_, Leaf a)] -> Right a+  [(_, Literal a)] -> Right a   xs -> do     evaledSubs <- evaluateSubtrees xs     computed <- computeUnconstrained evaledSubs 0@@ -49,7 +58,7 @@          in Right . forceDP minDP $ fromRational computed evaluate (Prec2 xs) = case xs of   [] -> Left "should not happen"-  [(_, Leaf a)] -> Right a+  [(_, Literal a)] -> Right a   xs -> do     evaledSubs <- evaluateSubtrees xs     computed <- computeUnconstrained evaledSubs 1@@ -61,9 +70,10 @@          in Right . forceSF min $ fromRational computed evaluate (Exp b e) = do   res <- evaluate b+  exp <- evaluate e >>= exprNNInt   case res of-    (Measured sf bd) -> Right $ forceSF sf (bd ^ e)-    (Constant a) -> Right . Constant $ a ^ e+    (Measured sf bd) -> Right $ forceSF sf (bd ^ exp)+    (Constant a) -> Right . Constant $ a ^ exp evaluate (Apply Log10 e) = do   res <- evaluate e   case res of

@@ -17,7 +17,6 @@ import Data.BigDecimal (BigDecimal (BigDecimal)) import Data.BigDecimal qualified as BD import Data.Foldable (foldr')-import Data.Ratio (denominator, numerator) import Data.SigFig.Types import Data.Text (Text) import Data.Text qualified as T@@ -34,7 +33,7 @@  -- | Parse text into either an error message or an expression. parse :: Text -> Either Text Expr-parse = textify . P.parse fullExpr ""+parse = textify . P.parse (expr <* eof) ""   where     textify = first (T.pack . show) @@ -123,47 +122,46 @@   char 'c'   return . Constant $ v % (10 ^ s) -leaf :: Parses Expr-leaf = do+literal :: Parses Expr+literal = do   l <- choice $ try <$> [sciNotationConstant, floatConstant, integerConstant, sciNotation, float, integer]-  return $ Leaf l+  return $ Literal l -exponent :: Parses Expr-exponent = do-  (base, e) <- try do-    base <- operand-    op <- operator-    e <- operand-    pure (base, e)-  e' <- exprNNInt e-  exps <- many do-    op <- operator-    term' <- operand-    exprNNInt term'-  pure $ foldr' (flip Exp) base (e' : exps)+factor :: Parses Expr+factor = do+  operand `chainl1` operator   where-    operand = choice [try $ betweenParens expr <|> try leaf] <* spaces-    operator = string "**" <* spaces-    toNNInt (Measured sf (BigDecimal v s)) =-      if s == 0 && v >= 0 then Just v else Nothing-    toNNInt (Constant a) =-      if denominator a == 1 && a >= 0 then Just (numerator a) else Nothing-    exprNNInt e = case e of-      Leaf k | Just n <- toNNInt k -> pure n-      _ -> unexpected "non-integer exponent"+    operand = choice [try $ betweenParens expr, try literal, function] <* spaces+    operator = Exp <$ try (string "**" <* spaces) --- exponent :: Parses Expr--- exponent = do---   e <- try do---     k <- try (betweenParens expr) <|> try leaf---     spaces---     string "**"---     spaces---     return k---   i <- toInteger . BD.value . BD.nf . value <$> try integer---   when (i < 0) $ unexpected "negative exponent"---   return $ Exp e i+term :: Parses Expr+term = do+  factor `chainl1'` (op, Mul, Prec2)+  where+    op = toOp <$> oneOf "*/" <* spaces +expr :: Parses Expr+expr = do+  term `chainl1'` (op, Add, Prec1)+  where+    op = toOp <$> oneOf "+-" <* spaces++chainl1' :: Parses Expr -> (Parses Op, Op, [(Op, Expr)] -> Expr) -> Parses Expr+{-# INLINEABLE chainl1' #-}+chainl1' p (o, i, c) = do x <- p; rest [(i, x)]+  where+    rest x =+      do+        op <- o+        y <- p+        rest $ (op, y) : x+        <|> pure (if length x > 1 then c (reverse x) else snd $ head x)++-- ❯ parseEval "344 ** 2 ** 4"+-- Right (Measured {numSigFigs = 3, value = 194000000000000000000})+-- ❯ (344 ^ 2) ^ 4+-- 196095460708571938816+ -- | A list of all the functions available. funcMap :: [(Function, Text)] funcMap =@@ -184,65 +182,6 @@ -- | Parses a function application. function :: Parses Expr function = choice genFuncParsers---- | Parses any expression.-expr :: Parses Expr-expr =-  try prec1Chain-    <|> try prec2Chain-    <|> exponent-    <|> try (betweenParens expr)-    <|> try function-    <|> try leaf---- | Parses a full expression.-fullExpr :: Parses Expr-fullExpr =-  choice-    [ try prec1Chain <* eof,-      try prec2Chain <* eof,-      exponent <* eof,-      try (betweenParens expr) <* eof,-      try function <* eof,-      leaf <* eof-    ]---- Generate a chain parser: necessary because sigfig-simplification--- only occurs on completion of evaluation of such a chain.-precChain :: [Parses Expr] -> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr-precChain validOperands validOperator constructor idOp =-  do-    term <- operand-    op <- operator-    term' <- operand-    rest [(toOp op, term'), (idOp, term)]-  where-    operand = choice validOperands <* spaces-    operator = validOperator <* spaces-    rest terms =-      do-        op <- operator-        term' <- operand-        rest ((toOp op, term') : terms)-        <|> (pure . constructor $ reverse terms)---- | Parse a precendence-2 chain (of both addition or subtraction)-prec1Chain :: Parses Expr-prec1Chain =-  precChain-    [try prec2Chain, exponent, try $ betweenParens expr, function, leaf]-    (oneOf "+-")-    Prec1-    Add---- | Parse a precendence-2 chain (of both multiplication or division)-prec2Chain :: Parses Expr-prec2Chain =-  precChain-    [exponent, try $ betweenParens expr, function, leaf]-    (oneOf "*/")-    Prec2-    Mul  betweenParens :: Parses a -> Parses a betweenParens p = char '(' *> spaces *> p <* spaces <* char ')'

@@ -0,0 +1,95 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A module to unparse an expression.+module Data.SigFig.PrettyPrint (prettyPrint) where++import Data.BigDecimal (BigDecimal (..))+import Data.BigDecimal qualified as BD+import Data.SigFig.Types hiding (div)+import Data.SigFig.Util (display, isTerminating)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Real (Ratio(..))++precedence = \case+  Apply {} -> 10+  Literal {} -> 11+  Exp {} -> 3+  Prec2 {} -> 2+  Prec1 {} -> 1++-- the only time we don't need parentheses is with leaf or if child is higher precedence++precede :: Int -> Op -> Expr -> Text+precede prec Add = (" + " <>) . prettyPrintPrec prec+precede prec Sub = (" - " <>) . prettyPrintPrec prec+precede prec Mul = (" * " <>) . prettyPrintPrec prec+precede prec Div = (" / " <>) . prettyPrintPrec prec++printTerm :: Term -> Text+printTerm (Measured sf bd) = format bd+  where+    ssf = T.pack $ show sf+    format :: BigDecimal -> Text+    format term' =+      let term@(BigDecimal v s') = BD.nf term'+          s = fromIntegral s' :: Integer+          termText = T.pack . show $ term+          p = fromIntegral (BD.precision term) :: Integer+          rsdp = p - sf - s+          rsd = if sf > p then 0 else v `div` (10 ^ (rsdp + s)) `mod` 10+       in if rsd /= 0 || rsdp == 0 && p == 1+            then termText+            else+              if rsdp >= 1+                then let coef = BigDecimal v (fromIntegral (s + (p - 1))) in format coef <> "e" <> T.pack (show $ p - 1)+                else+                  termText+                    <> (if s > 0 then "" else ".")+                    <> T.replicate (fromIntegral $ sf - p) "0"+printTerm (Constant v@(a :% b)) =+  T.pack $+    if isTerminating b+      then (++ "c") . show . BD.nf $ fromRational v+      else "(" ++ show a ++ "c / " ++ show b ++ "c)"++conditionallyAddParens :: Int -> Int -> Text -> Text+conditionallyAddParens outer inner t = if inner > outer then t else "(" <> t <> ")"++printFunc Log10 x = "log(" <> prettyPrintPrec 0 x <> ")"+printFunc Antilog10 x = "exp(" <> prettyPrintPrec 0 x <> ")"++prettyPrintPrec :: Int -> Expr -> Text+prettyPrintPrec prec e =+  let prec' = precedence e+   in case e of+        Literal n -> printTerm n+        Prec1 ((_, x) : xs) -> conditionallyAddParens prec prec' $ prettyPrintPrec 1 x <> foldMap (uncurry $ precede 1) xs+        Prec2 ((_, x) : xs) -> conditionallyAddParens prec prec' $ prettyPrintPrec 2 x <> foldMap (uncurry $ precede 2) xs+        Exp a b -> conditionallyAddParens prec prec' $ prettyPrintPrec 3 a <> " ** " <> prettyPrintPrec 3 b+        Apply a b -> printFunc a b+        _ -> error "ill-formed expression"++-- | Pretty print an expression, adding parentheses where needed. Text emitted from the+-- pretty printer is intended to be able to be re-parsed, into the same expression tree.+--+-- ==== __Examples__+--+-- If you want to create expressions to pretty print, utilize the+-- functions in 'Data.SigFig.Types' like below to make life easier.+--+-- >>> prettyPrint $ lMeasured 3 4.0+-- "4.00"+--+-- >>> prettyPrint $ add [lConstant 3, lMeasured 2 3.5]+-- "3c + 3.5"+--+-- >>> prettyPrint $ add [lConstant 3, mul [lMeasured 2 3.5, lConstant 2.7]]+-- "3c + 3.5 * 2.7c"+--+-- >>> prettyPrint $ mul [lConstant 3, add [lMeasured 2 3.5, lConstant 2.7]]+-- "3c * (3.5 + 2.7c)"+prettyPrint :: Expr -> Text+prettyPrint = prettyPrintPrec 0

@@ -45,23 +45,27 @@ constant :: Rational -> Term constant = Constant +toConstant :: Term -> Term+toConstant (Measured _ bd) = Constant $ toRational bd+toConstant a = a+ -- | The types of (infix) operators data Op   = Add   | Sub   | Mul   | Div-  deriving (Show, Eq)+  deriving (Show, Eq, Bounded, Enum) --- | Create a leaf node out of a term, like a "singleton".+-- | Create a literal node out of a term, like a "singleton". l :: Term -> Expr-l = Leaf+l = Literal --- | Create a leaf node and construct the 'Measured' value argument at the same time. Convenience function.+-- | Create a literal node and construct the 'Measured' value argument at the same time. Convenience function. lMeasured :: Integer -> Rational -> Expr lMeasured = (l .) . measured --- | Create a leaf node and construct the 'Constant' value argument at the same time. Convenience function.+-- | Create a literal node and construct the 'Constant' value argument at the same time. Convenience function. lConstant :: Rational -> Expr lConstant = l . constant @@ -92,7 +96,7 @@ div (x : xs) = Prec2 $ (Mul, x) : zip (repeat Div) xs  -- | Take an 'Expr' to the power of an integer. Equivalent to 'Exp'.-exp :: Expr -> Integer -> Expr+exp :: Expr -> Expr -> Expr exp = Exp  -- | Apply a function to an 'Expr'. Equivalent to 'Apply'.@@ -105,18 +109,18 @@     Log10   | -- | The function @exp()@ in expressions.     Antilog10-  deriving (Show, Eq)+  deriving (Show, Eq, Bounded, Enum)  -- | A datatype to represent (not-yet-evaluated) expressions. Use 'Data.SigFig.Parse.parse' to create such an expression from text. data Expr-  = -- | Leaf of an expression-    Leaf Term+  = -- | Literal term+    Literal Term   | -- | Operation of "Precedence 1": addition and subtraction     Prec1 [(Op, Expr)]   | -- | Operation of "Precedence 2": multiplication and division     Prec2 [(Op, Expr)]-  | -- | Exponentiation with a constant integer exponent-    Exp Expr Integer+  | -- | Exponentiation with a constant exponent+    Exp Expr Expr   | -- | Application of a function to an expression argument     Apply Function Expr   deriving (Show, Eq)

@@ -3,20 +3,100 @@  module Main where -import Data.BigDecimal+import Control.Applicative (liftA2)+import Control.Monad (liftM)+import Data.BigDecimal hiding (value) import Data.Either (isLeft) import Data.Ratio-import Data.SigFig+import Data.SigFig hiding (Function)+import Data.SigFig qualified as S+import Data.SigFig.PrettyPrint (prettyPrint) import Data.Text (Text) import Data.Text qualified as T import GHC.Natural (naturalFromInteger) import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck import Prelude hiding (div, exp)+import Prelude qualified as P+import Data.Bitraversable (bisequence)  main :: IO () main = defaultMain tests +instance Arbitrary S.Op where+  arbitrary = arbitraryBoundedEnum++instance Arbitrary S.Function where+  arbitrary = arbitraryBoundedEnum++arbitraryRational :: Gen Rational+arbitraryRational = do+  x <- arbitrarySizedIntegral+  y <- getNonZero <$> arbitrary+  pure $ x % y++arbitraryRationalTerminating :: Gen Rational+arbitraryRationalTerminating = do+  s <- getSize+  x <- resize (s * 100) arbitrarySizedIntegral+  fac2 <- arbitrarySizedNatural+  fac5 <- arbitrarySizedNatural+  pure $ x % (2 ^ fac2 * 5 ^ fac5)++length2OrMoreList :: Arbitrary a => Gen [a]+length2OrMoreList = do+  s <- getSize+  n <- chooseInt (2, max s 2)+  vector n++instance Arbitrary Term where+  arbitrary =+    oneof+      [ arbitraryConstant,+        arbitraryMeasured+      ]+    where+      arbitraryConstant = Constant <$> arbitraryRationalTerminating+      arbitraryMeasured = do+        s <- getSize+        n <- fromRational <$> arbitraryRationalTerminating+        let t = T.pack $ show n+        let minSf = T.length $ T.filter (/= '.') t+        sf <- fromIntegral <$> chooseInt (minSf, s * 5)+        pure $ Measured sf n++genExpr :: Gen Expr+genExpr = sized genExpr'++genExpr' :: Int -> Gen Expr+genExpr' n+  | n < 2 = S.Literal <$> arbitrary+  | n > 0 =+    oneof+      [ add <$> composite,+        sub <$> composite,+        div <$> composite,+        mul <$> composite,+        exp <$> subexpr <*> subexpr,+        apply <$> arbitrary <*> subexpr+      ]+  | otherwise = error "negative size"+  where+    n' = n `P.div` 2+    composite = resize n' length2OrMoreList+    subexpr = genExpr' n'++instance Arbitrary S.Expr where+  arbitrary = genExpr++inverse =+  testProperty+    "pretty-printing is the inverse of parsing"+    inverseProp++inverseProp e = (parse . prettyPrint) e == Right e+ tests :: TestTree tests =   testGroup@@ -29,7 +109,8 @@       singleOpTests,       orderOfOperations,       complexExpressions,-      createExprTests+      createExprTests,+      inverse     ]  -- | Cheese testing by copypasting from repl@@ -190,15 +271,15 @@  createExprTests =   let addLhs = add [lMeasured 2 3.0, lConstant 4.2]-      addRhs = Prec1 [(Add, Leaf $ Measured 2 (BigDecimal 3 0)), (Add, Leaf $ Constant 4.2)]+      addRhs = Prec1 [(Add, Literal $ Measured 2 (BigDecimal 3 0)), (Add, Literal $ Constant 4.2)]       subLhs = sub [lMeasured 2 3.0, lConstant 4.2]-      subRhs = Prec1 [(Add, Leaf $ Measured 2 (BigDecimal 3 0)), (Sub, Leaf $ Constant 4.2)]+      subRhs = Prec1 [(Add, Literal $ Measured 2 (BigDecimal 3 0)), (Sub, Literal $ Constant 4.2)]       mulLhs = mul [lMeasured 2 3.0, lConstant 4.2, lMeasured 4 2.2]-      mulRhs = Prec2 [(Mul, Leaf $ Measured 2 (BigDecimal 3 0)), (Mul, Leaf $ Constant 4.2), (Mul, Leaf $ Measured 4 2.2)]+      mulRhs = Prec2 [(Mul, Literal $ Measured 2 (BigDecimal 3 0)), (Mul, Literal $ Constant 4.2), (Mul, Literal $ Measured 4 2.2)]       divLhs = div [lMeasured 2 3.0, lConstant 4.2]-      divRhs = Prec2 [(Mul, Leaf $ Measured 2 (BigDecimal 3 0)), (Div, Leaf $ Constant 4.2)]-      expLhs = exp mulLhs 2-      expRhs = Exp mulRhs 2+      divRhs = Prec2 [(Mul, Literal $ Measured 2 (BigDecimal 3 0)), (Div, Literal $ Constant 4.2)]+      expLhs = exp mulLhs (lConstant 2)+      expRhs = Exp mulRhs (lConstant 2)    in testGroup         "creating expressions"         [ testCase "basic" $