exchangealgebra 0.5.3.1 → 0.5.3.2
raw patch · 5 files changed
+106/−29 lines, 5 files
Files
- ChangeLog.md +9/−0
- exchangealgebra.cabal +1/−1
- src/ExchangeAlgebra/Algebra/Base/Element.hs +27/−27
- src/ExchangeAlgebra/Algebra/Internal.hs +6/−1
- test/Algebra/ProjWildcardSpec.hs +63/−0
ChangeLog.md view
@@ -1,5 +1,14 @@ # Changelog for ExchangeAlgebra +## 0.5.3.2 - 2026-10-30++### Fixed++- Queries with wildcards inside nested tuples now select matching ledger entries+ in `proj`, `projNetNorm`, `collapseEntries`, and `collapseNetEntries`. Tuple+ wildcard detection and symmetric matching with `.==` also inspect nested+ components. This bug affected versions since 0.4.0.0.+ ## 0.5.3.1 - 2026-10-21 ### Fixed
exchangealgebra.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: exchangealgebra-version: 0.5.3.1+version: 0.5.3.2 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
src/ExchangeAlgebra/Algebra/Base/Element.hs view
@@ -592,8 +592,8 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b)- = isWildcard a- || isWildcard b+ = haveWildcard a+ || haveWildcard b {-# INLINE equal #-} equal (a1, a2) (b1, b2)@@ -626,9 +626,9 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b,c)- = isWildcard a- || isWildcard b- || isWildcard c+ = haveWildcard a+ || haveWildcard b+ || haveWildcard c {-# INLINE equal #-}@@ -666,10 +666,10 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b,c,d)- = isWildcard a- || isWildcard b- || isWildcard c- || isWildcard d+ = haveWildcard a+ || haveWildcard b+ || haveWildcard c+ || haveWildcard d {-# INLINE equal #-} equal (a1, a2, a3, a4) (b1, b2, b3, b4)@@ -709,11 +709,11 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b,c,d,e)- = isWildcard a- || isWildcard b- || isWildcard c- || isWildcard d- || isWildcard e+ = haveWildcard a+ || haveWildcard b+ || haveWildcard c+ || haveWildcard d+ || haveWildcard e {-# INLINE equal #-} equal (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)@@ -755,12 +755,12 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b,c,d,e,f)- = isWildcard a- || isWildcard b- || isWildcard c- || isWildcard d- || isWildcard e- || isWildcard f+ = haveWildcard a+ || haveWildcard b+ || haveWildcard c+ || haveWildcard d+ || haveWildcard e+ || haveWildcard f {-# INLINE equal #-} equal (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6)@@ -804,13 +804,13 @@ {-# INLINE haveWildcard #-} haveWildcard (a,b,c,d,e,f,g)- = isWildcard a- || isWildcard b- || isWildcard c- || isWildcard d- || isWildcard e- || isWildcard f- || isWildcard g+ = haveWildcard a+ || haveWildcard b+ || haveWildcard c+ || haveWildcard d+ || haveWildcard e+ || haveWildcard f+ || haveWildcard g {-# INLINE equal #-} equal (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7)
src/ExchangeAlgebra/Algebra/Internal.hs view
@@ -636,13 +636,18 @@ collect (Left ()) _ = Left () collect (Right acc) (!axis, !k)- | axisIsWildcard k = Right acc+ | axisHasWildcard k = Right acc | otherwise = case IntMap.lookup axis idx of Nothing -> Left () Just axisMap -> case Map.lookup k axisMap of Nothing -> Left () Just ids -> Right (ids : acc)++ -- A component with a wildcard inside it (e.g. @("a", wildcard)@) must+ -- not be looked up as an exact key; the final 'matchesQuery' check selects.+ axisHasWildcard (AxisKey coordinate) = haveWildcard coordinate+ {-# INLINE axisHasWildcard #-} {-# INLINE linerFromMap #-} -- | Complexity: O(n * d * (hash-insert + intset-insert))
test/Algebra/ProjWildcardSpec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} -- | The @proj@ family matches wildcards one way: only the query's wildcards -- act as a pattern, and a wildcard stored in a ledger base is an ordinary@@ -9,10 +10,12 @@ import Control.Monad (unless) import qualified Data.List as List import qualified Data.Map.Strict as Map+import Data.Text (Text) import System.Exit (exitFailure) import Test.QuickCheck hiding (label) import ExchangeAlgebra.Algebra hiding (map, filter) import qualified ExchangeAlgebra.Algebra as Algebra+import ExchangeAlgebra.Algebra.Transfer.Rule (collapseEntries) -- | Account and unit coordinates; either axis may hold a ledger wildcard. type TestBase = HatBase (AccountTitles, CountUnit)@@ -186,11 +189,71 @@ (observe (Algebra.map (setCashUnit wildcard) (cashYen .+ products)) == observe (cash .+ products)) +-- | Flattening Text coordinates preserves projection norms, net norms,+-- collapse postings, and symmetric matching. Small non-negative whole values+-- make the Double observations exact; either inner query axis may be a wildcard.+propNestedFlattening :: (Text, Text, Text) -> (Double, Double, Double) -> Bool+propNestedFlattening (queryFirst, querySecond, queryThird) (notValue, hatValue, otherValue) =+ norm (proj [nestedQuery] nestedLedger) == norm (proj [flatQuery] flatLedger)+ && projNetNorm [nestedQuery] nestedLedger == projNetNorm [flatQuery] flatLedger+ && List.sort nestedCollapsed == List.sort flatCollapsed+ && (nestedStored .== nestedCoordinates) == (flatStored .== flatCoordinates)+ && ((Not :< nestedStored) .== (Not :< nestedCoordinates))+ == ((Not :< flatStored) .== (Not :< flatCoordinates))+ where+ nestedStored = (("a", "b"), "c") :: ((Text, Text), Text)+ flatStored = ("a", "b", "c") :: (Text, Text, Text)+ nestedCoordinates = ((queryFirst, querySecond), queryThird)+ flatCoordinates = (queryFirst, querySecond, queryThird)+ nestedQuery = HatNot :< nestedCoordinates+ flatQuery = HatNot :< flatCoordinates+ nestedLedger :: Alg Double (HatBase ((Text, Text), Text))+ nestedLedger = notValue .@ Not :< nestedStored+ .+ hatValue .@ Hat :< nestedStored+ .+ otherValue .@ Not :< (("x", "y"), "z")+ flatLedger :: Alg Double (HatBase (Text, Text, Text))+ flatLedger = notValue .@ Not :< flatStored+ .+ hatValue .@ Hat :< flatStored+ .+ otherValue .@ Not :< ("x", "y", "z")+ nestedCollapsed :: [(Double, Hat, (Text, Text, Text))]+ nestedCollapsed = foldEntries+ (\result value (side :< ((first, second), third)) ->+ (value, side, (first, second, third)) : result) []+ (collapseEntries [nestedQuery] (const (("a", "b"), "d")) nestedLedger)+ flatCollapsed :: [(Double, Hat, (Text, Text, Text))]+ flatCollapsed = foldEntries+ (\result value (side :< coordinates) -> (value, side, coordinates) : result) []+ (collapseEntries [flatQuery] (const ("a", "b", "d")) flatLedger)++-- | The reported inner-only wildcard selects gross 13 and net 7, and+-- collapseEntries adds reversal and replacement postings with total norm 26.+testNestedWildcard :: IO ()+testNestedWildcard = do+ let ledger = 10 .@ Not :< (("a", "b"), "c")+ .+ 3 .@ Hat :< (("a", "b"), "c")+ .+ 2 .@ Not :< (("x", "y"), "z")+ :: Alg Double (HatBase ((Text, Text), Text))+ query = HatNot :< (("a", ""), "c")+ assertTest "nested wildcard: reported projection and collapse values"+ (norm (proj [query] ledger) == 13+ && projNetNorm [query] ledger == 7+ && norm (collapseEntries [query] (const (("a", "b"), "d")) ledger) == 26)+ assertTest "nested wildcard: reported case agrees with flat coordinates"+ (propNestedFlattening ("a", "", "c") (10, 3, 2))+ runTests :: IO () runTests = do testReportedTable testProjByAccountTitle testMapRewritesWildcardAxis+ testNestedWildcard+ quickProperty "nested wildcard: flattening preserves projection, collapse, and matching"+ (forAll ((,,) <$> elements ["a", ""] <*> elements ["b", ""]+ <*> elements ["c", ""]) $ \coordinates ->+ forAll ((,,) <$> (fromIntegral <$> chooseInt (0, 1000))+ <*> (fromIntegral <$> chooseInt (0, 1000))+ <*> (fromIntegral <$> chooseInt (0, 1000)))+ (propNestedFlattening coordinates)) quickProperty "proj: Liner result equals the one-way reference (ledger wildcards)" (forAll genProjCase propLedger) quickProperty "proj: single-element result equals the one-way reference"