psqueues 0.2.8.0 → 0.2.8.1
raw patch · 3 files changed
+29/−9 lines, 3 files
Files
- CHANGELOG +6/−0
- psqueues.cabal +4/−4
- src/Data/OrdPSQ/Internal.hs +19/−5
CHANGELOG view
@@ -1,5 +1,11 @@ # CHANGELOG +- 0.2.8.1 (2025-01-28)+ * Fix performance issue in OrdPSQ relating to balancing (#61).+ * Relax hashable upper bound to 1.5+ * Relax QuickCheck upper bound to 2.15+ * Relax tasty-quickcheck upper bound to 0.11+ - 0.2.8.0 (2022-10-27) * Add a number of minor optimizations and INLINE pragmas: - The previous `INLINABLE` pragmas were insufficient to fully specialize
psqueues.cabal view
@@ -1,5 +1,5 @@ Name: psqueues-Version: 0.2.8.0+Version: 0.2.8.1 License: BSD3 License-file: LICENSE Maintainer: Jasper Van der Jeugt <jaspervdj@gmail.com>@@ -68,7 +68,7 @@ Build-depends: base >= 4.2 && < 5 , deepseq >= 1.2 && < 1.6- , hashable >= 1.1.2.3 && < 1.5+ , hashable >= 1.1.2.3 && < 1.6 if impl(ghc>=6.10) Build-depends: ghc-prim@@ -144,10 +144,10 @@ Build-depends: HUnit >= 1.2 && < 1.7- , QuickCheck >= 2.7 && < 2.15+ , QuickCheck >= 2.7 && < 2.16 , tasty >= 1.2 && < 1.6 , tasty-hunit >= 0.9 && < 0.11- , tasty-quickcheck >= 0.8 && < 0.11+ , tasty-quickcheck >= 0.8 && < 0.12 , base , array
src/Data/OrdPSQ/Internal.hs view
@@ -515,16 +515,14 @@ lbalance, rbalance :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v-lbalance k p v Start m r = lloser k p v Start m r-lbalance k p v l m Start = lloser k p v l m Start lbalance k p v l m r+ | size' r + size' l < 2 = lloser k p v l m r | size' r > omega * size' l = lbalanceLeft k p v l m r | size' l > omega * size' r = lbalanceRight k p v l m r | otherwise = lloser k p v l m r -rbalance k p v Start m r = rloser k p v Start m r-rbalance k p v l m Start = rloser k p v l m Start rbalance k p v l m r+ | size' r + size' l < 2 = rloser k p v l m r | size' r > omega * size' l = rbalanceLeft k p v l m r | size' l > omega * size' r = rbalanceRight k p v l m r | otherwise = rloser k p v l m r@@ -653,7 +651,8 @@ not (hasDuplicateKeys t) && hasMinHeapProperty t && hasBinarySearchTreeProperty t &&- hasCorrectSizeAnnotations t+ hasCorrectSizeAnnotations t &&+ hasBalancedTreeProperty t hasDuplicateKeys :: Ord k => OrdPSQ k p v -> Bool hasDuplicateKeys = any (> 1) . List.map length . List.group . List.sort . keys@@ -696,6 +695,21 @@ calculateSize (LLoser _ _ l _ r) = 1 + calculateSize l + calculateSize r calculateSize (RLoser _ _ l _ r) = 1 + calculateSize l + calculateSize r +hasBalancedTreeProperty :: OrdPSQ k p v -> Bool+hasBalancedTreeProperty Void = True+hasBalancedTreeProperty (Winner _ t _) = go t+ where+ go Start = True+ go (LLoser _ _ l _ r) = withinOmegaFactor l r && go l && go r+ go (RLoser _ _ l _ r) = withinOmegaFactor l r && go l && go r++ withinOmegaFactor t1 t2 = u < (l + 1) * omega+ where+ (l, u)+ | s1 < s2 = (s1, s2)+ | otherwise = (s2, s1)+ s1 = size' t1+ s2 = size' t2 -------------------------------------------------------------------------------- -- Utility functions