diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,40 @@ # Changelog for ExchangeAlgebra +## 0.4.1.0 - 2026-06-06 + +### Added +- `nearlyEqScaled` — scale-aware approximate equality + (`|x - y| <= atol + rtol * max |x| |y|`, with `atol = 1e-13`, `rtol = 1e-12`). + +### Fixed +- `bases` ignored the `_notSide` Seq and iterated `_hatSide` twice + (`src/ExchangeAlgebra/Algebra.hs`, regression existed since the introduction of the + HashMap-backed `Liner` representation). The previous implementation produced + `length (bases x) != length (vals x)` whenever the Hat-side and Not-side Seqs of any + base had different lengths, dropped entries whose Hat-side Seq was empty, and + duplicated Hat-side entries with the wrong label. A 1-character fix + (`hs` → `ns` in the outer fold) restores the intended behaviour, covered by a + new `testBasesNotSideRegression` unit test. + +### Changed +- Reconciliation comparators (`bar` / `(.-)`, `balance`, `diffRL`, `barNormPair`) now use a + scale-aware tolerance instead of a fixed `1e-13` absolute tolerance. **Behaviour change:** + near-balanced values at large magnitudes no longer retain floating-point rounding noise as a + spurious residual, and `balance` / `diffRL` no longer use exact `==` / `>` comparisons. +- `isNearlyNum` returns `False` (instead of raising `error`) when a NaN makes every ordered + comparison fail, so non-finite inputs can no longer crash the check. + +### Internal +- `Journal.toAlg` avoids materializing an intermediate `Map.elems base` list. +- Removed an unused `Control.Parallel.Strategies` import from `ExchangeAlgebra.Algebra`. + +### Documentation +- Documented the spill-to-disk path (`runSimulationWithSpill` / `runScenariosWithSpill` with + `SpillDeletePolicy`) as the recommended approach for constant-memory large-scale simulations, + in the README and the `ExchangeAlgebra.Simulate` module header (example: `sim2`). +- Added the original axiomatic source (Deguchi & Nakano, *Axiomatic Foundations of Vector + Accounting*, Systems Research 3(1):31–39, 1986) to the README References section. + ## 0.4.0.0 - 2026-05-18 First release prepared for Hackage publication. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -83,9 +83,9 @@ # then edit freely as a starting point ``` -A Git sparse-checkout with a standalone `examples/stack.yaml` is planned so that -`cd examples && stack build` works after a sparse-clone; this will land together -with the first Hackage release. +A standalone `examples/stack.yaml` (pinned to the Hackage release) is checked in, +so `cd examples && stack build` works after a sparse-clone or `degit` without +needing the rest of the repository. ## Module Overview @@ -154,6 +154,37 @@ type or `EA.proj`, for example). **Using Journal as the unqualified umbrella and pulling the Algebra layer in as `EA` qualified is the idiomatic style for this library.** +## Large-scale simulations (constant memory) + +`runSimulation` keeps the entire world state in memory for the whole run, so peak memory +grows with the number of terms. For long horizons or large agent populations, use the +**spill-to-disk** variants instead — they periodically write ledger chunks to disk and evict +old terms, so peak memory becomes **independent of the number of terms**: + +```haskell +import qualified ExchangeAlgebra.Simulate as ES + +opts :: ES.SpillOptions Term World Transaction +opts = (ES.mkBinarySpillOptions everyNTerms spillPath extractPayload) + -- keep only the most recent N terms resident; older terms live on disk + { ES.spillDeletePolicy = ES.KeepRecentTerms 2 } + +main = do + _world <- ES.runSimulationWithSpill opts gen env + -- restore spilled chunks later with ES.readBinarySpillFile / restoreJournalFromBinarySpill + pure () +``` + +- `ES.runSimulationWithSpill` / `ES.runScenariosWithSpill` are drop-in replacements for + `runSimulation` / `runScenarios` that add periodic spilling. +- `ES.SpillDeletePolicy` bounds resident memory: `KeepRecentTerms n` keeps a sliding window, + `DeleteSpilledChunk` evicts each chunk right after it is written, `NoDelete` keeps everything. +- Restore spilled data with `ES.readBinarySpillFile` (binary format) or the + `restoreJournalFromBinarySpill` helper. + +A runnable end-to-end example (multi-scenario run with binary spill, `KeepRecentTerms`, and +restore) is `examples/basic/simulateEx2.hs` (the `sim2` executable). + ## A note on visualization `ExchangeAlgebra.Simulate.Visualize` provides Chart-based PNG rendering, but **we recommend @@ -217,6 +248,7 @@ stack build stack exec -- ebex1 # Introductory bookkeeping example stack exec -- sim1 # 100-term simulation (+ Python visualization) +stack exec -- sim2 # spill-to-disk simulation (constant memory, binary spill + restore) stack exec -- ripple # 10-agent ripple-effect simulation stack exec -- cge # CGE model ``` @@ -247,6 +279,18 @@ plain-text forms via GitHub's "Cite this repository" button. ## References + +- Hiroshi Deguchi and Bunpei Nakano. + *Axiomatic Foundations of Vector Accounting.* + Systems Research, Vol. 3, No. 1, pp. 31–39, 1986. + Pergamon Press. + DOI: [10.1002/sres.3850030105](https://doi.org/10.1002/sres.3850030105) + + The axiomatic origin of Exchange Algebra. This paper formalises double-entry + bookkeeping as an accounting vector space over the extended basis + `Γ = Λ ∪ Λ̂` (account titles and their dual hats), introduces the five + transaction axioms, and derives the debit/credit partition and the balance + principle (`|y_L| = |y_R|`) purely algebraically. - Hiroshi Deguchi. *Economics as an Agent-Based Complex System: Toward Agent-Based Social Systems Sciences.* Springer, 2004. diff --git a/exchangealgebra.cabal b/exchangealgebra.cabal --- a/exchangealgebra.cabal +++ b/exchangealgebra.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: b82362d388c7bd4bf8ed038200e10484428d995a6bab1ebd91c900e9f8c1acbe +-- hash: 7d4bb7802873f6ce2b4888ce4717621e5ccc4400b73ebc12b9d4ea69f0e994b5 name: exchangealgebra -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Exchange Algebra for bookkeeping and economic simulation description: Please see the README on GitHub at category: Accounting, Finance, Math diff --git a/src/ExchangeAlgebra/Algebra.hs b/src/ExchangeAlgebra/Algebra.hs --- a/src/ExchangeAlgebra/Algebra.hs +++ b/src/ExchangeAlgebra/Algebra.hs @@ -42,6 +42,7 @@ ( module ExchangeAlgebra.Algebra.Base , Nearly(..) , isNearlyNum + , nearlyEqScaled , Redundant(..) , Exchange(..) , HatVal(..) @@ -99,7 +100,6 @@ import Algebra.Additive (C) import qualified Data.Scientific as D (Scientific, fromFloatDigits, formatScientific, FPFormat(..)) import Control.DeepSeq -import Control.Parallel.Strategies (rpar, rseq, runEval, using, Strategy, rdeepseq) import GHC.Stack (HasCallStack, callStack, prettyCallStack) import Data.Hashable import qualified Data.Binary as Binary @@ -138,13 +138,40 @@ {-# INLINE isNearlyNum #-} -- | Complexity: O(1) -- Assumes primitive numeric operations and comparisons are constant time. +-- +-- NOTE: this is an /absolute/-tolerance test (@|x - y| <= |t|@); it does not +-- scale with magnitude. For large values, rounding error easily exceeds a small +-- fixed @t@, while for small values it can swallow a real residual. Internal +-- accounting reconciliation uses 'nearlyEqScaled' instead. The final guard +-- returns 'False' (was: 'error') when a NaN makes every ordered comparison fail, +-- so a non-finite input can no longer crash the check. isNearlyNum :: (Show a, Num a, Ord a) => a -> a -> a -> Bool isNearlyNum x y t | x == y = True | x > y = abs (x - y) <= abs t | x < y = abs (y - x) <= abs t - | otherwise = error $ "on isNearlyNum: " ++ show x ++ ", " ++ show y + | otherwise = False -- NaN: not nearly-equal to anything +{-# INLINE nearlyEqScaled #-} +-- | Scale-aware approximate equality for accounting reconciliation: +-- +-- @|x - y| <= atol + rtol * max |x| |y|@, with @atol = 1e-13@, @rtol = 1e-12@. +-- +-- The absolute floor @atol@ handles values near zero; the relative term @rtol@ +-- lets the threshold track magnitude, so the test stays meaningful for large +-- balances (where a fixed @1e-13@ was far too strict and retained pure rounding +-- noise as a spurious residual). Returns 'False' if either argument is a +-- non-finite error value (NaN/Inf), so error values never read as nearly equal. +-- +-- Complexity: O(1) +nearlyEqScaled :: (HatVal n) => n -> n -> Bool +nearlyEqScaled x y + | isErrorValue x || isErrorValue y = False + | otherwise = abs (x - y) <= atol + rtol * max (abs x) (abs y) + where + atol = 1e-13 + rtol = 1e-12 + ------------------------------------------------------------ -- * Algebra ------------------------------------------------------------ @@ -752,7 +779,7 @@ f p@(Pair hs ns) = let !h = Foldable.foldl' (+) 0 hs !n = Foldable.foldl' (+) 0 ns - in case isNearlyNum h n 1e-13 of -- precision 13 digits + in case nearlyEqScaled h n of -- scale-aware tolerance (WI-11) True -> Nothing False -> case (Seq.length hs, Seq.length ns) of -- Already in canonical form: singleton on winning side, empty on other @@ -795,14 +822,13 @@ -- | filter Minus Stock decM xs = filter (\x -> x /= Zero && (not. isHat. _hatBase) x) xs - -- | check Credit Debit balance - balance xs | (norm . decR) xs == (norm . decL) xs = True - | otherwise = False + -- | check Credit Debit balance (scale-aware tolerance, WI-12) + balance xs = nearlyEqScaled ((norm . decR) xs) ((norm . decL) xs) - -- | - diffRL xs | r > l = (Credit, r - l) - | l > r = (Debit, l -r) - | otherwise = (Side,0) + -- | (scale-aware tolerance, WI-12); near-equal sides report (Side, 0) + diffRL xs | nearlyEqScaled r l = (Side, 0) + | r > l = (Credit, r - l) + | otherwise = (Debit, l - r) where r = (norm . decR) xs l = (norm . decL) xs @@ -839,7 +865,7 @@ where f :: (HatVal v, HatBaseClass b) => [b] -> BasePart b -> Pair v -> [b] f xs b (Pair {_hatSide = hs, _notSide = ns}) - = Foldable.foldl' (g Not b) (Foldable.foldl' (g Hat b) xs hs) hs + = Foldable.foldl' (g Not b) (Foldable.foldl' (g Hat b) xs hs) ns g :: (HatVal v, HatBaseClass b) => Hat -> BasePart b -> [b] -> v -> [b] g h b ys v = (merge h b):ys @@ -1287,7 +1313,7 @@ barNormPair (Pair hs ns) = let !h = Foldable.foldl' (+) 0 hs !n = Foldable.foldl' (+) 0 ns - in if isNearlyNum h n 1e-13 + in if nearlyEqScaled h n then 0 else if h > n then h - n else n - h diff --git a/src/ExchangeAlgebra/Journal.hs b/src/ExchangeAlgebra/Journal.hs --- a/src/ExchangeAlgebra/Journal.hs +++ b/src/ExchangeAlgebra/Journal.hs @@ -415,14 +415,13 @@ decP xs = map (EA.filter (\x -> x /= EA.Zero && (isHat . EA._hatBase) x)) xs decM xs = map (EA.filter (\x -> x /= EA.Zero && (not . isHat . EA._hatBase) x)) xs - balance xs - | (norm . decR) xs == (norm . decL) xs = True - | otherwise = False + -- scale-aware tolerance (WI-12), consistent with Alg's Exchange instance + balance xs = EA.nearlyEqScaled ((norm . decR) xs) ((norm . decL) xs) diffRL xs - | r > l = (Credit, r - l) - | l > r = (Debit, l - r) - | otherwise = (Side, 0) + | EA.nearlyEqScaled r l = (Side, 0) + | r > l = (Credit, r - l) + | otherwise = (Debit, l - r) where r = (norm . decR) xs l = (norm . decL) xs @@ -434,6 +433,14 @@ -- >>> x = [(1.00:@Hat:>> fromList x -- 1.00:@Hat: [Journal n v b] -> Journal n v b fromList = foldr (.+) mempty @@ -527,6 +534,13 @@ -- | Summation in a monadic context. Applies a monadic function to each element and mconcats the results. -- -- Complexity: O(|xs| * cost(f)) +-- +-- NOTE: kept as @mconcat <$> forM xs f@ deliberately. A strict @foldM@ left fold +-- was tried (plan WI-3) but it changes the '<>' association order, which for +-- 'Alg'/'Journal' reorders the audit-trail sequence and (via non-associative +-- 'Double' addition) shifts 'norm' results. Although the 'Monoid' laws make the +-- value equal in exact arithmetic, it is observably different under floating point. +-- See plans/in-progress/LAZY_EVAL_AUDIT.md (WI-3). sigmaM :: (Monoid m, Monad m0) => [a] -> (a -> m0 m) -> m0 m sigmaM xs f = mconcat <$> CM.forM xs f @@ -537,7 +551,10 @@ toAlg :: (HatVal v, HatBaseClass b, Note n) => Journal n v b -> Alg v b toAlg (Journal base delta _ _ _) = - EA.unionsMerge (Map.elems base ++ Map.elems delta) + -- Fold base's elements directly onto delta's element list instead of + -- @Map.elems base ++ Map.elems delta@, which avoids materializing the + -- separate @Map.elems base@ list and the @(++)@ traversal. + EA.unionsMerge (Map.foldr (:) (Map.elems delta) base) ------------------------------------------------------------------ -- | Apply function f to the entry of each Note in the Journal. diff --git a/src/ExchangeAlgebra/Simulate.hs b/src/ExchangeAlgebra/Simulate.hs --- a/src/ExchangeAlgebra/Simulate.hs +++ b/src/ExchangeAlgebra/Simulate.hs @@ -19,6 +19,17 @@ + == Large-scale runs (constant memory) + + 'runSimulation' keeps the whole world state resident for the entire run, so + peak memory grows with the number of terms. For long horizons or large agent + populations, prefer the spill-to-disk variants 'runSimulationWithSpill' / + 'runScenariosWithSpill': they periodically write ledger chunks to disk and, + with a 'SpillDeletePolicy' (@'KeepRecentTerms' n@ for a sliding window, or + 'DeleteSpilledChunk'), evict old terms so peak memory is independent of the + term count. Spilled data is restored with 'readBinarySpillFile'. A runnable + example is @examples\/basic\/simulateEx2.hs@ (the @sim2@ executable). + == Application note The design of this module — the accounting state space as the minimal diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -117,6 +117,33 @@ assertNear "Journal.projWithNoteNorm (selected notes)" expected1 actual1 assertNear "Journal.projWithNoteNorm (plank wildcard)" expected2 actual2 +-- | Regression test for the `bases` typo bug. +-- +-- Before the fix at Algebra.hs:868, `bases` ignored the `_notSide` Seq and +-- iterated `_hatSide` twice (with `Hat` and `Not` labels). As a result, +-- `length (bases x) != length (vals x)` whenever Hat/Not Seq lengths differed. +-- +-- This test constructs an Alg where the Hat Seq for `Yen` has length 1 and +-- the Not Seq has length 2, plus a separate basis whose Hat Seq is empty. +-- That makes the divergence detectable in both directions. +testBasesNotSideRegression :: IO () +testBasesNotSideRegression = do + let alg :: TestAlg + alg = (100 :@ (Hat :< Yen)) -- Yen: hatSide = [100] + .+ (50 :@ (Not :< Yen)) -- Yen: notSide = [50] + .+ (30 :@ (Not :< Yen)) -- Yen: notSide = [50, 30] + .+ (20 :@ (Not :< Amount)) -- Amount: notSide = [20], hatSide = [] + vs = EA.vals alg + bs = EA.bases alg + hatCount = length (L.filter isHat bs) + notCount = length (L.filter (not . isHat) bs) + -- vals and bases must agree on total count (one label per scalar entry) + assertEqual "bases/vals same length (regression for hs/ns typo)" + (length vs) (length bs) + -- Expected: 1 Hat label (Hat: IO String readFileStrict p = do @@ -721,6 +769,8 @@ testProjNormFastPath testProjWithBaseNorm testProjWithNoteNorm + testBasesNotSideRegression + testNumericToleranceScaleAware testSigmaMergePath testSigma2When testSigmaFromMap