diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/exchangealgebra.cabal b/exchangealgebra.cabal --- a/exchangealgebra.cabal +++ b/exchangealgebra.cabal @@ -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 category: Accounting, Finance, Math diff --git a/src/ExchangeAlgebra/Algebra/Base/Element.hs b/src/ExchangeAlgebra/Algebra/Base/Element.hs --- a/src/ExchangeAlgebra/Algebra/Base/Element.hs +++ b/src/ExchangeAlgebra/Algebra/Base/Element.hs @@ -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) diff --git a/src/ExchangeAlgebra/Algebra/Internal.hs b/src/ExchangeAlgebra/Algebra/Internal.hs --- a/src/ExchangeAlgebra/Algebra/Internal.hs +++ b/src/ExchangeAlgebra/Algebra/Internal.hs @@ -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)) diff --git a/test/Algebra/ProjWildcardSpec.hs b/test/Algebra/ProjWildcardSpec.hs --- a/test/Algebra/ProjWildcardSpec.hs +++ b/test/Algebra/ProjWildcardSpec.hs @@ -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"