exchangealgebra 0.5.1.0 → 0.5.2.0
raw patch · 14 files changed
+1414/−5 lines, 14 files
Files
- ChangeLog.md +24/−0
- README.md +1/−1
- exchangealgebra.cabal +6/−1
- src/ExchangeAlgebra/Algebra/Exact.hs +608/−0
- src/ExchangeAlgebra/Algebra/Internal.hs +35/−2
- src/ExchangeAlgebra/Journal.hs +8/−0
- src/ExchangeAlgebra/Journal/Exact.hs +224/−0
- src/ExchangeAlgebra/Reporting/Group.hs +4/−0
- src/ExchangeAlgebra/Write.hs +4/−0
- test/Algebra/ExactSumSpec.hs +419/−0
- test/Spec.hs +2/−0
- test/Surface/Algebra/Exact.hs +36/−0
- test/Surface/Journal/Exact.hs +41/−0
- test/SurfaceMain.hs +2/−1
ChangeLog.md view
@@ -1,5 +1,29 @@ # Changelog for ExchangeAlgebra +## 0.5.2.0 - 2026-09-23++### Added++- `ExchangeAlgebra.Algebra.Exact` and `ExchangeAlgebra.Journal.Exact` provide+ checked readouts that sum original postings exactly and round each output+ once. The algebra API includes `normExact`, `barExact`,+ `projNetNormExact`, `balanceMapByExact`, `netPairMapByExact`,+ `postFromNetByExact`, `diffRLExact`, `balanceExact`, and+ `accountBalancesExact`. Journal projections cancel within each note before+ rounding the combined residual; other journal readouts aggregate notes.+ `sumExact` and the accumulator operations also support scalar aggregation.+ `ExactSum` supports `Double`, `MoneyDouble`, `NN.Double`, and `MoneyDecimal`.+ `ExactSumError` reports non-finite or negative inputs and exact sums beyond+ the finite range of the output type. Callers must handle the `Either` result.++### Documentation++- Mark the existing floating-point net and balance readouts as order-dependent+ where they sum postings sequentially, and identify tolerance-based+ cancellation. `netGross` and `relativeTo` document that their supplied gross+ totals may already be rounded; use exact readouts on the original postings+ upstream when exact balances are required.+ ## 0.5.1.0 - 2026-09-23 ### Added
README.md view
@@ -21,7 +21,7 @@ ```yaml # stack.yaml extra-deps:- - exchangealgebra-0.5.1.0+ - exchangealgebra-0.5.2.0 ``` ```yaml
exchangealgebra.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: exchangealgebra-version: 0.5.1.0+version: 0.5.2.0 synopsis: Exchange Algebra for bookkeeping and economic simulation description: Please see the README on GitHub at <https://github.com/yakagika/ExchangeAlgebra#readme> category: Accounting, Finance, Math@@ -84,6 +84,7 @@ ExchangeAlgebra.Algebra.Base.Account.Registry ExchangeAlgebra.Algebra.Base.Account.Types ExchangeAlgebra.Algebra.Base.Element+ ExchangeAlgebra.Algebra.Exact ExchangeAlgebra.Algebra.Internal ExchangeAlgebra.Algebra.Readout.Net ExchangeAlgebra.Algebra.Transfer@@ -97,6 +98,7 @@ ExchangeAlgebra.Convert.Csv ExchangeAlgebra.Foundation ExchangeAlgebra.Journal+ ExchangeAlgebra.Journal.Exact ExchangeAlgebra.Journal.Transfer ExchangeAlgebra.Journal.Transfer.Rule ExchangeAlgebra.Optimize@@ -191,8 +193,10 @@ main-is: SurfaceMain.hs other-modules: Surface.Accounting+ Surface.Algebra.Exact Surface.Algebra.Readout.Net Surface.Foundation+ Surface.Journal.Exact Surface.Render.Bookkeeping Surface.Render.Csv Surface.Render.Simulation@@ -231,6 +235,7 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:+ Algebra.ExactSumSpec Algebra.ProjWildcardSpec Golden.WriteRows Transfer.RuleSpec
+ src/ExchangeAlgebra/Algebra/Exact.hs view
@@ -0,0 +1,608 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Checked readouts retain exact sums until each output is rounded once.+-- This additive accounting layer uses the algebra, value types, and account+-- balance representation; journal readouts build on it in+-- "ExchangeAlgebra.Journal.Exact". Start with the accumulator contract, then+-- read the algebra readouts for grouping and cancellation rules.+--+-- Inputs must be finite and non-negative. Every intermediate aggregation unit+-- and output must be at most the largest finite value of its type. Errors are+-- sticky. Double outputs use nearest-even rounding and normalize negative zero.+-- For Double, MoneyDouble, and NN.Double, the same multiset of complete bases,+-- sides, and values gives bit-identical scalar outputs under reordering and+-- accumulator merging. Changing notes, compressing, or substituting rounded+-- partial totals is outside this guarantee, as are enumeration, Show, and Binary.+module ExchangeAlgebra.Algebra.Exact (+ -- * Accumulators+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ -- * Algebra readouts+ , normExact+ , barExact+ , projNetNormExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ -- * Accounting readouts+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ ) where++import qualified Data.Decimal as Decimal+import qualified Data.Foldable as Foldable+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map.Strict as Map+import qualified Data.Sequence as Seq+import qualified Number.NonNegative as NN++import ExchangeAlgebra.Algebra (+ Alg+ , HatVal(..)+ , foldEntries+ , (.@)+ , (.+)+ )+import qualified ExchangeAlgebra.Algebra as Algebra+import qualified ExchangeAlgebra.Algebra.Internal as Internal+import ExchangeAlgebra.Algebra.Base (+ AccountTitles+ , ExBaseClass(..)+ , Hat(..)+ , HatBaseClass(..)+ , Side(..)+ )+import ExchangeAlgebra.TrialBalance.Balance (AccountBalance(..))+import ExchangeAlgebra.Value (MoneyDecimal(..), MoneyDouble(..))++-- * Accumulators++-- | Checked summation failures. A failed accumulator cannot recover by netting.+data ExactSumError+ = NonFiniteInput -- ^ An input is NaN or infinite.+ | NegativeInput -- ^ An input is negative.+ | SumOutOfRange -- ^ An exact aggregation exceeds the largest finite value.+ deriving (Eq, Show)++-- | Exact non-negative aggregation with signed intermediates confined to the state.+-- Floating instances require IEEE-754 nearest-even arithmetic. Decimal arithmetic+-- has no upper range bound. Each readout validates its aggregation units before+-- cancellation; invalid inputs and out-of-range sums produce sticky failures.+--+-- == Laws+--+-- For all four supplied instances, on valid states whose sums are in range,+-- merge is commutative and associative, and empty is its identity, observed+-- through the represented exact value. Netting returns the exact comparison+-- and absolute difference. No tolerance applies. For floating instances,+-- observing these laws through 'roundAccum' gives bit-identical values;+-- 'roundAccum' is not a homomorphism into floating-point addition.+class HatVal n => ExactSum n where+ -- | State containing an exact non-negative value or a sticky failure.+ data Accum n++ -- | The valid state representing zero.+ emptyAccum :: Accum n++ -- | Add one finite non-negative input without rounding the represented sum.+ -- Invalid input or an exact sum beyond the type's range makes the state fail.+ addAccum :: n -> Accum n -> Accum n++ -- | Merge exact values without rounding, retaining failures from either input.+ -- The merged exact value must fit the type's range.+ mergeAccum :: Accum n -> Accum n -> Accum n++ -- | Validate both states, then return their exact comparison and absolute+ -- difference without rounding. Even equal out-of-range sides fail.+ netAccumState :: Accum n -> Accum n -> Either ExactSumError (Ordering, Accum n)++ -- | Round once to the value type, normalizing negative zero to positive zero.+ -- The exact value, not its rounded result, must be in range.+ roundAccum :: Accum n -> Either ExactSumError n++-- | Non-overlapping Shewchuk partials in increasing magnitude, with no zero terms.+-- Both the elements and the spine are strict; signed values remain private.+data Partials+ = NoPartials+ | Partial !Double !Partials++-- | Floating accumulator payload containing a checked scalar or expansion.+data FloatingState+ = FloatingFailure !ExactSumError+ | FloatingSingle !Double+ | FloatingSum !Partials++instance ExactSum Double where+ data Accum Double = DoubleAccum !FloatingState+ emptyAccum = DoubleAccum (FloatingSingle 0)+ addAccum value (DoubleAccum state) = DoubleAccum (addFloating value state)+ mergeAccum (DoubleAccum left) (DoubleAccum right) =+ DoubleAccum (mergeFloating left right)+ netAccumState (DoubleAccum left) (DoubleAccum right) = do+ (direction, difference) <- netFloating left right+ pure (direction, DoubleAccum difference)+ roundAccum (DoubleAccum state) = roundFloating state++instance ExactSum MoneyDouble where+ data Accum MoneyDouble = MoneyDoubleAccum !(Accum Double)+ emptyAccum = MoneyDoubleAccum emptyAccum+ addAccum (MoneyDouble value) (MoneyDoubleAccum state) =+ MoneyDoubleAccum (addAccum value state)+ mergeAccum (MoneyDoubleAccum left) (MoneyDoubleAccum right) =+ MoneyDoubleAccum (mergeAccum left right)+ netAccumState (MoneyDoubleAccum left) (MoneyDoubleAccum right) = do+ (direction, difference) <- netAccumState left right+ pure (direction, MoneyDoubleAccum difference)+ roundAccum (MoneyDoubleAccum state) = MoneyDouble <$> roundAccum state++instance ExactSum NN.Double where+ data Accum NN.Double = NonNegativeAccum !(Accum Double)+ emptyAccum = NonNegativeAccum emptyAccum+ addAccum value (NonNegativeAccum state) =+ NonNegativeAccum (addAccum (NN.toNumber value) state)+ mergeAccum (NonNegativeAccum left) (NonNegativeAccum right) =+ NonNegativeAccum (mergeAccum left right)+ netAccumState (NonNegativeAccum left) (NonNegativeAccum right) = do+ (direction, difference) <- netAccumState left right+ pure (direction, NonNegativeAccum difference)+ roundAccum (NonNegativeAccum state) = NN.fromNumber <$> roundAccum state++instance ExactSum MoneyDecimal where+ data Accum MoneyDecimal+ = DecimalFailure !ExactSumError+ | DecimalAccum !(Decimal.DecimalRaw Integer)+ emptyAccum = DecimalAccum 0+ addAccum _ failure@(DecimalFailure _) = failure+ addAccum (MoneyDecimal value) (DecimalAccum total)+ | value < 0 = DecimalFailure NegativeInput+ | otherwise = DecimalAccum (total + value)+ mergeAccum failure@(DecimalFailure _) _ = failure+ mergeAccum _ failure@(DecimalFailure _) = failure+ mergeAccum (DecimalAccum left) (DecimalAccum right) = DecimalAccum (left + right)+ netAccumState (DecimalFailure failure) _ = Left failure+ netAccumState _ (DecimalFailure failure) = Left failure+ netAccumState (DecimalAccum left) (DecimalAccum right) =+ Right (compare left right, DecimalAccum (abs (left - right)))+ roundAccum (DecimalFailure failure) = Left failure+ roundAccum (DecimalAccum value) = Right (MoneyDecimal value)++-- | Largest finite binary64 value, expressed without an overflowing intermediate.+maximumFinite :: Double+maximumFinite = encodeFloat (2 ^ (53 :: Int) - 1) (1024 - 53)++-- | Error-free two-sum with the greater-magnitude operand first.+twoSum :: Double -> Double -> (Double, Double)+twoSum left right+ | abs left < abs right = twoSum right left+ | otherwise = let !high = left + right+ !low = right - (high - left)+ in (high, low)++-- | Insert a signed component into an expansion without range checking.+-- An infinite high component records arithmetic overflow for the caller.+insertPartial :: Double -> Partials -> Partials+insertPartial value NoPartials+ | value == 0 = NoPartials+ | otherwise = Partial value NoPartials+insertPartial value (Partial next rest)+ | isInfinite high = Partial high NoPartials+ | low == 0 = insertPartial high rest+ | otherwise = Partial low (insertPartial high rest)+ where+ (!high, !low) = twoSum value next++-- | Reverse an expansion for comparisons, subtraction, and final rounding.+reversePartials :: Partials -> Partials+reversePartials = go NoPartials+ where+ go !result NoPartials = result+ go !result (Partial value rest) = go (Partial value result) rest++-- | Compare an expansion with zero using its largest nonzero component.+signPartials :: Partials -> Ordering+signPartials NoPartials = EQ+signPartials (Partial value NoPartials) = compare value 0+signPartials (Partial _ rest) = signPartials rest++-- | Keep zero and one-component states in a strict scalar payload, without a spine.+compactPartials :: Partials -> FloatingState+compactPartials NoPartials = FloatingSingle 0+compactPartials (Partial value NoPartials) = FloatingSingle value+compactPartials partials = FloatingSum partials++-- | Check the exact expansion against M. If the largest component is M,+-- the sign of the remaining expansion distinguishes M from M + one subnormal.+checkPartials :: Partials -> FloatingState+checkPartials partials = check 0 partials+ where+ check _ NoPartials = compactPartials partials+ check previous (Partial largest NoPartials)+ | isInfinite largest = FloatingFailure SumOutOfRange+ | largest > maximumFinite = FloatingFailure SumOutOfRange+ | largest == maximumFinite && previous > 0 = FloatingFailure SumOutOfRange+ | otherwise = compactPartials partials+ check _ (Partial value rest) = check value rest++-- | Add two checked non-negative scalars with one TwoSum. Allocate partials only+-- for a nonzero residual; a positive low term above M still fails before rounding.+addSingles :: Double -> Double -> FloatingState+addSingles 0 right = FloatingSingle right+addSingles left 0 = FloatingSingle left+addSingles left right+ | isInfinite high = FloatingFailure SumOutOfRange+ | high == maximumFinite && low > 0 = FloatingFailure SumOutOfRange+ | low == 0 = FloatingSingle high+ | otherwise = FloatingSum (Partial low (Partial high NoPartials))+ where+ (!high, !low) = twoSum left right++-- | Validate an input before inserting it into a valid floating state.+addFloating :: Double -> FloatingState -> FloatingState+addFloating _ failure@(FloatingFailure _) = failure+addFloating value (FloatingSingle total)+ | isNaN value || isInfinite value = FloatingFailure NonFiniteInput+ | value < 0 = FloatingFailure NegativeInput+ | otherwise = addSingles total value+addFloating value (FloatingSum partials)+ | isNaN value || isInfinite value = FloatingFailure NonFiniteInput+ | value < 0 = FloatingFailure NegativeInput+ | otherwise = checkPartials (insertPartial value partials)++-- | Merge ascending partials, then check the whole exact aggregation unit.+mergeFloating :: FloatingState -> FloatingState -> FloatingState+mergeFloating failure@(FloatingFailure _) _ = failure+mergeFloating _ failure@(FloatingFailure _) = failure+mergeFloating (FloatingSingle left) (FloatingSingle right) = addSingles left right+mergeFloating (FloatingSingle left) right =+ mergeFloating (FloatingSum (insertPartial left NoPartials)) right+mergeFloating left (FloatingSingle right) =+ mergeFloating left (FloatingSum (insertPartial right NoPartials))+mergeFloating (FloatingSum left) (FloatingSum right) = checkPartials (go left right)+ where+ go !total NoPartials = total+ go !total (Partial value rest) = go (insertPartial value total) rest++-- | Merge both expansions in descending magnitude, negating only the second+-- state's components. Cancel the large opposing components before inserting+-- either state's small signed tails. Inserting -M into an existing expansion+-- with a negative low component could otherwise overflow before cancellation.+netFloating :: FloatingState -> FloatingState+ -> Either ExactSumError (Ordering, FloatingState)+netFloating (FloatingFailure failure) _ = Left failure+netFloating _ (FloatingFailure failure) = Left failure+netFloating (FloatingSingle 0) (FloatingSingle 0) = Right (EQ, FloatingSingle 0)+netFloating (FloatingSingle 0) right = Right (LT, right)+netFloating left (FloatingSingle 0) = Right (GT, left)+netFloating (FloatingSingle left) (FloatingSingle right) =+ Right (compare left right, difference)+ where+ (!high, !low) = twoSum (max left right) (negate (min left right))+ difference+ | low == 0 = FloatingSingle high+ | otherwise = FloatingSum (Partial low (Partial high NoPartials))+netFloating (FloatingSingle left) right =+ netFloating (FloatingSum (insertPartial left NoPartials)) right+netFloating left (FloatingSingle right) =+ netFloating left (FloatingSum (insertPartial right NoPartials))+netFloating (FloatingSum NoPartials) (FloatingSum NoPartials) =+ Right (EQ, FloatingSingle 0)+netFloating (FloatingSum NoPartials) right = Right (LT, right)+netFloating left (FloatingSum NoPartials) = Right (GT, left)+netFloating (FloatingSum left) (FloatingSum right) =+ Right (direction, compactPartials magnitude)+ where+ difference = subtractPartials NoPartials (reversePartials left) (reversePartials right)+ direction = signPartials difference+ magnitude+ | direction == LT = negatePartials difference+ | otherwise = difference+ subtractPartials !total NoPartials NoPartials = total+ subtractPartials !total (Partial value rest) NoPartials =+ subtractPartials (insertPartial value total) rest NoPartials+ subtractPartials !total NoPartials (Partial value rest) =+ subtractPartials (insertPartial (negate value) total) NoPartials rest+ subtractPartials !total first@(Partial firstValue firstRest)+ second@(Partial secondValue secondRest)+ | abs firstValue >= abs secondValue =+ subtractPartials (insertPartial firstValue total) firstRest second+ | otherwise =+ subtractPartials (insertPartial (negate secondValue) total) first secondRest+ negatePartials NoPartials = NoPartials+ negatePartials (Partial value rest) = Partial (negate value) (negatePartials rest)++-- | Collapse from the largest component, correcting ties with the next residual.+-- This is the nearest-even finalization used with Shewchuk expansions.+roundPartials :: Partials -> Double+roundPartials NoPartials = 0+roundPartials (Partial value NoPartials) = value+roundPartials partials = case reversePartials partials of+ NoPartials -> 0+ Partial value rest -> collapse value rest+ where+ collapse !high NoPartials = high+ collapse !high (Partial value rest)+ | low == 0 = collapse rounded rest+ | otherwise = correct rounded low rest+ where+ (!rounded, !low) = twoSum high value+ correct high low (Partial next _)+ | (low < 0 && next < 0) || (low > 0 && next > 0)+ , let doubled = low * 2+ , let adjusted = high + doubled+ , adjusted - high == doubled = adjusted+ correct high _ _ = high++-- | Extract one checked scalar; zero has its canonical positive sign.+roundFloating :: FloatingState -> Either ExactSumError Double+roundFloating (FloatingFailure failure) = Left failure+roundFloating (FloatingSingle value)+ | value == 0 = Right 0+ | otherwise = Right value+roundFloating (FloatingSum partials)+ | rounded == 0 = Right 0+ | otherwise = Right rounded+ where+ rounded = roundPartials partials++-- | Validate two exact states and round their absolute difference once.+-- The direction compares the first state with the second without tolerance.+netAccum :: ExactSum n => Accum n -> Accum n -> Either ExactSumError (Ordering, n)+netAccum left right = do+ (direction, difference) <- netAccumState left right+ magnitude <- roundAccum difference+ pure (direction, magnitude)++-- | Sum finite non-negative inputs exactly and round once. The exact total+-- must fit the value type; unlike a sequential floating sum, order has no effect.+sumExact :: (ExactSum n, Foldable f) => f n -> Either ExactSumError n+sumExact = roundAccum . Foldable.foldl' (flip addAccum) emptyAccum++-- * Algebra readouts++-- | Two non-negative states, ordered as Not then Hat, or debit then credit.+data Sides n = Sides !(Accum n) !(Accum n)++-- | Two empty side totals.+emptySides :: ExactSum n => Sides n+emptySides = Sides emptyAccum emptyAccum++-- | Add to the first side when the predicate holds, otherwise the second.+addSide :: ExactSum n => Bool -> n -> Sides n -> Sides n+addSide True value (Sides first second) = Sides (addAccum value first) second+addSide False value (Sides first second) = Sides first (addAccum value second)++-- | Add the entries observed by foldEntries, preserving its exact-zero filter.+addPosting :: ExactSum n => Accum n -> n -> Accum n+{-# INLINE addPosting #-}+addPosting total value+ | isZeroValue value = total+ | otherwise = addAccum value total++-- | Visit the stored complete-base pairs without reconstructing posting bases.+foldPairs :: (HatVal n, HatBaseClass b)+ => (a -> BasePart b -> Internal.Pair n -> a) -> a -> Alg n b -> a+{-# INLINE foldPairs #-}+foldPairs _ initial Internal.Zero = initial+foldPairs collect initial (value Internal.:@ postingBase)+ | isZeroValue value = initial+ | otherwise = collect initial (base postingBase) pair+ where+ pair+ | isHat postingBase = Internal.Pair (Seq.singleton value) Seq.empty+ | otherwise = Internal.Pair Seq.empty (Seq.singleton value)+foldPairs collect initial (Internal.Liner pairs _ _ _ _ _) =+ HashMap.foldlWithKey' collect initial pairs++-- | Accumulate each stored side before exact cancellation, without regrouping.+netPairState :: ExactSum n => Internal.Pair n -> Either ExactSumError (Ordering, Accum n)+{-# INLINE netPairState #-}+netPairState (Internal.Pair hats nots) = netAccumState+ (Foldable.foldl' addPosting emptyAccum nots)+ (Foldable.foldl' addPosting emptyAccum hats)++-- | Exact absolute residual states, retaining the winning complete base.+baseResiduals :: (ExactSum n, HatBaseClass b)+ => Alg n b -> Either ExactSumError [(b, Accum n)]+{-# INLINE baseResiduals #-}+baseResiduals = foldPairs collect (Right [])+ where+ collect result basePart pair = do+ residuals <- result+ (direction, magnitude) <- netPairState pair+ case direction of+ EQ -> pure residuals+ GT -> pure ((merge Not basePart, magnitude) : residuals)+ LT -> pure ((merge Hat basePart, magnitude) : residuals)++-- | Read the gross norm of all finite non-negative postings with one rounding.+-- Hat and Not both contribute; their combined exact total must fit the type.+-- This avoids the order-dependent floating addition used by the existing norm.+normExact :: (ExactSum n, HatBaseClass b) => Alg n b -> Either ExactSumError n+{-# INLINABLE normExact #-}+normExact Internal.Zero = roundAccum emptyAccum+normExact (value Internal.:@ _) = roundAccum (addPosting emptyAccum value)+normExact (Internal.Liner pairs _ _ _ _ _) =+ roundAccum (HashMap.foldl' collect emptyAccum pairs)+ where+ collect total (Internal.Pair hats nots) =+ Foldable.foldl' addPosting (Foldable.foldl' addPosting total hats) nots++-- | Cancel only exactly equal complete bases, returning non-negative postings.+-- Each finite non-negative side total must fit the type. Each surviving base+-- difference is rounded once, with no cancellation tolerance as in the old bar.+-- Scalar bits follow the module's multiset guarantee; posting order does not.+barExact :: (ExactSum n, HatBaseClass b)+ => Alg n b -> Either ExactSumError (Alg n b)+{-# INLINABLE barExact #-}+barExact Internal.Zero = Right Internal.Zero+barExact (value Internal.:@ _) | isZeroValue value = Right Internal.Zero+barExact (value Internal.:@ postingBase) =+ (.@ merge side (base postingBase)) <$> roundAccum (addPosting emptyAccum value)+ where+ side+ | isHat postingBase = Hat+ | otherwise = Not+barExact (Internal.Liner pairs _ _ _ _ _) = do+ rounded <- traverse roundPair pairs+ let remaining = HashMap.mapMaybe id rounded+ pure $ case HashMap.null remaining of+ True -> Internal.Zero+ False -> Internal.linerFromMap remaining+ where+ roundPair pair = do+ (direction, state) <- netPairState pair+ case direction of+ EQ -> pure Nothing+ GT -> do+ value <- roundAccum state+ pure (makePair Not value)+ LT -> do+ value <- roundAccum state+ pure (makePair Hat value)+ makePair _ value | isZeroValue value = Nothing+ makePair Hat value = Just (Internal.Pair (Seq.singleton value) Seq.empty)+ makePair _ value = Just (Internal.Pair Seq.empty (Seq.singleton value))++-- | Project with set semantics, cancel per complete base, then round the sum+-- of residual states once. Selected inputs must be finite and non-negative;+-- each side total and the residual total must fit the type.+--+-- Unlike the existing projection readout, no sequential rounding or tolerance+-- is used. It equals @normExact =<< barExact (Algebra.proj bases algebra)@ only+-- as a mathematical operation interpreting every operation at infinite precision.+-- With T = 2^53, residuals T+1 and 1 give T+2 here but T after rounding each base+-- first. Duplicate queries never duplicate postings.+projNetNormExact :: (ExactSum n, HatBaseClass b)+ => [b] -> Alg n b -> Either ExactSumError n+projNetNormExact bases algebra = do+ residuals <- baseResiduals (Algebra.proj bases algebra)+ roundAccum (Foldable.foldl' (\total (_, state) -> mergeAccum total state)+ emptyAccum residuals)++-- | Sum selected finite non-negative postings by key and net each key once.+-- Each key's side totals must fit the type. GT means Not is larger, LT means+-- Hat is larger, and EQ retains a zero key. Unlike the signed, sequential old+-- readout, the magnitude is non-negative and no tolerance is applied.+-- Postings whose key is Nothing are not validated or aggregated.+balanceMapByExact :: (ExactSum n, HatBaseClass b, Ord k)+ => (BasePart b -> Maybe k) -> Alg n b+ -> Either ExactSumError (Map.Map k (Ordering, n))+{-# INLINABLE balanceMapByExact #-}+balanceMapByExact keyOf algebra = traverse finish grouped+ where+ grouped = case algebra of+ singleton@(_ Internal.:@ _) -> foldEntries collectPosting Map.empty singleton+ _ -> foldPairs collect Map.empty algebra+ collectPosting previous value postingBase = case keyOf (base postingBase) of+ Nothing -> previous+ Just key -> Map.alter (Just . addSide (not (isHat postingBase)) value+ . maybe emptySides id) key previous+ collect totals basePart (Internal.Pair hats nots)+ | Foldable.all isZeroValue hats && Foldable.all isZeroValue nots = totals+ | otherwise = case keyOf basePart of+ Nothing -> totals+ Just key -> Map.alter (Just . addPair . maybe emptySides id) key totals+ where+ addPair (Sides first second) = Sides+ (Foldable.foldl' addPosting first nots)+ (Foldable.foldl' addPosting second hats)+ finish (Sides first second) = netAccum first second++-- | Cancel per complete base before merging residual states by key and side.+-- All inputs must be finite and non-negative; base-side and key-side totals+-- must fit the type. Each output side is rounded once. There is no tolerance.+-- Distinct bases with Not 10 and Hat 7 give (10,7), as in the existing readout;+-- the pair is ordered Not then Hat and does not net across bases.+netPairMapByExact :: (ExactSum n, HatBaseClass b, Ord k)+ => (BasePart b -> Maybe k) -> Alg n b+ -> Either ExactSumError (Map.Map k (n, n))+{-# INLINABLE netPairMapByExact #-}+netPairMapByExact keyOf algebra = do+ residuals <- baseResiduals algebra+ traverse finish (Foldable.foldl' collect Map.empty residuals)+ where+ collect totals (postingBase, state) = case keyOf (base postingBase) of+ Nothing -> totals+ Just key -> Map.alter (Just . combine . maybe emptySides id) key totals+ where+ combine (Sides first second)+ | isHat postingBase = Sides first (mergeAccum second state)+ | otherwise = Sides (mergeAccum first state) second+ finish (Sides first second) = (,) <$> roundAccum first <*> roundAccum second++-- | Net each complete base, restore its winning side, select its key, merge+-- residual states by key, round once, then call the posting function.+-- All input base-side and selected key totals must fit the type; inputs must be+-- finite and non-negative. Unlike the old function, no tolerance or rounded+-- intermediate algebra is used. Validation and the one-rounding guarantee end+-- at the amount passed to the callback; values made by the callback are not covered.+postFromNetByExact :: (ExactSum n, HatBaseClass b, Ord k)+ => (b -> Maybe k) -> (k -> n -> Alg n b) -> Alg n b+ -> Either ExactSumError (Alg n b)+postFromNetByExact keyOf post algebra = do+ residuals <- baseResiduals algebra+ amounts <- traverse roundAccum (Foldable.foldl' collect Map.empty residuals)+ pure (Map.foldlWithKey' (\result key value -> result .+ post key value) mempty amounts)+ where+ collect totals (postingBase, state) = case keyOf postingBase of+ Nothing -> totals+ Just key -> Map.insertWith mergeAccum key state totals++-- * Accounting readouts++-- | Collect accounting sides; a structural Side contributes to neither total.+accountSide :: ExactSum n => Side -> n -> Sides n -> Sides n+accountSide Debit = addSide True+accountSide Credit = addSide False+accountSide Side = const id++-- | Recover a debit or credit direction from an exact comparison.+accountDirection :: Ordering -> Side+accountDirection GT = Debit+accountDirection LT = Credit+accountDirection EQ = Side++-- | Compare debit and credit exact totals, rounding only their absolute difference.+-- Finite non-negative inputs and both side totals must fit the type. Only exact+-- equality returns (Side,0); the existing tolerance-based diffRL is lossy.+-- Structural Side postings contribute no value and are not validated.+diffRLExact :: (ExactSum n, ExBaseClass b)+ => Alg n b -> Either ExactSumError (Side, n)+diffRLExact algebra = do+ let Sides debit credit = foldEntries collect emptySides algebra+ (direction, amount) <- netAccum debit credit+ pure (accountDirection direction, amount)+ where+ collect totals value postingBase = accountSide (whichSide postingBase) value totals++-- | Test exact debit-credit equality without the old balance tolerance.+-- The finite non-negative input and side-total range checks of 'diffRLExact'+-- apply. Its amount is rounded once, while this predicate observes exact direction.+balanceExact :: (ExactSum n, ExBaseClass b) => Alg n b -> Either ExactSumError Bool+balanceExact = fmap ((== Side) . fst) . diffRLExact++-- | Aggregate by account title and net debit against credit without tolerance.+-- Finite non-negative inputs and each account's side totals must fit the type.+-- Each account magnitude is rounded once, instead of sequentially summing as+-- in the old accountBalances. Balanced accounts remain present as NoBalance.+-- Structural Side postings contribute no value and are not validated.+accountBalancesExact :: (ExactSum n, ExBaseClass b)+ => Alg n b -> Either ExactSumError (Map.Map AccountTitles (AccountBalance n))+accountBalancesExact = traverse finish . foldEntries collect Map.empty+ where+ collect totals value postingBase =+ Map.alter (Just . accountSide (whichSide postingBase) value+ . maybe emptySides id) (getAccountTitle postingBase) totals+ finish (Sides debit credit) = do+ (direction, amount) <- netAccum debit credit+ pure $ case direction of+ EQ -> NoBalance+ GT -> DebitBalance amount+ LT -> CreditBalance amount
src/ExchangeAlgebra/Algebra/Internal.hs view
@@ -52,6 +52,7 @@ , HatVal(..) , Pair(..) , Alg(..)+ , linerFromMap , isZero , (.@) , (<@)@@ -243,12 +244,19 @@ (.^) :: a n b -> a n b -- | Bar operation. Cancels Hat/Not on the same base and retains only the difference.+ -- Floating-point side totals use sequential addition and depend on posting order;+ -- near-equal sides cancel under 'nearlyEqScaled'. For exact totals, see+ -- "ExchangeAlgebra.Algebra.Exact" or "ExchangeAlgebra.Journal.Exact". -- Complexity: O(n) (n is the number of base keys) (.-) :: a n b -> a n b -- | Alias for bar operation. Identical to @(.-)@. -- On an axis-preserving ledger, @norm . bar@ cancels only within each full -- base. Use 'balanceMapBy' or 'netPairMapBy' for net amounts by group.+ -- Floating-point side totals depend on posting order, and near-equal sides+ -- cancel under 'nearlyEqScaled'. See "ExchangeAlgebra.Algebra.Exact" for+ -- exact netting of the original postings, or "ExchangeAlgebra.Journal.Exact"+ -- for journal readouts. bar :: a n b -> a n b bar = (.-) @@ -315,9 +323,19 @@ -- | Extracts only the Not-side elements (the M-projection of the -- decomposition; @isHat@ does not hold). Complexity: O(s) decM :: a n b -> a n b- -- | Checks whether the norms of debit and credit sides are equal. Complexity: O(s)+ -- | Checks whether the norms of debit and credit sides are equal. The norms+ -- sum floating-point postings sequentially, so their totals depend on order;+ -- 'nearlyEqScaled' treats near-equal totals as balanced. For an exact check+ -- over the original postings, see "ExchangeAlgebra.Algebra.Exact" or+ -- "ExchangeAlgebra.Journal.Exact".+ -- Complexity: O(s) balance :: a n b -> Bool- -- | Returns the debit-credit difference as a (Side, difference) pair. Complexity: O(s)+ -- | Returns the debit-credit difference as a (Side, difference) pair. The+ -- side norms sum floating-point postings sequentially and depend on order;+ -- 'nearlyEqScaled' reports a zero difference for near-equal totals. For+ -- exact netting of the original postings, see "ExchangeAlgebra.Algebra.Exact"+ -- or "ExchangeAlgebra.Journal.Exact".+ -- Complexity: O(s) diffRL :: a n b -> (Side, n) @@ -1696,6 +1714,9 @@ -- On an axis-preserving ledger, this nets only within each projected full -- base; it does not cancel across axis values. Use 'balanceMapBy' or -- 'netPairMapBy' for net amounts by group.+-- Floating-point side and projected totals use sequential addition and depend+-- on posting order. 'nearlyEqScaled' cancels near-equal sides. See+-- "ExchangeAlgebra.Algebra.Exact" for exact sums over the original postings. -- -- Complexity: O(cost(proj) + cost(bar) + cost(norm)). projNetNorm :: (HatVal n, HatBaseClass b) => [b] -> Alg n b -> n@@ -1751,6 +1772,9 @@ -- | Compute the net balance as the difference of two projections. -- @balanceBy plusBases minusBases alg@ computes -- @projNetNorm plusBases alg - projNetNorm minusBases alg@.+-- Floating-point totals inherit the posting-order dependence and near-equal+-- cancellation of 'projNetNorm'. See "ExchangeAlgebra.Algebra.Exact" for exact+-- sums over the original postings. -- -- Useful for calculating stock quantities, profits, etc. --@@ -1783,6 +1807,9 @@ -- type (e.g. 'Double', @MoneyDouble@, @MoneyDecimal@); a non-negative-only type -- such as @Number.NonNegative.Double@ is unsuitable here. Keys whose net is zero -- are kept (like 'foldEntriesToMap'); filter afterwards if undesired.+-- Floating-point bucket sums use sequential addition and depend on posting+-- order. See "ExchangeAlgebra.Algebra.Exact" for exact sums over the original+-- postings. -- -- Complexity: O(total number of entries) — a single fold, no per-key projection. --@@ -1828,6 +1855,9 @@ -- @n - h@ identity with 'balanceMapBy' only holds on a /signed/ value type -- (e.g. 'Double', @MoneyDouble@, @MoneyDecimal@) where the difference can be -- negative.+-- Floating-point per-base and per-key sums use sequential addition and depend+-- on posting order. 'nearlyEqScaled' drops near-equal per-base sides. See+-- "ExchangeAlgebra.Algebra.Exact" for exact sums over the original postings. -- -- Complexity: O(total number of entries) — a single fold over the entries, -- followed by one collapse over the distinct bases.@@ -1972,6 +2002,9 @@ -- Thus it factors through the quotient induced by 'bar': it is not the free -- extension that acts independently on entries in the redundant layer (that -- one is 'extendBy').+-- Floating-point per-base and class totals use sequential addition and depend+-- on posting order; 'bar' cancels near-equal sides under 'nearlyEqScaled'. See+-- "ExchangeAlgebra.Algebra.Exact" for exact sums over the original postings. -- -- Complexity: O(m + Σ cost(post)). --
src/ExchangeAlgebra/Journal.hs view
@@ -826,6 +826,10 @@ -- (e.g. a @HatNot@ wildcard, or a list selecting both sides of one base) -- selects both the hat and the not side of a base: the un-netted norm sums -- both sides, the netted one cancels them. See 'EA.projNetNorm'.+-- Floating-point sums within each note and across notes use sequential addition+-- and depend on posting and note order. Near-equal sides cancel under+-- 'EA.nearlyEqScaled'. See "ExchangeAlgebra.Journal.Exact" for exact sums over+-- the original postings. -- -- Complexity: O(j * proj cost) where j is the number of Notes projWithBaseNetNorm :: (HatVal v, HatBaseClass b, Note n)@@ -878,6 +882,10 @@ -- -- which is __not__ the same as @norm (projWithNoteBase ns bs js)@ when a query -- selects both sides of one base (see 'projWithBaseNetNorm').+-- Floating-point sums within each note and across selected notes use sequential+-- addition and depend on posting and note order. Near-equal sides cancel under+-- 'EA.nearlyEqScaled'. See "ExchangeAlgebra.Journal.Exact" for exact sums over+-- the original postings. -- -- Complexity: O(|ns| * proj cost) projWithNoteBaseNetNorm :: (HatVal v, HatBaseClass b, Note n)
+ src/ExchangeAlgebra/Journal/Exact.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++-- | Checked journal readouts preserve exact residuals across note boundaries.+-- This journal layer uses "ExchangeAlgebra.Algebra.Exact" and the existing+-- journal projections. Start with the algebra accumulator contract, then read+-- the projection section for cancellation within each note. Other readouts+-- aggregate notes, as the existing journal bar does.+--+-- Inputs must be finite and non-negative; all intermediate aggregation units+-- and final outputs must fit the value type. Each scalar is rounded once,+-- without cancellation tolerance, and negative zero becomes positive zero.+-- For Double, MoneyDouble, and NN.Double, scalar bits depend only on the multiset+-- of (note, complete base, side, value), including under accumulator merging.+-- Reassigning notes, compressing, substituting rounded partial sums, enumeration,+-- Show, and Binary are outside that guarantee.+module ExchangeAlgebra.Journal.Exact (+ -- * Accumulators+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ -- * Journal readouts+ , normExact+ , barExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ -- * Projections+ , projNetNormExact+ , projWithBaseNetNormExact+ , projWithNoteBaseNetNormExact+ -- * Accounting readouts+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ ) where++import qualified Data.Foldable as Foldable+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map.Strict as Map++import ExchangeAlgebra.Algebra (Alg, HatVal(..))+import qualified ExchangeAlgebra.Algebra.Internal as Internal+import ExchangeAlgebra.Algebra.Base (+ AccountTitles+ , ExBaseClass+ , Hat(..)+ , HatBaseClass(..)+ , Side+ )+import ExchangeAlgebra.Algebra.Exact (+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ )+import qualified ExchangeAlgebra.Algebra.Exact as Exact+import ExchangeAlgebra.Journal (Journal, Note(..), (.|))+import qualified ExchangeAlgebra.Journal as Journal+import ExchangeAlgebra.TrialBalance.Balance (AccountBalance)++-- * Accumulators++-- The scalar accumulator operations are re-exported from the algebra layer.++-- * Journal readouts++-- | Scan stored complete-base pairs, retaining Not and Hat states independently.+-- No note boundary is crossed until the caller explicitly combines its input.+residuals :: (ExactSum n, HatBaseClass b)+ => Alg n b -> Either ExactSumError [(b, Accum n)]+residuals Internal.Zero = Right []+residuals (value Internal.:@ postingBase)+ | isZeroValue value = Right []+ | otherwise = do+ (direction, state) <- netAccumState (addAccum value emptyAccum) emptyAccum+ pure $ case direction of+ EQ -> []+ _ -> [(merge side (base postingBase), state)]+ where+ side+ | isHat postingBase = Hat+ | otherwise = Not+residuals (Internal.Liner pairs _ _ _ _ _) = HashMap.foldlWithKey' finish (Right []) pairs+ where+ add total value+ | isZeroValue value = total+ | otherwise = addAccum value total+ finish result basePart (Internal.Pair hats nots) = do+ previous <- result+ (direction, difference) <- netAccumState+ (Foldable.foldl' add emptyAccum nots) (Foldable.foldl' add emptyAccum hats)+ pure $ case direction of+ EQ -> previous+ GT -> (merge Not basePart, difference) : previous+ LT -> (merge Hat basePart, difference) : previous++-- | Sum every posting across notes and round the gross norm once.+-- Finite non-negative inputs and their combined Hat-plus-Not total must fit the+-- type. Unlike the existing norm, floating summation order does not affect bits.+normExact :: (ExactSum n, HatBaseClass b, Note t)+ => Journal t n b -> Either ExactSumError n+normExact = Exact.normExact . Journal.toAlg++-- | Gather notes into plank, then cancel complete bases exactly.+-- Each finite non-negative base-side total must fit the type. Each residual is+-- rounded once, with no tolerance. Notes are aggregated as in the existing bar;+-- use the projection readouts for cancellation confined to each note.+barExact :: (ExactSum n, HatBaseClass b, Note t)+ => Journal t n b -> Either ExactSumError (Journal t n b)+barExact journal = (.| plank) <$> Exact.barExact (Journal.toAlg journal)++-- | Aggregate selected postings across notes by key and net each key once.+-- Inputs must be finite and non-negative and each key-side total must fit the+-- type. GT means Not wins, LT means Hat wins, and zero keys remain (EQ,0).+-- The magnitude is non-negative, without the old signed sequential summation.+-- Postings whose key is Nothing are not validated or aggregated.+balanceMapByExact :: (ExactSum n, HatBaseClass b, Note t, Ord k)+ => (BasePart b -> Maybe k) -> Journal t n b+ -> Either ExactSumError (Map.Map k (Ordering, n))+balanceMapByExact keyOf = Exact.balanceMapByExact keyOf . Journal.toAlg++-- | Gather notes, cancel per complete base, and merge by key and winning side.+-- Finite non-negative inputs, base-side totals, and key-side residual totals+-- must fit the type. Each (Not,Hat) output component is rounded once, without+-- tolerance. Distinct bases with Not 10 and Hat 7 retain (10,7).+netPairMapByExact :: (ExactSum n, HatBaseClass b, Note t, Ord k)+ => (BasePart b -> Maybe k) -> Journal t n b+ -> Either ExactSumError (Map.Map k (n, n))+netPairMapByExact keyOf = Exact.netPairMapByExact keyOf . Journal.toAlg++-- | Gather notes, net each base, restore its winning side, select the key,+-- merge residual states, round once per key, then invoke the journal callback.+-- Finite non-negative inputs and all base-side and selected key totals must+-- fit the type. No tolerance or rounded intermediate bar is used. The checks+-- and rounding guarantee end at the callback's argument, not its output.+postFromNetByExact :: (ExactSum n, HatBaseClass b, Note t, Ord k)+ => (b -> Maybe k) -> (k -> n -> Journal t n b) -> Journal t n b+ -> Either ExactSumError (Journal t n b)+postFromNetByExact keyOf post journal = do+ remaining <- residuals (Journal.toAlg journal)+ amounts <- traverse roundAccum (Foldable.foldl' collect Map.empty remaining)+ pure (Map.foldlWithKey' (\result key value -> result <> post key value) mempty amounts)+ where+ collect totals (postingBase, state) = case keyOf postingBase of+ Nothing -> totals+ Just key -> Map.insertWith mergeAccum key state totals++-- * Projections++-- | Merge every note's exact base residuals before the only scalar rounding.+-- The caller has already selected notes and bases with the existing projections.+projectedNorm :: (ExactSum n, HatBaseClass b, Note t)+ => Journal t n b -> Either ExactSumError n+projectedNorm journal = do+ total <- HashMap.foldl' collect (Right emptyAccum) (Journal.toMap journal)+ roundAccum total+ where+ collect result algebra = do+ previous <- result+ remaining <- residuals algebra+ pure (Foldable.foldl' (\total (_, state) -> mergeAccum total state) previous remaining)++-- | Project bases with set semantics and cancel within each note.+-- This is 'projWithBaseNetNormExact': finite non-negative selected inputs,+-- base-side totals, and the combined residual total must fit the type. There+-- is one final rounding and no tolerance; repeated queries do not repeat values.+projNetNormExact :: (ExactSum n, HatBaseClass b, Note t)+ => [b] -> Journal t n b -> Either ExactSumError n+projNetNormExact = projWithBaseNetNormExact++-- | Project bases, net each complete base within each note, merge residual+-- states across notes, and round once. Finite non-negative selected inputs,+-- each base-side total, and the final residual sum must fit the type.+-- Different notes containing Not 10 and Hat 10 yield 20, not zero.+--+-- Unlike the old readout, no note-local scalar is rounded before summation.+-- Equality with a norm of per-note bars holds only as a mathematical operation+-- interpreting every operation at infinite precision. With T = 2^53, residuals+-- T+1 and 1 yield T+2 here, but T if each base is rounded first. Duplicate base+-- queries have set semantics and do not change output bits.+projWithBaseNetNormExact :: (ExactSum n, HatBaseClass b, Note t)+ => [b] -> Journal t n b -> Either ExactSumError n+projWithBaseNetNormExact bases = projectedNorm . Journal.projWithBase bases++-- | Select notes and bases with the existing wildcard and set semantics, then+-- cancel within each note and round the merged residual states once.+-- Empty notes or plank select all notes; duplicate queries do not duplicate+-- postings. Finite non-negative selected inputs, base-side totals, and the+-- final residual sum must fit the type. No tolerance or intermediate rounding+-- is used, with the same mathematical equality qualification as+-- 'projWithBaseNetNormExact'.+projWithNoteBaseNetNormExact :: (ExactSum n, HatBaseClass b, Note t)+ => [t] -> [b] -> Journal t n b -> Either ExactSumError n+projWithNoteBaseNetNormExact notes bases =+ projectedNorm . Journal.projWithNoteBase notes bases++-- * Accounting readouts++-- | Net debit and credit across notes and round the absolute difference once.+-- Finite non-negative inputs and both side totals must fit the type. Only+-- exact equality yields Side, without the tolerance of the old diffRL.+-- Structural Side postings contribute no value and are not validated.+diffRLExact :: (ExactSum n, ExBaseClass b, Note t)+ => Journal t n b -> Either ExactSumError (Side, n)+diffRLExact = Exact.diffRLExact . Journal.toAlg++-- | Test exact debit-credit equality across notes with the checks of 'diffRLExact'.+-- This observes exact direction, with no tolerance; its scalar is rounded once.+balanceExact :: (ExactSum n, ExBaseClass b, Note t)+ => Journal t n b -> Either ExactSumError Bool+balanceExact = Exact.balanceExact . Journal.toAlg++-- | Aggregate by account title across notes and net each account exactly.+-- Finite non-negative inputs and account-side totals must fit the type. Each+-- magnitude is rounded once, replacing sequential sums without a tolerance.+-- Exact zero accounts remain NoBalance, as in the algebra account readout.+-- Structural Side postings contribute no value and are not validated.+accountBalancesExact :: (ExactSum n, ExBaseClass b, Note t)+ => Journal t n b+ -> Either ExactSumError (Map.Map AccountTitles (AccountBalance n))+accountBalancesExact = Exact.accountBalancesExact . Journal.toAlg
src/ExchangeAlgebra/Reporting/Group.hs view
@@ -231,6 +231,10 @@ -- scale-aware near-equality as @ExchangeAlgebra.Write.netGross@\/@diffRL@, so -- a balance that nets to zero within tolerance reports a zero magnitude -- rather than floating-point dust.+-- This function compares two supplied totals; it does not sum postings. If+-- floating-point addition has already rounded those totals, use+-- @ExchangeAlgebra.Journal.Exact.accountBalancesExact@ or+-- @ExchangeAlgebra.Algebra.Exact.diffRLExact@ upstream on the original postings. relativeTo :: HatVal v => Side -> (v, v) -> RelativeAmount v relativeTo side (debit, credit) | nearlyEqScaled debit credit = RelativeAmount False zeroValue
src/ExchangeAlgebra/Write.hs view
@@ -632,6 +632,10 @@ -- against @l = 'norm' . 'decL'@ (debit) with the scale-aware tolerance, so the -- same comparison is applied here: near-equal sides report v'Side' with zero -- magnitude, otherwise the larger side wins with the non-negative difference.+-- This function compares two supplied totals; it does not sum postings. If+-- floating-point addition has already rounded those totals, use+-- @ExchangeAlgebra.Journal.Exact.accountBalancesExact@ or+-- @ExchangeAlgebra.Algebra.Exact.diffRLExact@ upstream on the original postings. -- -- Complexity: O(1). netGross :: (HatVal n) => (n, n) -> (Side, n)
+ test/Algebra/ExactSumSpec.hs view
@@ -0,0 +1,419 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Rational-oracle and bit-level acceptance tests for checked exact readouts.+module Algebra.ExactSumSpec (runTests) where++import Control.Monad (unless)+import qualified Data.Decimal as Decimal+import qualified Data.List as List+import qualified Data.Map.Strict as Map+import Data.Word (Word64)+import GHC.Float (castDoubleToWord64)+import qualified Number.NonNegative as NN+import System.Exit (exitFailure)+import Test.QuickCheck hiding (collect)++import ExchangeAlgebra.Algebra.Base hiding (equal)+import ExchangeAlgebra.Algebra (Alg, (.@))+import qualified ExchangeAlgebra.Algebra as Algebra+import ExchangeAlgebra.Algebra.Exact+import qualified ExchangeAlgebra.Journal as Journal+import qualified ExchangeAlgebra.Journal.Exact as JournalExact+import ExchangeAlgebra.TrialBalance.Balance (AccountBalance(..))+import ExchangeAlgebra.Value (MoneyDecimal(..), MoneyDouble(..))++-- | Concrete complete bases with no wildcard ordering in the oracle.+type TestBase = HatBase AccountTitles++-- | Double posting ledger used by the readout acceptance cases.+type TestAlg = Alg Double TestBase++-- | Notes are strings, including the existing empty-string plank wildcard.+type TestJournal = Journal.Journal String Double TestBase++-- | Largest finite binary64 input.+maximumFinite :: Double+maximumFinite = encodeFloat (2 ^ (53 :: Int) - 1) 971++-- | Smallest positive binary64 subnormal input.+subnormal :: Double+subnormal = encodeFloat 1 (-1074)++-- | First integer whose successor cannot be represented in binary64.+threshold :: Double+threshold = 2 ^ (53 :: Int)++-- | Compare successful outputs by all 64 bits, including the sign of zero.+bits :: Either ExactSumError Double -> Either ExactSumError Word64+bits = fmap castDoubleToWord64++-- | Exact reference with a range check before nearest-even conversion.+oracle :: Rational -> Either ExactSumError Double+oracle value+ | value > toRational maximumFinite = Left SumOutOfRange+ | otherwise = Right (fromRational value)++-- | Build an accumulator without rounding its intermediate states.+accumulate :: ExactSum n => [n] -> Accum n+accumulate = List.foldl' (flip addAccum) emptyAccum++-- | Generate finite non-negative inputs across all binary64 exponent ranges.+genValue :: Gen Double+genValue = frequency+ [ (3, elements [0, subnormal, maximumFinite, threshold, 1, 1e308])+ , (7, do+ mantissa <- chooseInteger (1, 2 ^ (53 :: Int) - 1)+ power <- chooseInt (-1074, 971)+ pure (encodeFloat mantissa power))+ ]++-- | Moderate-sized lists include both valid and overflowing exact totals.+genValues :: Gen [Double]+genValues = chooseInt (0, 25) >>= flip vectorOf genValue++-- | Permutations, construction by split, and merge association share one oracle.+propSum :: Property+propSum = forAll genValues $ \values -> forAll (shuffle values) $ \permuted ->+ forAll (chooseInt (0, length values)) $ \cut ->+ let (left, right) = splitAt cut values+ expected = bits (oracle (sum (fmap toRational values)))+ first = accumulate left+ second = accumulate right+ (middle, lastPart) = splitAt (length right `div` 2) right+ middleState = accumulate middle+ lastState = accumulate lastPart+ in conjoin+ [ bits (sumExact values) === expected+ , bits (sumExact permuted) === expected+ , bits (roundAccum (mergeAccum first second)) === expected+ , bits (roundAccum (mergeAccum second first)) === expected+ , bits (roundAccum (mergeAccum emptyAccum (mergeAccum first second))) === expected+ , bits (roundAccum (mergeAccum (mergeAccum first emptyAccum) second)) === expected+ , bits (roundAccum (mergeAccum first (mergeAccum middleState lastState))) === expected+ , bits (roundAccum (mergeAccum (mergeAccum first middleState) lastState)) === expected+ ]++-- | Netting checks both exact side ranges before subtracting, without tolerance.+propNet :: Property+propNet = forAll genValues $ \left -> forAll genValues $ \right ->+ let first = sum (fmap toRational left)+ second = sum (fmap toRational right)+ expected+ | max first second > toRational maximumFinite = Left SumOutOfRange+ | otherwise = (,) (compare first second) <$> oracle (abs (first - second))+ observe = fmap (\(direction, value) -> (direction, castDoubleToWord64 value))+ in observe (netAccum (accumulate left) (accumulate right)) === observe expected++-- | Merging signed residual expansions preserves their exact non-negative values.+propResidualMerge :: Property+propResidualMerge = forAll genValue $ \a -> forAll genValue $ \b ->+ forAll genValue $ \c -> forAll genValue $ \d ->+ let result = do+ (_, first) <- netAccumState (accumulate [a]) (accumulate [b])+ (_, second) <- netAccumState (accumulate [c]) (accumulate [d])+ let left = mergeAccum first second+ right = mergeAccum second first+ pure (bits (roundAccum left), bits (roundAccum right))+ expected = bits (oracle (abs (toRational a - toRational b)+ + abs (toRational c - toRational d)))+ in result === Right (expected, expected)++-- | Bias toward high-exponent ties that create a negative low partial.+genBoundarySide :: Gen [Double]+genBoundarySide = frequency+ [ (1, pure [maximumFinite])+ , (3, do+ high <- chooseInteger (2 ^ (53 :: Int) - 16, 2 ^ (53 :: Int) + 16)+ low <- chooseInteger (1, 31)+ pure [encodeFloat high 970, encodeFloat low 970])+ ]++-- | Both subtraction directions must stay finite for valid near-boundary states.+propBoundaryNet :: Property+propBoundaryNet = forAll genBoundarySide $ \left -> forAll genBoundarySide $ \right ->+ let first = sum (fmap toRational left)+ second = sum (fmap toRational right)+ observe = fmap (\(direction, value) -> (direction, castDoubleToWord64 value))+ expected = (,) (compare first second) <$> oracle (abs (first - second))+ in observe (netAccum (accumulate left) (accumulate right)) === observe expected++-- | Subtraction also accepts previously netted states with signed low components.+propNestedNet :: Property+propNestedNet = forAll genValue $ \a -> forAll genValue $ \b ->+ forAll genValue $ \c -> forAll genValue $ \d ->+ let first = abs (toRational a - toRational b)+ second = abs (toRational c - toRational d)+ result = do+ (_, left) <- netAccumState (accumulate [a]) (accumulate [b])+ (_, right) <- netAccumState (accumulate [c]) (accumulate [d])+ netAccum left right+ expected = (,) (compare first second) <$> oracle (abs (first - second))+ observe = fmap (\(direction, value) -> (direction, castDoubleToWord64 value))+ in observe result === observe expected++-- | Generate small ledgers with exact, independently calculable group residuals.+genEntries :: Gen [(Double, TestBase)]+genEntries = do+ count <- chooseInt (0, 20)+ vectorOf count $ do+ value <- elements [subnormal, 1, 2, 3, threshold, threshold + 2]+ postingBase <- (:<) <$> elements [Not, Hat] <*> elements [Cash, Deposits, Sales]+ pure (value, postingBase)++-- | Construct only through the public checked posting constructor.+build :: [(Double, TestBase)] -> TestAlg+build = Algebra.fromList . fmap (uncurry (.@))++-- | Observe scalar bits without relying on HashMap traversal or Alg equality.+observeAlg :: TestAlg -> [(String, Word64)]+observeAlg = List.sort . Algebra.foldEntries+ (\entries value postingBase -> (show postingBase, castDoubleToWord64 value) : entries) []++-- | Independently sum signed Rational values per concrete account title.+exactGroups :: [(Double, TestBase)] -> Map.Map AccountTitles Rational+exactGroups = List.foldl' collect Map.empty+ where+ collect totals (value, postingBase) = Map.insertWith (+) (base postingBase)+ (signed postingBase (toRational value)) totals+ signed postingBase value+ | isHat postingBase = negate value+ | otherwise = value++-- | Regrouping a multiset preserves bar bits; residual merging rounds only once.+propReadouts :: Property+propReadouts = forAll genEntries $ \entries -> forAll (shuffle entries) $ \permuted ->+ let groups = exactGroups entries+ original = build entries+ reordered = mconcat (fmap (uncurry (.@)) permuted)+ gross = sum (fmap (toRational . fst) entries)+ residual = sum (fmap abs (Map.elems groups))+ expectedBalances = traverse (\value ->+ (,) (compare value 0) <$> oracle (abs value)) groups+ expectedPair = (,)+ <$> oracle (sum [value | value <- Map.elems groups, value > 0])+ <*> oracle (sum [abs value | value <- Map.elems groups, value < 0])+ pairs = netPairMapByExact (const (Just ())) original+ actualPair = fmap (Map.findWithDefault (0, 0) ()) pairs+ queries = [HatNot :< wildcard]+ in conjoin+ [ fmap observeAlg (barExact original) === fmap observeAlg (barExact reordered)+ , bits (normExact original) === bits (oracle gross)+ , bits (projNetNormExact queries original) === bits (oracle residual)+ , balanceMapByExact Just original === expectedBalances+ , actualPair === expectedPair+ ]++-- | Journal permutation and assembly preserve per-note projection residuals.+propJournal :: Property+propJournal = forAll genEntries $ \entries ->+ let annotated = zip (cycle ["a", "b", "c"]) entries+ make (note, (value, postingBase)) = value .@ postingBase Journal..| note+ original = mconcat (fmap make annotated) :: TestJournal+ query = [HatNot :< wildcard]+ noteGroups = List.foldl' collect Map.empty annotated+ collect totals (note, (value, postingBase)) =+ Map.insertWith (+) (note, base postingBase) (signed postingBase value) totals+ signed postingBase value+ | isHat postingBase = negate (toRational value)+ | otherwise = toRational value+ expected = bits (oracle (sum (fmap abs (Map.elems noteGroups))))+ in forAll (shuffle annotated) $ \permuted ->+ let reordered = Journal.fromList (fmap make permuted)+ in conjoin+ [ bits (JournalExact.projNetNormExact query original) === expected+ , bits (JournalExact.projNetNormExact query reordered) === expected+ , JournalExact.balanceMapByExact Just reordered+ === JournalExact.balanceMapByExact Just original+ , JournalExact.accountBalancesExact reordered+ === JournalExact.accountBalancesExact original+ ]++-- | Handwritten wrappers preserve the Double oracle; Decimal merge is exact.+propInstances :: Property+propInstances = forAll genValues $ \values -> forAll (shuffle values) $ \permuted ->+ let expected = bits (sumExact values)+ money = fmap MoneyDouble values+ nonNegative = fmap NN.fromNumber permuted :: [NN.Double]+ unwrapMoney (MoneyDouble value) = value+ decimalValues = fmap (MoneyDecimal . Decimal.Decimal 2 . toInteger) [1 .. length values]+ decimalState = accumulate decimalValues+ in conjoin+ [ bits (fmap unwrapMoney (sumExact money)) === expected+ , bits (fmap NN.toNumber (sumExact nonNegative)) === expected+ , roundAccum (mergeAccum decimalState emptyAccum) === Right (sum decimalValues)+ , sumExact (reverse decimalValues) === Right (sum decimalValues)+ ]++-- | Run a deterministic check and stop the suite on failure.+check :: (Eq a, Show a) => String -> a -> a -> IO ()+check name expected actual = unless (expected == actual) $ do+ putStrLn ("[FAIL] exact " ++ name ++ ": expected " ++ show expected ++ ", got " ++ show actual)+ exitFailure++-- | Run a reproducible-size property batch with failure details on demand.+propertyCheck :: String -> Property -> IO ()+propertyCheck name proposition = do+ result <- quickCheckWithResult stdArgs { maxSuccess = 1000, chatty = False } proposition+ unless (isSuccess result) $ do+ putStrLn ("[FAIL] exact " ++ name ++ ": " ++ output result)+ exitFailure+ putStrLn ("[PASS] exact " ++ name ++ " (1000 cases)")++-- | Floating boundaries and sticky validation errors, independent of algebra construction.+testAccumulator :: IO ()+testAccumulator = do+ check "2^53,1,1" (Right (threshold + 2)) (sumExact [threshold, 1, 1])+ check "subnormals" (Right (3 * subnormal)) (sumExact [subnormal, subnormal, subnormal])+ check "tie even down" (Right threshold) (sumExact [threshold, 1])+ check "tie even up" (Right (threshold + 4)) (sumExact [threshold + 2, 1])+ check "beyond tie" (Right (threshold + 2)) (sumExact [threshold, 1, subnormal])+ check "net below tie" (Right (GT, threshold))+ (netAccum (accumulate [threshold + 2]) (accumulate [1, subnormal]))+ check "zero sign" (Right 0) (bits (sumExact [-0, 0 :: Double]))+ check "net zero sign" (Right (EQ, 0))+ (fmap (\(direction, value) -> (direction, castDoubleToWord64 value))+ (netAccum (accumulate [-0 :: Double]) (accumulate [0])))+ check "M" (Right maximumFinite) (sumExact [maximumFinite])+ check "M boundary inside" (Right maximumFinite)+ (sumExact [encodeFloat (2 ^ (53 :: Int) - 2) 971, encodeFloat 1 971])+ check "M plus smallest" (Left SumOutOfRange) (sumExact [maximumFinite, subnormal])+ check "both sides overflow" (Left SumOutOfRange)+ (netAccum (accumulate [1e308, 1e308 :: Double]) (accumulate [1e308, 1e308]))+ let boundaryValues = [encodeFloat 1 1023, 3 * encodeFloat 1 970]+ boundaryState = accumulate boundaryValues+ expectedDifference = fromRational+ (toRational maximumFinite - sum (fmap toRational boundaryValues))+ boundaryLedger = build+ [(value, Not :< Cash) | value <- boundaryValues]+ <> build [(maximumFinite, Hat :< Cash)]+ check "negative low versus M" (Right (LT, expectedDifference))+ (netAccum boundaryState (accumulate [maximumFinite]))+ check "M versus negative low" (Right (GT, expectedDifference))+ (netAccum (accumulate [maximumFinite]) boundaryState)+ check "boundary projection finite" (Right expectedDifference)+ (projNetNormExact [HatNot :< Cash] boundaryLedger)+ check "boundary bar does not throw" (Right expectedDifference)+ (barExact boundaryLedger >>= normExact)+ check "negative" (Left NegativeInput) (sumExact [-1 :: Double])+ check "NaN" (Left NonFiniteInput) (sumExact [0 / 0 :: Double])+ check "positive infinity" (Left NonFiniteInput) (sumExact [1 / 0 :: Double])+ check "negative infinity" (Left NonFiniteInput) (sumExact [-1 / 0 :: Double])+ let failed = accumulate [-1 :: Double]+ check "sticky add" (Left NegativeInput) (roundAccum (addAccum 1 failed))+ check "sticky merge left" (Left NegativeInput) (roundAccum (mergeAccum failed emptyAccum))+ check "sticky merge right" (Left NegativeInput) (roundAccum (mergeAccum emptyAccum failed))+ check "sticky net" (Left NegativeInput) (netAccum failed failed)+ let nearMaximum = accumulate [maximumFinite]+ tiny = accumulate [subnormal]+ case netAccumState nearMaximum tiny of+ Left failure -> check "M-small state" (Right ()) (Left failure)+ Right (_, below) -> do+ check "M-small rounds M" (Right maximumFinite) (roundAccum below)+ check "M-small plus small" (Right maximumFinite) (roundAccum (mergeAccum below tiny))+ check "small plus M-small" (Right maximumFinite) (roundAccum (mergeAccum tiny below))+ check "nested residual" (Right (GT, subnormal)) (netAccum nearMaximum below)+ check "MoneyDouble" (Right (MoneyDouble (threshold + 2)))+ (sumExact [MoneyDouble threshold, 1, 1])+ check "MoneyDouble nonfinite" (Left NonFiniteInput) (sumExact [MoneyDouble (1 / 0)])+ check "MoneyDouble negative" (Left NegativeInput) (sumExact [MoneyDouble (-1)])+ check "NN.Double" (Right (NN.fromNumber (threshold + 2)))+ (sumExact [NN.fromNumber threshold, 1, 1] :: Either ExactSumError NN.Double)+ check "NN magnitude only" (Right (LT, 7 :: NN.Double))+ (netAccum (accumulate [3]) (accumulate [10]))+ check "MoneyDecimal negative" (Left NegativeInput) (sumExact [-1 :: MoneyDecimal])+ let decimal = MoneyDecimal (Decimal.Decimal 2 1)+ check "MoneyDecimal scale" (Right (MoneyDecimal (Decimal.Decimal 2 101)))+ (sumExact [1, decimal])+ check "MoneyDecimal unlimited" (Right (2 * 10 ^ (400 :: Int) :: MoneyDecimal))+ (sumExact [10 ^ (400 :: Int), 10 ^ (400 :: Int)])+ check "MoneyDecimal net" (Right (LT, decimal))+ (netAccum (accumulate [1]) (accumulate [1, decimal]))++-- | Fixed grouping, projection, and accounting cases from the accepted contract.+testReadouts :: IO ()+testReadouts = do+ let pairExample = build [(10, Not :< Cash), (7, Hat :< Deposits)]+ sameBase = build [(10, Not :< Cash), (7, Hat :< Cash)]+ selectHat postingBase+ | isHat postingBase = Just ()+ | otherwise = Nothing+ post _ value = value .@ (Not :< Sales)+ query = [HatNot :< wildcard]+ large = build [(1e308, Not :< Cash), (1e308, Not :< Deposits)]+ roundExample = build [(threshold, Not :< Cash), (1, Not :< Cash), (1, Not :< Deposits)]+ equal = build [(10, Not :< Cash), (10, Hat :< Cash)]+ check "pair retains base distinction" (Right (Map.singleton () (10, 7)))+ (netPairMapByExact (const (Just ())) pairExample)+ check "post selects after netting" (Right [])+ (fmap observeAlg (postFromNetByExact selectHat post sameBase))+ check "balance direction" (Right (Map.fromList [(Cash, (GT, 10)), (Deposits, (LT, 7))]))+ (balanceMapByExact Just pairExample)+ check "zero key retained" (Right (Map.singleton Cash (EQ, 0)))+ (balanceMapByExact Just equal)+ check "bar zero removed" (Right []) (fmap observeAlg (barExact equal))+ check "gross overflow" (Left SumOutOfRange) (normExact large)+ check "residual overflow" (Left SumOutOfRange) (projNetNormExact query large)+ check "pair overflow" (Left SumOutOfRange) (netPairMapByExact (const (Just ())) large)+ check "post overflow" (Left SumOutOfRange)+ (fmap observeAlg (postFromNetByExact (const (Just ())) post large))+ check "projection rounds once" (Right (threshold + 2)) (projNetNormExact query roundExample)+ check "pair rounds once per key side" (Right (Map.singleton () (threshold + 2, 0)))+ (netPairMapByExact (const (Just ())) roundExample)+ check "post rounds once per key" (Right (threshold + 2))+ (postFromNetByExact (const (Just ())) post roundExample >>= normExact)+ check "two rounds differ" (Right threshold) (barExact roundExample >>= normExact)+ check "duplicate base query" (projNetNormExact query roundExample)+ (projNetNormExact (query ++ query) roundExample)+ check "debit difference" (Right (Debit, 3)) (diffRLExact sameBase)+ check "exact balance" (Right True) (balanceExact equal)+ check "account balances" (Right (Map.singleton Cash (DebitBalance 3)))+ (accountBalancesExact sameBase)+ let journal = (10 .@ (Not :< Cash) Journal..| "a")+ <> (10 .@ (Hat :< Cash) Journal..| "b") :: TestJournal+ roundedJournal = (build [(threshold, Not :< Cash), (1, Not :< Cash)] Journal..| "a")+ <> (build [(1, Not :< Cash)] Journal..| "b")+ check "journal separate notes" (Right 20) (JournalExact.projWithBaseNetNormExact query journal)+ check "journal duplicate base queries" (Right 20)+ (JournalExact.projWithBaseNetNormExact (query ++ query) journal)+ check "journal note selection" (Right 10)+ (JournalExact.projWithNoteBaseNetNormExact ["a", "a"] query journal)+ check "journal empty notes" (Right 20)+ (JournalExact.projWithNoteBaseNetNormExact [] query journal)+ check "journal plank notes" (Right 20)+ (JournalExact.projWithNoteBaseNetNormExact ["a", ""] query journal)+ check "journal once across notes" (Right (threshold + 2))+ (JournalExact.projWithBaseNetNormExact query roundedJournal)+ check "journal bar gathers" (Right 0) (JournalExact.barExact journal >>= JournalExact.normExact)+ check "journal balance" (Right True) (JournalExact.balanceExact journal)+ check "journal diff" (Right (Side, 0)) (JournalExact.diffRLExact journal)+ check "journal account" (Right (Map.singleton Cash NoBalance))+ (JournalExact.accountBalancesExact journal)+ check "journal pair gathers" (Right Map.empty)+ (JournalExact.netPairMapByExact Just journal)+ check "journal signed gathers" (Right (Map.singleton Cash (EQ, 0)))+ (JournalExact.balanceMapByExact Just journal)+ check "journal post gathers" (Right 0)+ (JournalExact.postFromNetByExact selectHat+ (\key value -> post key value Journal..| "new") journal >>= JournalExact.normExact)+ check "journal post rounds once" (Right (threshold + 2))+ (JournalExact.postFromNetByExact (const (Just ()))+ (\key value -> post key value Journal..| "new") roundedJournal+ >>= JournalExact.normExact)+ check "journal alias" (Right 20) (JournalExact.projNetNormExact query journal)+ check "journal residual overflow" (Left SumOutOfRange)+ (JournalExact.projWithBaseNetNormExact query (large Journal..| "a"))++-- | Execute all exact-readout acceptance checks in the main test suite.+runTests :: IO ()+runTests = do+ testAccumulator+ testReadouts+ propertyCheck "sum, permutation, merge, and Rational oracle" propSum+ propertyCheck "net and Rational oracle" propNet+ propertyCheck "residual merge and Rational oracle" propResidualMerge+ propertyCheck "high-exponent tie netting" propBoundaryNet+ propertyCheck "nested netting and Rational oracle" propNestedNet+ propertyCheck "readouts, construction order, and Rational oracle" propReadouts+ propertyCheck "journal multiset and note-local Rational oracle" propJournal+ propertyCheck "handwritten instances" propInstances+ putStrLn "[PASS] exact boundary, grouping, journal, and instance acceptance cases"
test/Spec.hs view
@@ -75,6 +75,7 @@ import Golden.WriteRows import qualified Transfer.RuleSpec as TransferRuleSpec import qualified Algebra.ProjWildcardSpec as ProjWildcardSpec+import qualified Algebra.ExactSumSpec as ExactSumSpec import Numeric (showHex) import Control.Monad (forM_) import Control.Monad.ST@@ -6965,6 +6966,7 @@ main :: IO () main = do+ ExactSumSpec.runTests TransferRuleSpec.runTests ProjWildcardSpec.runTests testAccountTitlesBinary
+ test/Surface/Algebra/Exact.hs view
@@ -0,0 +1,36 @@+-- | Compile-time lock for the public names exported by+-- "ExchangeAlgebra.Algebra.Exact".+module Surface.Algebra.Exact (+ -- * Accumulators+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ -- * Algebra readouts+ , normExact+ , barExact+ , projNetNormExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ -- * Accounting readouts+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ ) where++import ExchangeAlgebra.Algebra.Exact (+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ , normExact+ , barExact+ , projNetNormExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ )
+ test/Surface/Journal/Exact.hs view
@@ -0,0 +1,41 @@+-- | Compile-time lock for the public names exported by+-- "ExchangeAlgebra.Journal.Exact".+module Surface.Journal.Exact (+ -- * Accumulators+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ -- * Journal readouts+ , normExact+ , barExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ -- * Projections+ , projNetNormExact+ , projWithBaseNetNormExact+ , projWithNoteBaseNetNormExact+ -- * Accounting readouts+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ ) where++import ExchangeAlgebra.Journal.Exact (+ ExactSum(..)+ , ExactSumError(..)+ , netAccum+ , sumExact+ , normExact+ , barExact+ , balanceMapByExact+ , netPairMapByExact+ , postFromNetByExact+ , projNetNormExact+ , projWithBaseNetNormExact+ , projWithNoteBaseNetNormExact+ , diffRLExact+ , balanceExact+ , accountBalancesExact+ )
test/SurfaceMain.hs view
@@ -1,8 +1,10 @@ module Main (main) where import Surface.Accounting ()+import Surface.Algebra.Exact () import Surface.Algebra.Readout.Net () import Surface.Foundation ()+import Surface.Journal.Exact () import Surface.Render.Bookkeeping () import Surface.Render.Csv () import Surface.Render.Simulation ()@@ -13,4 +15,3 @@ -- | Report successful compilation of every surface lock module. main :: IO () main = putStrLn "surface ok"-