psqueues 0.2.8.1 → 0.2.8.2
raw patch · 4 files changed
+76/−26 lines, 4 filesdep −arraydep −containersdep −ghc-primPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: array, containers, ghc-prim, mtl, unordered-containers
API changes (from Hackage documentation)
- Data.HashPSQ: deleteView :: forall k p v. (Hashable k, Ord k, Ord p) => k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
+ Data.HashPSQ: deleteView :: (Hashable k, Ord k, Ord p) => k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
- Data.OrdPSQ: map :: forall k p v w. (k -> p -> v -> w) -> OrdPSQ k p v -> OrdPSQ k p w
+ Data.OrdPSQ: map :: (k -> p -> v -> w) -> OrdPSQ k p v -> OrdPSQ k p w
Files
- CHANGELOG +13/−0
- psqueues.cabal +3/−12
- src/Data/BitUtil.hs +1/−2
- src/Data/OrdPSQ/Internal.hs +59/−12
CHANGELOG view
@@ -1,5 +1,18 @@ # CHANGELOG +- 0.2.8.2 (2025-08-08)+ * Use Straka's balancing algorithm for OrdPSQ (#64):++ Milan Straka's paper 'Adams’ Trees Revisited' argues that Adams'+ balancing algorithm previously did not have a correct proof. It+ provides a proof of a slightly modified balancing algorithm that+ prefers single rotations in many more cases. The small change+ specified in that paper fixes the frequent quickcheck failures+ exposed when the balance test was made more precise.++ * Remove unnecessary dependencies: array, containers, ghc-prim, mtl,+ unordered-containers+ - 0.2.8.1 (2025-01-28) * Fix performance issue in OrdPSQ relating to balancing (#61). * Relax hashable upper bound to 1.5
psqueues.cabal view
@@ -1,5 +1,5 @@ Name: psqueues-Version: 0.2.8.1+Version: 0.2.8.2 License: BSD3 License-file: LICENSE Maintainer: Jasper Van der Jeugt <jaspervdj@gmail.com>@@ -8,7 +8,7 @@ Category: Data Structures Build-type: Simple Cabal-version: >=1.10-Tested-with: GHC==9.6.1, GHC==9.4.2, GHC==9.2.2, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+Tested-with: GHC==9.6.4, GHC==9.4.2, GHC==9.2.2, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 Description: The psqueues package provides@@ -70,9 +70,6 @@ , deepseq >= 1.2 && < 1.6 , hashable >= 1.1.2.3 && < 1.6 - if impl(ghc>=6.10)- Build-depends: ghc-prim- Exposed-modules: Data.HashPSQ Data.IntPSQ@@ -105,16 +102,12 @@ Data.PSQueue.Benchmark Build-depends:- containers >= 0.5- , unordered-containers >= 0.2.4- , criterion >= 0.8- , mtl >= 2.1+ criterion >= 0.8 , PSQueue >= 1.1 , random >= 1.0 , base , deepseq- , ghc-prim , hashable , psqueues @@ -150,9 +143,7 @@ , tasty-quickcheck >= 0.8 && < 0.12 , base- , array , deepseq- , ghc-prim , hashable , psqueues , tagged
src/Data/BitUtil.hs view
@@ -28,8 +28,7 @@ import Data.Bits ((.|.), xor) #if __GLASGOW_HASKELL__-import GHC.Exts (Word(..), Int(..))-import GHC.Prim (uncheckedShiftRL#)+import GHC.Exts (Word(..), Int(..), uncheckedShiftRL#) #else import Data.Word (shiftL, shiftR) #endif
src/Data/OrdPSQ/Internal.hs view
@@ -73,7 +73,7 @@ import Control.DeepSeq (NFData (rnf)) import Data.Foldable (Foldable (foldl')) import qualified Data.List as List-import Data.Maybe (isJust)+import Data.Maybe (isJust, fromMaybe) import Data.Traversable #if MIN_VERSION_base(4,11,0) import Prelude hiding (foldr, lookup, map, null, (<>))@@ -483,10 +483,14 @@ -- Balancing internals -------------------------------------------------------------------------------- --- | Balance factor+-- Balance factors, see Milan Straka - Adams' Trees Revisited+-- currently available at https://ufal.mff.cuni.cz/~straka/papers/2011-bbtree.pdf omega :: Int omega = 4 -- Has to be greater than 3.75 because Hinze's paper said so. +alpha :: Int+alpha = 2 -- Has to be 2 when omega is 4, by Straka's paper.+ size' :: LTree k p v -> Size size' Start = 0 size' (LLoser s _ _ _ _) = s@@ -532,32 +536,32 @@ :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v lbalanceLeft k p v l m r- | size' (left r) < size' (right r) = lsingleLeft k p v l m r- | otherwise = ldoubleLeft k p v l m r+ | size' (left r) < alpha * size' (right r) = lsingleLeft k p v l m r+ | otherwise = ldoubleLeft k p v l m r {-# INLINABLE lbalanceRight #-} lbalanceRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v lbalanceRight k p v l m r- | size' (left l) > size' (right l) = lsingleRight k p v l m r- | otherwise = ldoubleRight k p v l m r+ | alpha * size' (left l) > size' (right l) = lsingleRight k p v l m r+ | otherwise = ldoubleRight k p v l m r {-# INLINABLE rbalanceLeft #-} rbalanceLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v rbalanceLeft k p v l m r- | size' (left r) < size' (right r) = rsingleLeft k p v l m r- | otherwise = rdoubleLeft k p v l m r+ | size' (left r) < alpha * size' (right r) = rsingleLeft k p v l m r+ | otherwise = rdoubleLeft k p v l m r {-# INLINABLE rbalanceRight #-} rbalanceRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v rbalanceRight k p v l m r- | size' (left l) > size' (right l) = rsingleRight k p v l m r- | otherwise = rdoubleRight k p v l m r+ | alpha * size' (left l) > size' (right l) = rsingleRight k p v l m r+ | otherwise = rdoubleRight k p v l m r {-# INLINABLE lsingleLeft #-} lsingleLeft@@ -652,7 +656,11 @@ hasMinHeapProperty t && hasBinarySearchTreeProperty t && hasCorrectSizeAnnotations t &&- hasBalancedTreeProperty t+ hasBalancedTreeProperty t &&+ hasLTreeBST t &&+ hasLTreeKeyCondition t &&+ hasLTreeOrigins t &&+ hasPennantHeap t hasDuplicateKeys :: Ord k => OrdPSQ k p v -> Bool hasDuplicateKeys = any (> 1) . List.map length . List.group . List.sort . keys@@ -703,13 +711,52 @@ 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+ withinOmegaFactor t1 t2 = l + u < 2 || l * omega >= u where (l, u) | s1 < s2 = (s1, s2) | otherwise = (s2, s1) s1 = size' t1 s2 = size' t2++hasLTreeBST :: Ord k => OrdPSQ k p v -> Bool+hasLTreeBST Void = True+hasLTreeBST (Winner (E qk _ _) t qm) = qk <= qm && go (<= qm) t+ where+ go _ Start = True+ go p (LLoser _ (E k _ _) l m r) =+ p k && go (\x -> p x && x <= m) l && go (\x -> p x && x > m) r+ go p (RLoser _ (E k _ _) l m r) =+ p k && go (\x -> p x && x <= m) l && go (\x -> p x && x > m) r++hasLTreeKeyCondition :: Ord k => OrdPSQ k p v -> Bool+hasLTreeKeyCondition Void = True+hasLTreeKeyCondition p@(Winner _ t qm) = hasKey qm && go t+ where+ hasKey k = isJust (lookup k p)++ go Start = True+ go (LLoser _ _ l m r) = hasKey m && go l && go r+ go (RLoser _ _ l m r) = hasKey m && go l && go r++hasLTreeOrigins :: Ord k => OrdPSQ k p v -> Bool+hasLTreeOrigins Void = True+hasLTreeOrigins (Winner _ lt _) = go lt+ where+ go Start = True+ go (LLoser _ (E k _ _) l m r) = k <= m && go l && go r+ go (RLoser _ (E k _ _) l m r) = k > m && go l && go r++hasPennantHeap :: Ord p => OrdPSQ k p v -> Bool+hasPennantHeap Void = True+hasPennantHeap p@(Winner (E _ mp _) _ _) = go mp (tourView p)+ where+ go _ Null = True+ go d (Single (E _ prio _)) = prio >= d+ go d (Play l r) = fromMaybe False $ do+ (_, pl, _) <- findMin l+ (_, pr, _) <- findMin r+ pure $ pl >= d && pr >= d && go pl (tourView l) && go pr (tourView r) -------------------------------------------------------------------------------- -- Utility functions