lfudacaching (empty) → 0.1.0.0
raw patch · 10 files changed
+2088/−0 lines, 10 filesdep +basedep +deepseqdep +ghc-primsetup-changed
Dependencies added: base, deepseq, ghc-prim, hashable, lfudacaching, psqueues, tasty, tasty-bench, tasty-hunit
Files
- CHANGELOG.md +17/−0
- LICENSE +191/−0
- README.md +147/−0
- Setup.hs +2/−0
- app/Main.hs +98/−0
- bench/Main.hs +78/−0
- lfudacaching.cabal +148/−0
- src/Data/LfudaCache.hs +419/−0
- test/Main.hs +9/−0
- test/Test/Data/LfudaCache.hs +979/−0
+ CHANGELOG.md view
@@ -0,0 +1,17 @@+# Changelog for `lfudacaching`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## 0.1.0.0 - 2026-03-06++Pure Haskell implementation of cache data structures with three eviction policies:+LFUDA (Least Frequently Used with Dynamic Aging), GDSF (Greedy Dual-Size Frequency),+and LFU (Least Frequently Used).++- Immutable API: `insert`, `insertView`, `lookup`, `peek`, `contains`, `remove`, `purge`+- `Functor`, `Foldable`, `Traversable` instances for `LfudaCache`+- Test suite (29 tests), benchmarks, and demo program
+ LICENSE view
@@ -0,0 +1,191 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to the Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by the Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding any notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ Copyright 2026 philippedev101++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,147 @@+# lfudacaching++A pure Haskell implementation of cache data structures with multiple eviction policies:++- **LFUDA** (Least Frequently Used with Dynamic Aging) - Prevents cache pollution by aging out stale entries+- **GDSF** (Greedy Dual-Size Frequency) - Factors in entry size alongside frequency+- **LFU** (Least Frequently Used) - Classic frequency-based eviction without aging++Based on the Go implementation from [lfuda-go](https://github.com/bparli/lfuda-go).++## Installation++Add `lfudacaching` to your `package.yaml` dependencies:++```yaml+dependencies:+ - lfudacaching+```++Or in your `.cabal` file:++```cabal+build-depends: lfudacaching+```++## Usage++Note: `Data.LfudaCache` exports its own `lookup`, so you need to hide it from `Prelude`.++```haskell+import Data.LfudaCache+import Prelude hiding (lookup)++main :: IO ()+main = do+ -- Create a cache with capacity 100 using LFUDA policy+ let cache = newLFUDA 100++ -- Insert key-value pairs+ let cache1 = insert "alice" 42 cache+ let cache2 = insert "bob" 99 cache1++ -- Lookup updates frequency (affects eviction priority)+ case lookup "alice" cache2 of+ Just (val, cache2') -> do+ putStrLn $ "Found alice: " ++ show val+ -- Use cache2' going forward (frequency of "alice" was bumped)+ print (size cache2')+ Nothing -> putStrLn "Not found"++ -- Peek reads without updating frequency+ case peek "bob" cache2 of+ Just val -> putStrLn $ "Peeked bob: " ++ show val+ Nothing -> putStrLn "Not found"++ -- Check membership without frequency update+ print $ contains "alice" cache2 -- True++ -- Remove an entry+ let cache3 = remove "alice" cache2++ -- Cache info+ print $ size cache3 -- 1+ print $ keys cache3 -- ["bob"]+```++A demo program is included — run it with `stack exec lfuda-demo`.++## API Overview++### Construction++| Function | Description |+|------------|--------------------------------------|+| `newLFUDA` | Create cache with LFUDA policy |+| `newGDSF` | Create cache with GDSF policy |+| `newLFU` | Create cache with LFU policy |+| `newCache` | Create cache with specified policy |++### Operations++| Function | Description |+|--------------|------------------------------------------------|+| `insert` | Insert a key-value pair |+| `insertView` | Insert, returning the evicted entry if any |+| `lookup` | Get value and update frequency |+| `peek` | Get value without updating frequency |+| `contains` | Check if key exists (no frequency update) |+| `remove` | Remove an entry |+| `purge` | Clear all entries |++### Cache Information++| Function | Description |+|----------|--------------------------------------------------|+| `keys` | Get all keys ordered by priority (highest first) |+| `size` | Current number of entries |+| `age` | Current cache age |++### Typeclass Instances++`LfudaCache k` is an instance of `Functor`, `Foldable`, and `Traversable`, allowing you to map, fold, and traverse over cached values.++## Eviction Policies++### LFUDA+Priority = frequency + cache age. When an entry is evicted, the cache age is set to the evicted entry's frequency. This prevents long-lived but infrequently accessed entries from dominating the cache.++### GDSF+Priority = frequency + cache age * entry size. Similar to LFUDA but factors in entry size, giving larger entries higher eviction resistance. Currently all entries use a fixed size of 1, so GDSF behaves similarly to LFUDA.++### LFU+Priority = frequency. Simple frequency counting with no aging. The cache age never changes. Entries that were popular in the past stay cached even if they are no longer accessed.++## Important Behavioral Notes++### Priorities are sticky++Entry priorities are stored in the underlying priority queue and are **only recalculated on `lookup`**, not when the cache age changes. This means:++- After an eviction raises the cache age, existing entries keep their old (lower) priorities.+- A freshly inserted entry gets `priority = 1 + current_age`, which can be *higher* than an old entry whose priority was computed when the age was lower.+- To "refresh" an entry's priority to account for the current age, you must `lookup` it.++This is standard LFUDA behavior and means that entries which haven't been accessed recently will naturally drift toward eviction as the cache ages.++### Re-inserting a key resets its frequency++Calling `insert` on an existing key replaces the value **and resets its frequency to 1**. If you've built up a high frequency through many `lookup` calls, re-inserting the same key throws that away. Use `lookup` to access entries without resetting frequency, or check with `contains`/`peek` before inserting.++### Eviction happens during insert++When the cache is full, `insert` evicts the lowest-priority entry **before returning**. If you insert a key you intend to immediately remove, the eviction still happens. This can remove entries you intended to keep.++### Purge does not reset age++`purge` clears all entries and resets the size to 0, but the cache age is preserved. Entries inserted after a purge will have their priority calculated using the pre-purge age.++## Building++```bash+stack build # Build library+stack test # Run tests (29 tests)+stack bench # Run benchmarks+stack exec lfuda-demo # Run demo program+```+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,98 @@+module Main (main) where++import Data.LfudaCache+import Data.Foldable (foldl')+import Prelude hiding (lookup)+++main :: IO ()+main = do+ putStrLn "=== LFUDA Cache Demo ==="+ putStrLn ""++ -- Create a small cache to demonstrate eviction behavior+ let cache :: LfudaCache String Int+ cache = newLFUDA 3+ putStrLn $ "Created LFUDA cache with capacity 3"+ putStrLn ""++ -- Insert some entries+ let c1 = insert "alice" (100 :: Int) cache+ let c2 = insert "bob" 200 c1+ let c3 = insert "carol" 300 c2+ putStrLn $ "Inserted alice=100, bob=200, carol=300"+ putStrLn $ "Size: " ++ show (size c3)+ putStrLn $ "Keys: " ++ show (keys c3)+ putStrLn ""++ -- Lookup bumps frequency+ putStrLn "Looking up 'alice' 3 times (bumps frequency)..."+ let c4 = foldl' (\c _ -> case lookup "alice" c of+ Just (_, c') -> c'+ Nothing -> c+ ) c3 [1..3 :: Int]++ -- Insert a 4th entry - should evict lowest frequency entry+ -- Use insertView to see what was evicted+ let (evicted, c5) = insertView "dave" 400 c4+ putStrLn $ "Inserted dave=400, eviction occurred: " ++ show (evicted /= Nothing)+ case evicted of+ Just (k, v) -> putStrLn $ "Evicted: " ++ show k ++ "=" ++ show v+ Nothing -> pure ()+ putStrLn $ "Keys after eviction: " ++ show (keys c5)+ putStrLn $ "alice still in cache: " ++ show (contains "alice" c5)+ putStrLn ""++ -- Demonstrate peek vs lookup+ putStrLn "--- Peek vs Lookup ---"+ case peek "alice" c5 of+ Just v -> putStrLn $ "peek alice = " ++ show v ++ " (no frequency update)"+ Nothing -> putStrLn "alice not found"++ case lookup "alice" c5 of+ Just (v, _) -> putStrLn $ "lookup alice = " ++ show v ++ " (frequency updated)"+ Nothing -> putStrLn "alice not found"+ putStrLn ""++ -- Demonstrate insertView+ putStrLn "--- InsertView ---"+ let (evictedEntry, c6) = insertView "eve" 500 c5+ case evictedEntry of+ Just (k, v) -> putStrLn $ "Evicted: " ++ show k ++ "=" ++ show v+ Nothing -> putStrLn "No eviction"+ putStrLn $ "Keys: " ++ show (keys c6)+ putStrLn ""++ -- Compare policies+ putStrLn "=== Policy Comparison ==="+ putStrLn ""+ comparePolicies++comparePolicies :: IO ()+comparePolicies = do+ let capacity :: Int+ capacity = 3+ items :: [(String, Int)]+ items = [("a", 1), ("b", 2), ("c", 3), ("d", 4), ("e", 5)]++ -- For each policy, insert items and show what survives+ let policies :: [(CachePolicy, String)]+ policies = [(LFUDA, "LFUDA"), (GDSF, "GDSF"), (LFU, "LFU")]++ mapM_ (\(policy, name) -> do+ let cache0 :: LfudaCache String Int+ cache0 = newCache capacity policy+ -- Insert first 3+ cache1 = foldl' (\c (k, v) -> insert k v c) cache0 (take 3 items)+ -- Bump frequency of "a"+ let cache2 = foldl' (\c _ -> case lookup "a" c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache1 [1..2 :: Int]+ -- Insert remaining 2+ let cache3 = foldl' (\c (k, v) -> insert k v c) cache2 (drop 3 items)++ putStrLn $ name ++ ":"+ putStrLn $ " Surviving keys: " ++ show (keys cache3)+ putStrLn $ " Age: " ++ show (age cache3)+ ) policies
+ bench/Main.hs view
@@ -0,0 +1,78 @@+module Main (main) where++import Test.Tasty.Bench+import Data.LfudaCache+import Data.Foldable (foldl')+import Prelude hiding (lookup)+++main :: IO ()+main = defaultMain+ [ bgroup "insert"+ [ bench "LFUDA/1000" $ nf (insertN LFUDA 1000) 10000+ , bench "GDSF/1000" $ nf (insertN GDSF 1000) 10000+ , bench "LFU/1000" $ nf (insertN LFU 1000) 10000+ ]+ , bgroup "lookup"+ [ bench "LFUDA/hit" $ nf (lookupHit LFUDA 1000) 5000+ , bench "GDSF/hit" $ nf (lookupHit GDSF 1000) 5000+ , bench "LFU/hit" $ nf (lookupHit LFU 1000) 5000+ , bench "LFUDA/miss" $ nf (lookupMiss LFUDA 1000) 5000+ , bench "LFU/miss" $ nf (lookupMiss LFU 1000) 5000+ ]+ , bgroup "mixed"+ [ bench "LFUDA/1000" $ nf (mixedWorkload LFUDA 1000) 10000+ , bench "GDSF/1000" $ nf (mixedWorkload GDSF 1000) 10000+ , bench "LFU/1000" $ nf (mixedWorkload LFU 1000) 10000+ ]+ , bgroup "contains"+ [ bench "LFUDA/1000" $ nf (containsWorkload LFUDA 1000) 5000+ , bench "LFU/1000" $ nf (containsWorkload LFU 1000) 5000+ ]+ ]++-- | Insert n items into a cache of given capacity+insertN :: CachePolicy -> Int -> Int -> LfudaCache Int Int+insertN policy capacity n =+ foldl' (\c i -> insert i i c) (newCache capacity policy) [0..n-1]++-- | Lookup items that are in the cache (hits)+lookupHit :: CachePolicy -> Int -> Int -> LfudaCache Int Int+lookupHit policy capacity n =+ let cache0 = foldl' (\c i -> insert i i c) (newCache capacity policy) [0..capacity-1]+ in foldl' (\c i ->+ case lookup (i `mod` capacity) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache0 [0..n-1]++-- | Lookup items that are not in the cache (misses)+lookupMiss :: CachePolicy -> Int -> Int -> LfudaCache Int Int+lookupMiss policy capacity n =+ let cache0 = foldl' (\c i -> insert i i c) (newCache capacity policy) [0..capacity-1]+ in foldl' (\c i ->+ case lookup (capacity + i) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache0 [0..n-1]++-- | Mixed insert/lookup workload+mixedWorkload :: CachePolicy -> Int -> Int -> LfudaCache Int Int+mixedWorkload policy capacity n =+ foldl' (\c i ->+ if even i+ then insert (i `mod` (capacity * 2)) i c+ else case lookup (i `mod` (capacity * 2)) c of+ Just (_, c') -> c'+ Nothing -> c+ ) (newCache capacity policy) [0..n-1]++-- | Contains check workload (no frequency update)+containsWorkload :: CachePolicy -> Int -> Int -> Int+containsWorkload policy capacity n =+ let cache0 = foldl' (\c i -> insert i i c) (newCache capacity policy) [0..capacity-1]+ in foldl' (\acc i ->+ if contains (i `mod` (capacity * 2)) cache0+ then acc + 1+ else acc+ ) (0 :: Int) [0..n-1]
+ lfudacaching.cabal view
@@ -0,0 +1,148 @@+cabal-version: 3.0+name: lfudacaching+version: 0.1.0.0+synopsis: Pure LFUDA, GDSF, and LFU cache implementations+description:+ Pure, immutable cache with three eviction policies:+ .+ * __LFUDA__ — Least Frequently Used with Dynamic Aging+ * __GDSF__ — Greedy Dual-Size Frequency+ * __LFU__ — Least Frequently Used+ .+ All operations are /O(log n)/ in the number of cached entries, backed by a+ hash-priority search queue.++category: Data+homepage: https://github.com/philippedev101/lfudacache#readme+bug-reports: https://github.com/philippedev101/lfudacache/issues+author: philippedev101+maintainer: philippedev101@gmail.com+copyright: 2026+license: Apache-2.0+license-file: LICENSE+build-type: Simple++extra-source-files:+ README.md++extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/philippedev101/lfudacache++-- Shared language, extensions, and base dependency+common lang+ default-language: GHC2021+ default-extensions:+ BangPatterns+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DerivingVia+ DisambiguateRecordFields+ DuplicateRecordFields+ FunctionalDependencies+ GADTs+ KindSignatures+ LambdaCase+ MultiWayIf+ NoImplicitPrelude+ OverloadedRecordDot+ OverloadedStrings+ PartialTypeSignatures+ PolyKinds+ RecordWildCards+ RoleAnnotations+ UnboxedSums+ UnboxedTuples+ UnliftedDatatypes+ UnliftedNewtypes+ ViewPatterns+ build-depends:+ base >= 4.18 && < 5++-- Strict warnings for development components (not the library)+common dev-warnings+ ghc-options:+ -Weverything++ -- Unavoidable noise+ -Wno-missing-import-lists+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module+ -Wno-safe+ -Wno-unsafe++ -- Promoted to errors+ -Werror=deprecations+ -Werror=identities+ -Werror=incomplete-patterns+ -Werror=incomplete-record-updates+ -Werror=missing-fields+ -Werror=missing-methods+ -Werror=ambiguous-fields+ -Werror=missing-export-lists+ -Werror=missing-local-signatures+ -Werror=monomorphism-restriction+ -Werror=type-defaults+ -Werror=orphans+ -Werror=name-shadowing+ -Werror=missing-kind-signatures+ -Werror=missing-deriving-strategies+ -Werror=unticked-promoted-constructors+ -Werror=missing-role-annotations++ -- foldl' import is redundant on GHC 9.10+ but required on 9.6/9.8+ -Wno-unused-imports++ -- Cross-module specialisation: unfixable+ -Wno-all-missed-specialisations+ -Wno-missed-specialisations++library+ import: lang+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules:+ Data.LfudaCache+ build-depends:+ deepseq >= 1.4 && < 1.7+ , hashable >= 1.4 && < 1.6+ , psqueues >= 0.2.8 && < 0.3+ , ghc-prim >= 0.10 && < 0.14++executable lfuda-demo+ import: lang, dev-warnings+ hs-source-dirs: app+ main-is: Main.hs+ build-depends:+ lfudacaching++test-suite lfuda-test+ import: lang, dev-warnings+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Test.Data.LfudaCache+ build-depends:+ lfudacaching+ , tasty >= 1.5 && < 1.6+ , tasty-hunit >= 0.10 && < 0.11++benchmark lfuda-bench+ import: lang+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ ghc-options: -O2 -rtsopts+ build-depends:+ lfudacaching+ , tasty-bench >= 0.4 && < 0.5
+ src/Data/LfudaCache.hs view
@@ -0,0 +1,419 @@+{-# LANGUAGE StrictData #-}+{-|+Module : Data.LfudaCache+Description : Pure LFUDA, GDSF, and LFU cache implementations+Copyright : (c) 2026 philippedev101+License : Apache-2.0+Maintainer : philippedev101@gmail.com+Stability : experimental++Pure, immutable cache with three eviction policies: __LFUDA__, __GDSF__, and __LFU__.++== Eviction policies++* __LFUDA__ (Least Frequently Used with Dynamic Aging) — combines access+ frequency with a global /age/ counter that advances on every eviction.+ New entries start with @frequency + age@ as their priority, which prevents+ long-lived but rarely accessed items from permanently occupying the cache+ (a common weakness of plain LFU).++* __GDSF__ (Greedy Dual-Size Frequency) — extends LFUDA by factoring in+ entry size: @frequency + age × size@. Useful when cached values have+ varying costs.++* __LFU__ (Least Frequently Used) — evicts the entry with the lowest access+ frequency. No aging is applied, so frequently accessed items are never+ evicted regardless of how long ago they were last accessed.++== Quick start++@+import Data.LfudaCache+import Prelude hiding ('lookup')++example :: (Maybe String, LfudaCache String String)+example =+ let cache = 'newLFUDA' 100+ cache' = 'insert' \"hello\" \"world\" cache+ in case 'lookup' \"hello\" cache' of+ Just (val, cache'') -> (Just val, cache'')+ Nothing -> (Nothing, cache')+@++== Complexity++All operations are /O(log n)/ in the number of cached entries, backed by a+hash-priority search queue ('Data.HashPSQ.HashPSQ').++== Lookup vs Peek++'lookup' increments the entry's access frequency (affecting future eviction+priority). 'peek' returns the value without any side effect on frequency —+useful for monitoring or read-only inspection.+-}+module Data.LfudaCache+ ( -- * Cache type+ LfudaCache+ , CachePolicy(..)+ , Age++ -- * Construction+ , newLFUDA+ , newGDSF+ , newLFU+ , newCache++ -- * Insertion+ , insert+ , insertView++ -- * Lookup+ , lookup+ , peek+ , contains++ -- * Deletion+ , remove+ , purge++ -- * Size and metadata+ , keys+ , size+ , age+ ) where++import Control.DeepSeq (NFData)+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Maybe (isNothing)+import GHC.Generics (Generic)+import GHC.Types (Type)+import Prelude hiding (lookup)+import qualified Data.HashPSQ as HashPSQ+++-- | Eviction policy. See the module documentation for a description of each.+type CachePolicy :: Type+data CachePolicy+ = LFUDA -- ^ Least Frequently Used with Dynamic Aging.+ -- Priority = @frequency + age@.+ | GDSF -- ^ Greedy Dual-Size Frequency.+ -- Priority = @frequency + age × size@.+ | LFU -- ^ Plain Least Frequently Used (no aging).+ -- Priority = @frequency@.+ deriving stock (Eq, Show, Generic)+ deriving anyclass (NFData)++-- | Access count for a cache entry. Incremented on every 'lookup' hit.+type Frequency :: Type+type Frequency = Int64++-- | Cache age counter. Under LFUDA\/GDSF this advances on every eviction,+-- ensuring that newly inserted entries are not immediately evicted just+-- because older entries accumulated high frequency counts.+type Age :: Type+type Age = Int64++-- | Internal priority value computed from 'Frequency', 'Size', and 'Age'+-- according to the active 'CachePolicy'. The entry with the /lowest/+-- priority is evicted first.+type Priority :: Type+type Priority = Int64++-- | Logical size of a cache entry (used by the 'GDSF' policy).+-- Currently fixed at @1@ for every entry.+type Size :: Type+type Size = Int64++-- | Internal result of an eviction attempt (not exported).+type EvictionResult :: Type -> Type -> Type+type role EvictionResult representational representational+data EvictionResult k v =+ EvictionResult+ { evicted :: !Bool -- ^ Whether an eviction occurred+ , evictedKey :: !(Maybe k) -- ^ The key that was evicted (if any)+ , evictedValue :: !(Maybe v) -- ^ The value that was evicted (if any)+ } deriving stock (Show, Eq, Generic)+ deriving anyclass (NFData)++-- | An immutable, bounded cache parameterised by key type @k@ and value+-- type @v@. The eviction strategy is determined by the 'CachePolicy' chosen+-- at construction time.+--+-- The cache supports 'Functor', 'Foldable', and 'Traversable' over values,+-- as well as 'Eq', 'Show', and 'NFData'.+type LfudaCache :: Type -> Type -> Type+type role LfudaCache representational representational+data LfudaCache k v = LfudaCache+ { lfudaCapacity :: {-# UNPACK #-} !Int -- ^ The maximum number of elements in the cache+ , lfudaSize :: {-# UNPACK #-} !Int -- ^ The current number of elements in the cache+ , lfudaAge :: {-# UNPACK #-} !Age -- ^ The current age of the cache+ , lfudaPolicy :: !CachePolicy -- ^ The cache eviction policy to use+ , lfudaQueue :: !(HashPSQ.HashPSQ k Priority (Frequency, Size, v)) -- ^ Underlying priority queue+ } deriving stock (Generic)++instance (Show k, Show v) => Show (LfudaCache k v) where+ show c = "LfudaCache { capacity=" ++ show (lfudaCapacity c) +++ ", size=" ++ show (lfudaSize c) +++ ", age=" ++ show (lfudaAge c) +++ ", policy=" ++ show (lfudaPolicy c) +++ ", entries=" ++ show (lfudaSize c) ++ " }"++instance (Eq k, Eq v, Hashable k, Ord k) => Eq (LfudaCache k v) where+ c1 == c2 = lfudaCapacity c1 == lfudaCapacity c2 &&+ lfudaSize c1 == lfudaSize c2 &&+ lfudaAge c1 == lfudaAge c2 &&+ lfudaPolicy c1 == lfudaPolicy c2 &&+ lfudaQueue c1 == lfudaQueue c2++instance (NFData k, NFData v) => NFData (LfudaCache k v)++-- Manual implementation of Functor+instance (Hashable k, Ord k) => Functor (LfudaCache k) where+ {-# INLINABLE fmap #-}+ fmap f (LfudaCache cap sizeVal ageVal policy queue) =+ LfudaCache cap sizeVal ageVal policy (mapQueue f queue)+ where+ mapQueue :: forall v v'. (v -> v') -> HashPSQ.HashPSQ k Priority (Frequency, Size, v) -> HashPSQ.HashPSQ k Priority (Frequency, Size, v')+ mapQueue g = HashPSQ.fromList . map mapEntry . HashPSQ.toList+ where+ mapEntry :: (k, Priority, (Frequency, Size, v)) -> (k, Priority, (Frequency, Size, v'))+ mapEntry (k, p, (freq, s, v)) = (k, p, (freq, s, g v))++-- Manual implementation of Foldable+instance (Hashable k, Ord k) => Foldable (LfudaCache k) where+ {-# INLINABLE foldr #-}+ foldr f z = foldr (\(_, _, (_, _, v)) acc -> f v acc) z . HashPSQ.toList . lfudaQueue++-- Manual implementation of Traversable+instance (Hashable k, Ord k) => Traversable (LfudaCache k) where+ {-# INLINABLE traverse #-}+ traverse f (LfudaCache cap sizeVal ageVal policy queue) =+ LfudaCache cap sizeVal ageVal policy <$> traverseQueue f queue+ where+ traverseQueue :: forall f v v'. Applicative f =>+ (v -> f v') ->+ HashPSQ.HashPSQ k Priority (Frequency, Size, v) ->+ f (HashPSQ.HashPSQ k Priority (Frequency, Size, v'))+ traverseQueue g = fmap HashPSQ.fromList . traverse transformEntry . HashPSQ.toList+ where+ transformEntry :: (k, Priority, (Frequency, Size, v)) -> f (k, Priority, (Frequency, Size, v'))+ transformEntry (k, p, (freq, s, v)) = (\v' -> (k, p, (freq, s, v'))) <$> g v++-- | Create a new empty cache with the given maximum capacity and eviction+-- policy. Calls 'error' if @capacity < 1@.+--+-- >>> size (newCache 100 LFUDA)+-- 0+{-# INLINABLE newCache #-}+newCache :: Int -> CachePolicy -> LfudaCache k v+newCache capacity policy+ | capacity < 1 = error "LfudaCache.new: capacity < 1"+ | otherwise = LfudaCache capacity 0 0 policy HashPSQ.empty++-- | @'newLFUDA' cap@ — shorthand for @'newCache' cap 'LFUDA'@.+{-# INLINABLE newLFUDA #-}+newLFUDA :: Int -> LfudaCache k v+newLFUDA capacity = newCache capacity LFUDA++-- | @'newGDSF' cap@ — shorthand for @'newCache' cap 'GDSF'@.+{-# INLINABLE newGDSF #-}+newGDSF :: Int -> LfudaCache k v+newGDSF capacity = newCache capacity GDSF++-- | @'newLFU' cap@ — shorthand for @'newCache' cap 'LFU'@.+{-# INLINABLE newLFU #-}+newLFU :: Int -> LfudaCache k v+newLFU capacity = newCache capacity LFU++-- | Compute the eviction priority for an entry under the given policy.+-- Lower priority ⇒ evicted first.+{-# INLINE calculatePriority #-}+calculatePriority :: CachePolicy -> Frequency -> Size -> Age -> Priority+calculatePriority LFUDA freq _ ageValue = freq + ageValue+calculatePriority GDSF freq sizeValue ageValue = freq + ageValue * sizeValue+calculatePriority LFU freq _ _ = freq++-- | Common logic for insert operations+{-# INLINABLE prepareInsert #-}+prepareInsert :: (Hashable k, Ord k) => k -> v -> LfudaCache k v+ -> (Bool, LfudaCache k v)+prepareInsert key val c =+ let initialFreq :: Frequency+ initialFreq = 1+ entrySize :: Size+ entrySize = 1 -- Default size (could be parameterized in future)+ priority = calculatePriority (lfudaPolicy c) initialFreq entrySize (lfudaAge c)+ (mbOldVal, queue') = HashPSQ.insertView key priority (initialFreq, entrySize, val) (lfudaQueue c)+ sizeIncrease = isNothing mbOldVal+ in (sizeIncrease, c { lfudaSize = if sizeIncrease+ then lfudaSize c + 1+ else lfudaSize c+ , lfudaQueue = queue'+ })++-- | Restore 'LfudaCache' invariants by evicting elements if cache exceeds capacity+-- Returns (eviction result, updated cache)+{-# INLINABLE trim #-}+trim :: (Hashable k, Ord k) => LfudaCache k v -> (EvictionResult k v, LfudaCache k v)+trim c+ | lfudaSize c <= lfudaCapacity c =+ (EvictionResult False Nothing Nothing, c)+ | otherwise =+ case HashPSQ.findMin (lfudaQueue c) of+ Nothing ->+ (EvictionResult False Nothing Nothing, c) -- Should not happen in practice+ Just (k, _, (freq, _, v)) ->+ let newAge = case lfudaPolicy c of+ LFU -> lfudaAge c -- No aging for LFU+ _ -> freq -- Set age to frequency+ c' = c { lfudaSize = lfudaSize c - 1+ , lfudaAge = newAge+ , lfudaQueue = HashPSQ.deleteMin (lfudaQueue c)+ }+ in (EvictionResult True (Just k) (Just v), c')++-- | Insert a key–value pair. If the key already exists its value is+-- replaced and its frequency is reset to @1@. When the cache is at+-- capacity the lowest-priority entry is evicted first.+--+-- Use 'insertView' if you need to know /which/ entry was evicted.+--+-- /O(log n)/+--+-- >>> let c = insert "a" 1 (newLFUDA 2)+-- >>> size c+-- 1+{-# INLINABLE insert #-}+insert :: (Hashable k, Ord k) => k -> v -> LfudaCache k v -> LfudaCache k v+insert key val c =+ let (_, c') = prepareInsert key val c+ (_, c'') = trim c'+ in c''++-- | Like 'insert', but also returns the evicted entry (if any) as+-- @'Just' (key, value)@, or 'Nothing' when no eviction was necessary.+--+-- /O(log n)/+--+-- >>> let (ev1, c) = insertView "a" 1 (newLFUDA 1)+-- >>> ev1+-- Nothing+-- >>> let (ev2, _) = insertView "b" 2 c+-- >>> ev2+-- Just ("a",1)+{-# INLINABLE insertView #-}+insertView :: (Hashable k, Ord k) => k -> v -> LfudaCache k v -> (Maybe (k, v), LfudaCache k v)+insertView key val c =+ let (_, c') = prepareInsert key val c+ (evictionResult, c'') = trim c'+ in case (evictedKey evictionResult, evictedValue evictionResult) of+ (Just k, Just v) -> (Just (k, v), c'')+ _ -> (Nothing, c'')++-- | Look up a key, returning its value and an updated cache with the+-- entry's frequency incremented. Returns 'Nothing' on a cache miss.+--+-- Use 'peek' if you do not want the frequency bump.+--+-- /O(log n)/+--+-- >>> let c = insert "a" 1 (newLFUDA 2)+-- >>> fmap fst (lookup "a" c)+-- Just 1+-- >>> lookup "z" c+-- Nothing+{-# INLINABLE lookup #-}+lookup :: (Hashable k, Ord k) => k -> LfudaCache k v -> Maybe (v, LfudaCache k v)+lookup k c =+ case HashPSQ.lookup k (lfudaQueue c) of+ Nothing -> Nothing+ Just (_, (freq, entrySize, v)) ->+ let newFreq = freq + 1+ newPriority = calculatePriority (lfudaPolicy c) newFreq entrySize (lfudaAge c)+ c' = c { lfudaQueue = HashPSQ.insert k newPriority (newFreq, entrySize, v) (lfudaQueue c) }+ in Just (v, c')++-- | Test whether a key is present in the cache. Does /not/ affect+-- the entry's frequency.+--+-- /O(log n)/+--+-- >>> let c = insert "a" 1 (newLFUDA 2)+-- >>> contains "a" c+-- True+-- >>> contains "z" c+-- False+{-# INLINABLE contains #-}+contains :: (Hashable k, Ord k) => k -> LfudaCache k v -> Bool+contains k = HashPSQ.member k . lfudaQueue++-- | Retrieve a value without incrementing its access frequency.+-- Useful for read-only inspection, monitoring, or debugging.+--+-- /O(log n)/+--+-- >>> let c = insert "a" 1 (newLFUDA 2)+-- >>> peek "a" c+-- Just 1+-- >>> peek "z" c+-- Nothing+{-# INLINABLE peek #-}+peek :: (Hashable k, Ord k) => k -> LfudaCache k v -> Maybe v+peek k c = (\(_, (_, _, v)) -> v) <$> HashPSQ.lookup k (lfudaQueue c)++-- | Remove a key from the cache. Returns the cache unchanged if the key+-- is not present.+--+-- /O(log n)/+--+-- >>> let c = insert "a" 1 (newLFUDA 2)+-- >>> size (remove "a" c)+-- 0+-- >>> size (remove "z" c)+-- 1+{-# INLINABLE remove #-}+remove :: (Hashable k, Ord k) => k -> LfudaCache k v -> LfudaCache k v+remove k c =+ case HashPSQ.lookup k (lfudaQueue c) of+ Nothing -> c+ Just _ -> c { lfudaSize = lfudaSize c - 1+ , lfudaQueue = HashPSQ.delete k (lfudaQueue c)+ }++-- | Remove all entries from the cache, resetting 'size' to @0@.+-- The capacity and policy are preserved.+--+-- /O(1)/+--+-- >>> size (purge (insert "a" 1 (newLFUDA 2)))+-- 0+{-# INLINABLE purge #-}+purge :: LfudaCache k v -> LfudaCache k v+purge c = c { lfudaSize = 0+ , lfudaQueue = HashPSQ.empty+ }++-- | The current age of the cache. Under 'LFUDA' and 'GDSF' the age+-- advances each time an entry is evicted; under 'LFU' it stays at @0@.+--+-- /O(1)/+{-# INLINABLE age #-}+age :: LfudaCache k v -> Age+age = lfudaAge++-- | All keys currently in the cache, ordered from highest to lowest+-- eviction priority (i.e. the entry most likely to survive eviction+-- comes first).+--+-- /O(n log n)/+{-# INLINABLE keys #-}+keys :: (Hashable k, Ord k) => LfudaCache k v -> [k]+keys = map (\(k, _, _) -> k) . reverse . HashPSQ.toList . lfudaQueue++-- | The number of entries currently stored in the cache.+--+-- /O(1)/+{-# INLINABLE size #-}+size :: LfudaCache k v -> Int+size = lfudaSize
+ test/Main.hs view
@@ -0,0 +1,9 @@+module Main (main) where++import Test.Data.LfudaCache (tests)+import Test.Tasty+import Prelude+++main :: IO ()+main = defaultMain tests
+ test/Test/Data/LfudaCache.hs view
@@ -0,0 +1,979 @@+module Test.Data.LfudaCache+ ( tests+ ) where++import Test.Tasty+import Test.Tasty.HUnit+import Control.Monad+import Data.Maybe (isNothing)+import Data.LfudaCache+import Data.Foldable (foldl')+import Prelude hiding (lookup)+import Data.Kind+++tests :: TestTree+tests = testGroup "LFUDA Cache Tests"+ [ testCase "Basic LFUDA Operations" testLFUDA+ , testCase "GDSF Test" testGDSF+ , testCase "Insert Eviction Via InsertView" testInsertEviction+ , testCase "Contains Doesn't Update Frequency" testLFUDAContains+ , testCase "Peek Doesn't Update Frequency" testLFUDAPeek+ , testCase "Remove Operation" testLFUDARemove+ , testCase "Age Tracking" testLFUDAAge+ , testCase "Size Tracking" testLFUDASize+ , testCase "LFU Basic Operations" testLFU+ , testCase "LFU No Dynamic Aging" testLFUNoAging+ , testCase "LFU Frequency-Based Eviction" testLFUFrequencyEviction+ , testCase "LFU InsertView" testLFUInsertView+ , testCase "GDSF Size-Weighted Eviction" testGDSFSizeEviction+ , testCase "GDSF Dynamic Aging" testGDSFAging+ , testCase "GDSF Frequency And Size" testGDSFFrequencyAndSize+ , testCase "Edge: Re-insert Resets Frequency" testReinsertResetsFrequency+ , testCase "Edge: Capacity 1 Corner Cases" testCapacity1+ , testCase "Edge: Size Consistency" testSizeConsistency+ , testCase "Edge: Purge Preserves Age" testPurgePreservesAge+ , testCase "Edge: Operations After Purge" testOpsAfterPurge+ , testCase "Edge: InsertView Self-Replace" testInsertViewSelfReplace+ , testCase "Edge: InsertView Evicts Correct Entry" testInsertViewEvictsCorrect+ , testCase "Edge: Remove Nonexistent" testRemoveNonexistent+ , testCase "Edge: Equal Frequency Eviction" testEqualFrequencyEviction+ , testCase "Edge: LFUDA Age Accumulation" testAgeAccumulation+ , testCase "Edge: Lookup After Insert Same Key" testLookupAfterReinsert+ , testCase "Edge: Rapid Insert-Remove Cycles" testInsertRemoveCycles+ , testBenchmark "LFUDA Benchmark" benchmarkLFUDA+ , testBenchmark "LFUDA Random Benchmark" benchmarkLFUDARand+ ]++testLFUDA :: Assertion+testLFUDA = do+ -- Create cache with proper policy+ let initialCache :: LfudaCache Int Int+ initialCache = newCache 666 LFUDA++ -- Track number of evictions using insertView+ let insertAndTrackEvictions :: (LfudaCache Int Int, Int) -> Int -> (LfudaCache Int Int, Int)+ insertAndTrackEvictions (cache, count) i =+ let (evictedEntry, cache') = insertView i i cache+ newCount = case evictedEntry of+ Just _ -> count + 1+ Nothing -> count+ in (cache', newCount)++ let finalCacheAndCount = foldl' insertAndTrackEvictions (initialCache, 0) [100..999 :: Int]+ finalCache = fst finalCacheAndCount+ evictionCount = snd finalCacheAndCount++ let len = size finalCache+ assertEqual "Cache length should match" 666 len++ let keys2 = keys finalCache+ assertEqual "Keys length should match cache length" len (length keys2)++ -- Check eviction count+ assertEqual "Eviction count should match" (234 :: Int) evictionCount++ -- Check values that should be in cache+ forM_ keys2 $ \k -> do+ let result = lookup k finalCache+ case result of+ Just (v, _) -> assertEqual "Value should match key" k v+ Nothing -> assertFailure $ "Key " ++ show k ++ " should be in cache"++ -- These should be misses (keys 100-333, since we inserted 900 items in a cache of size 666)+ forM_ [100..333 :: Int] $ \i -> do+ let result = lookup i finalCache+ assertBool ("Key " ++ show i ++ " should not be in cache") (isNothing result)++ -- Set a new value and check it+ let cacheWithNewVal = insert (256 :: Int) (256 :: Int) finalCache++ let result = lookup (256 :: Int) cacheWithNewVal+ case result of+ Just (v, _) -> assertEqual "Value for key 256 should be 256" (256 :: Int) v+ Nothing -> assertFailure "Key 256 should be in cache"++ -- Check most frequently used key after updating key 256+ let updatedCache = case result of+ Just (_, c') -> c'+ Nothing -> cacheWithNewVal++ let keysAfterUpdate = keys updatedCache+ assertBool "Keys should be present after update" (not (null keysAfterUpdate))++ -- Purge and verify empty+ let purgedCache = purge updatedCache+ let lenAfterPurge = size purgedCache+ assertEqual "Cache should be empty after purge" 0 lenAfterPurge++ let resultAfterPurge = lookup (200 :: Int) purgedCache+ assertBool "Cache should contain nothing after purge" (isNothing resultAfterPurge)++testGDSF :: Assertion+testGDSF = do+ let initialCache :: LfudaCache Int Int+ initialCache = newGDSF 666++ -- Insert elements with power of 2 values+ let cacheWith10to19 = foldl' (\cache i ->+ insert i (2 ^ i) cache+ ) initialCache [10..19 :: Int]++ -- Insert more elements with same key/value+ let finalCache = foldl' (\cache i ->+ insert i i cache+ ) cacheWith10to19 [100..999 :: Int]++ let len = size finalCache+ assertEqual "Cache length should match" 666 len++ let keys2 = keys finalCache+ assertEqual "Keys length should match cache length" len (length keys2)++ -- Check values that should be in cache+ forM_ keys2 $ \k -> do+ let result = lookup k finalCache+ assertBool "Get should return a result" (not (isNothing result))+ case result of+ Just (v, _) ->+ if k >= 10 && k <= 19+ then assertEqual "Value should be 2^key for keys 10-19" (2 ^ k) v+ else assertEqual "Value should match key for other keys" k v+ Nothing -> assertFailure $ "Key " ++ show k ++ " should be in cache"++ -- Set a new value and check it+ let cacheWithNewVal = insert (256 :: Int) (256 :: Int) finalCache++ let result = lookup (256 :: Int) cacheWithNewVal+ case result of+ Just (v, _) -> assertEqual "Value for key 256 should be 256" (256 :: Int) v+ Nothing -> assertFailure "Key 256 should be in cache"++ -- Check most frequently used key after updating key 256+ let updatedCache = case result of+ Just (_, c') -> c'+ Nothing -> cacheWithNewVal++ let keysAfterUpdate = keys updatedCache+ -- Key 256 should have higher frequency due to the get operation above+ assertBool "Keys should be present after update" (not (null keysAfterUpdate))++testInsertEviction :: Assertion+testInsertEviction = do+ let cache :: LfudaCache Int Int+ cache = newCache 1 LFUDA++ -- First insert should not evict+ let (evicted1, _) = insertView (1 :: Int) (1 :: Int) cache+ assertEqual "Should not have evicted" Nothing evicted1++ -- Second insert (different key) should evict+ let c1 = insert (1 :: Int) (1 :: Int) cache+ let (evicted2, _) = insertView (2 :: Int) (2 :: Int) c1+ assertBool "Should have evicted" (evicted2 /= Nothing)++testLFUDAContains :: Assertion+testLFUDAContains = do+ let initialCache :: LfudaCache Int Int+ initialCache = newCache 2 LFUDA++ let cache1 = insert (1 :: Int) (1 :: Int) initialCache+ let cache2 = insert (2 :: Int) (2 :: Int) cache1++ -- Bump hits for key 1+ let finalCache1 = foldl' (\c _ ->+ case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache2 [1..10 :: Int]++ let keys1 = keys finalCache1+ case keys1 of+ (k:_) -> assertEqual "Key 1 should be most frequently used" (1 :: Int) k+ [] -> assertFailure "Keys list should not be empty"++ -- Contains should not bump hits for key 2+ let finalCache2 = foldl' (\c _ -> c) finalCache1 (replicate 20 (contains (2 :: Int) finalCache1))++ let keys2 = keys finalCache2+ case keys2 of+ (k:_) -> assertEqual "Key 1 should still be most frequently used" (1 :: Int) k+ [] -> assertFailure "Keys list should not be empty"++testLFUDAPeek :: Assertion+testLFUDAPeek = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 2++ let cache1 = insert (1 :: Int) (1 :: Int) initialCache+ let cache2 = insert (2 :: Int) (2 :: Int) cache1++ -- Peek should not update frequency+ let result1 = peek (1 :: Int) cache2+ assertEqual "Value for key 1 should be 1" (Just 1) result1++ -- Increase frequency of key 2+ let cache2' = case lookup (2 :: Int) cache2 of+ Just (_, c) -> c+ Nothing -> cache2++ -- Adding key 3 should evict key 1 (lowest frequency)+ let cache3 = insert (3 :: Int) (3 :: Int) cache2'++ -- Key 1 should be evicted+ let containsKey1 = contains (1 :: Int) cache3+ assertBool "Key 1 should have been evicted" (not containsKey1)++testLFUDARemove :: Assertion+testLFUDARemove = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 2++ let cache1 = insert (1 :: Int) (1 :: Int) initialCache+ let cache2 = insert (2 :: Int) (2 :: Int) cache1++ let result1 = lookup (1 :: Int) cache2+ case result1 of+ Just (v, _) -> assertEqual "Value for key 1 should be 1" (1 :: Int) v+ Nothing -> assertFailure "Key 1 should be in cache"++ -- Remove key 1+ assertBool "Key 1 should be in cache before removal" (contains (1 :: Int) cache2)+ let cache2' = remove (1 :: Int) cache2++ let result1' = lookup (1 :: Int) cache2'+ assertBool "Key 1 should not be in cache after removal" (isNothing result1')++ let len = size cache2'+ assertEqual "Cache length should be 1 after removal" 1 len++testLFUDAAge :: Assertion+testLFUDAAge = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 1++ -- Set key 1 with initial frequency 1+ let cache1 = insert (1 :: Int) (1 :: Int) initialCache++ -- Bump hits on key 1 to frequency 2+ let cache1' = case lookup (1 :: Int) cache1 of+ Just (_, c) -> c+ Nothing -> cache1++ -- Set key 2 - but key 2 will be immediately evicted because+ -- it has lower priority (1) than key 1 (2)+ let cache2 = insert (2 :: Int) (2 :: Int) cache1'++ -- The age should now be 1 (the frequency of the evicted key 2)+ let age1 = age cache2+ assertEqual "Cache age should be 1" 1 age1++testLFUDASize :: Assertion+testLFUDASize = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 10++ -- Insert elements+ let finalCache = foldl' (\cache i ->+ insert i i cache+ ) initialCache [10..29 :: Int]++ -- Check size+ let s = size finalCache+ assertEqual "Cache size should be 10" 10 s++ -- Purge and check size again+ let purgedCache = purge finalCache+ let s' = size purgedCache+ assertEqual "Cache size should be 0 after purge" 0 s'++-- Edge Case Tests++-- Re-inserting a key resets its frequency to 1, making it vulnerable to eviction+testReinsertResetsFrequency :: Assertion+testReinsertResetsFrequency = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 2++ -- Insert keys 1 and 2+ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = insert (2 :: Int) (20 :: Int) c1++ -- Lookup key 1 many times to build up its frequency+ let c3 = foldl' (\c _ -> case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) c2 [1..10 :: Int]++ -- Key 1 now has high frequency. Re-insert it with new value - resets freq to 1!+ let c4 = insert (1 :: Int) (100 :: Int) c3++ -- Verify the value was updated+ assertEqual "Value should be updated to 100" (Just 100) (peek (1 :: Int) c4)++ -- Now insert key 3. Key 1 has freq 1 again, key 2 also has freq 1.+ -- One of them gets evicted.+ let c5 = insert (3 :: Int) (30 :: Int) c4+ assertEqual "Size should be 2" 2 (size c5)++-- Capacity 1 cache: every new distinct key causes eviction+testCapacity1 :: Assertion+testCapacity1 = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 1++ -- First insert: no eviction+ let (ev1, _) = insertView (1 :: Int) (10 :: Int) cache+ let c1 = insert (1 :: Int) (10 :: Int) cache+ assertEqual "First insert should not evict" Nothing ev1+ assertEqual "Size should be 1" 1 (size c1)++ -- Same key: replaces value, no eviction (size stays 1)+ let (ev2, c2) = insertView (1 :: Int) (20 :: Int) c1+ assertEqual "Re-insert same key should not evict" Nothing ev2+ assertEqual "Size should still be 1" 1 (size c2)+ assertEqual "Value should be updated" (Just 20) (peek (1 :: Int) c2)++ -- Different key: must evict+ let (ev3, c3) = insertView (2 :: Int) (30 :: Int) c2+ assertBool "Different key should evict" (ev3 /= Nothing)+ assertEqual "Size should still be 1" 1 (size c3)+ assertBool "Key 1 should be gone" (not (contains (1 :: Int) c3))+ assertEqual "Key 2 should be present" (Just 30) (peek (2 :: Int) c3)++ -- Lookup on evicted key+ let result = lookup (1 :: Int) c3+ assertBool "Lookup evicted key should return Nothing" (isNothing result)++-- Size must always match the actual number of entries in the queue+testSizeConsistency :: Assertion+testSizeConsistency = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 3++ -- Empty cache+ assertEqual "Empty cache size" 0 (size cache)++ -- Insert 3+ let c1 = insert (1 :: Int) (10 :: Int) cache+ assertEqual "After 1 insert" 1 (size c1)+ let c2 = insert (2 :: Int) (20 :: Int) c1+ let c3 = insert (3 :: Int) (30 :: Int) c2+ assertEqual "After 3 inserts" 3 (size c3)++ -- Remove 1+ let c4 = remove (1 :: Int) c3+ assertEqual "After remove" 2 (size c4)+ assertEqual "Keys count matches size" (size c4) (length (keys c4))++ -- Re-insert key 1 (no eviction, room available)+ let (ev, c5) = insertView (1 :: Int) (100 :: Int) c4+ assertEqual "Should not evict (room available)" Nothing ev+ assertEqual "After re-insert" 3 (size c5)++ -- Re-insert existing key 2 (replace, no size change)+ let c6 = insert (2 :: Int) (200 :: Int) c5+ assertEqual "After replace" 3 (size c6)+ assertEqual "Keys count matches size" (size c6) (length (keys c6))++ -- Insert 4th key to force eviction+ let (ev2, c7) = insertView (4 :: Int) (40 :: Int) c6+ assertBool "Should evict" (ev2 /= Nothing)+ assertEqual "After eviction" 3 (size c7)+ assertEqual "Keys count matches size" (size c7) (length (keys c7))++ -- Purge+ let c8 = purge c7+ assertEqual "After purge" 0 (size c8)+ assertEqual "Keys empty after purge" 0 (length (keys c8))++ -- Insert after purge+ let c9 = insert (5 :: Int) (50 :: Int) c8+ assertEqual "After insert post-purge" 1 (size c9)++-- Purge clears entries but does NOT reset age+testPurgePreservesAge :: Assertion+testPurgePreservesAge = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 1++ let c1 = insert (1 :: Int) (10 :: Int) cache+ -- Bump frequency to 3+ let c2 = foldl' (\c _ -> case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) c1 [1..2 :: Int]++ -- Evict key 1 by inserting key 2+ let c3 = insert (2 :: Int) (20 :: Int) c2+ let ageBeforePurge = age c3+ assertBool "Age should be > 0 after eviction" (ageBeforePurge > 0)++ -- Purge+ let c4 = purge c3+ assertEqual "Age should survive purge" ageBeforePurge (age c4)+ assertEqual "Size should be 0" 0 (size c4)++-- Cache should work normally after purge+testOpsAfterPurge :: Assertion+testOpsAfterPurge = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 2++ -- Fill cache, then purge+ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = insert (2 :: Int) (20 :: Int) c1+ let c3 = purge c2++ -- All operations should work on purged cache+ assertBool "Contains on purged cache" (not (contains (1 :: Int) c3))+ assertEqual "Peek on purged cache" Nothing (peek (1 :: Int) c3)+ assertBool "Lookup on purged cache" (isNothing (lookup (1 :: Int) c3))+ assertEqual "Keys on purged cache" [] (keys c3)++ -- Insert should work+ let (ev1, c4) = insertView (3 :: Int) (30 :: Int) c3+ assertEqual "Should not evict (empty after purge)" Nothing ev1+ assertEqual "Value accessible" (Just 30) (peek (3 :: Int) c4)+ let (ev2, c5) = insertView (4 :: Int) (40 :: Int) c4+ assertEqual "Should not evict (still room)" Nothing ev2+ assertEqual "Size should be 2" 2 (size c5)++ -- Eviction should work after purge+ let (ev3, c6) = insertView (5 :: Int) (50 :: Int) c5+ assertBool "Should evict now (full)" (ev3 /= Nothing)+ assertEqual "Size still 2" 2 (size c6)++-- insertView on an existing key should NOT report eviction+testInsertViewSelfReplace :: Assertion+testInsertViewSelfReplace = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 2++ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = insert (2 :: Int) (20 :: Int) c1++ -- insertView same key: no eviction, just replacement+ let (evicted, c3) = insertView (1 :: Int) (100 :: Int) c2+ assertEqual "Should not report eviction for self-replace" Nothing evicted+ assertEqual "Value should be updated" (Just 100) (peek (1 :: Int) c3)+ assertEqual "Size should be unchanged" 2 (size c3)++ -- insertView on capacity-1 cache, same key+ let cache1 :: LfudaCache Int Int+ cache1 = newLFUDA 1+ let c4 = insert (1 :: Int) (10 :: Int) cache1+ let (evicted2, c5) = insertView (1 :: Int) (100 :: Int) c4+ assertEqual "No eviction for self-replace on cap-1" Nothing evicted2+ assertEqual "Size should be 1" 1 (size c5)++-- insertView reports the correct evicted entry+testInsertViewEvictsCorrect :: Assertion+testInsertViewEvictsCorrect = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 1++ let c1 = insert (1 :: Int) (10 :: Int) cache++ -- Insert key 2, should evict key 1 and report it+ let (evicted, c2) = insertView (2 :: Int) (20 :: Int) c1+ assertEqual "Should report key 1 evicted" (Just (1 :: Int, 10 :: Int)) evicted+ assertEqual "Size should be 1" 1 (size c2)++ -- Bump key 2 frequency, then insert key 3+ let c3 = case lookup (2 :: Int) c2 of+ Just (_, c) -> c+ Nothing -> c2+ let (evicted2, _) = insertView (3 :: Int) (30 :: Int) c3+ -- Key 3 has freq 1, key 2 has freq 2, so key 3 gets evicted+ assertEqual "Should report key 3 evicted (lower freq)" (Just (3 :: Int, 30 :: Int)) evicted2++-- Remove on empty cache and nonexistent keys+testRemoveNonexistent :: Assertion+testRemoveNonexistent = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 5++ -- Remove from empty cache+ let c1 = remove (1 :: Int) cache+ assertEqual "Size should still be 0" 0 (size c1)++ -- Insert then remove nonexistent+ let c2 = insert (1 :: Int) (10 :: Int) c1+ assertBool "Key 999 should not be in cache" (not (contains (999 :: Int) c2))+ let c3 = remove (999 :: Int) c2+ assertEqual "Size should still be 1" 1 (size c3)++ -- Remove then remove same key again+ assertBool "Key 1 should be in cache" (contains (1 :: Int) c3)+ let c4 = remove (1 :: Int) c3+ assertBool "Key 1 should be gone after removal" (not (contains (1 :: Int) c4))+ let c5 = remove (1 :: Int) c4+ assertEqual "Size should be 0" 0 (size c5)++-- When all entries have the same frequency, eviction should still work+testEqualFrequencyEviction :: Assertion+testEqualFrequencyEviction = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 3++ -- Insert 3 entries, all with frequency 1+ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = insert (2 :: Int) (20 :: Int) c1+ let c3 = insert (3 :: Int) (30 :: Int) c2++ -- Insert 4th, must evict one (all have same freq)+ let (ev, c4) = insertView (4 :: Int) (40 :: Int) c3+ assertBool "Must evict something" (ev /= Nothing)+ assertEqual "Size must be 3" 3 (size c4)+ assertEqual "Keys count must be 3" 3 (length (keys c4))++ -- All remaining keys should be accessible+ let remainingKeys = keys c4+ forM_ remainingKeys $ \k ->+ assertBool ("Key " ++ show k ++ " should be accessible") (contains k c4)++-- LFUDA age should grow over multiple eviction cycles+testAgeAccumulation :: Assertion+testAgeAccumulation = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 1++ assertEqual "Initial age" 0 (age cache)++ -- Round 1: insert key 1, bump freq to 3, evict with key 2+ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = foldl' (\c _ -> case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) c1 [1..2 :: Int]+ -- key 1 has freq 3+ let c3 = insert (2 :: Int) (20 :: Int) c2+ -- key 2 (freq 1) was evicted, age should be 1+ let age1 = age c3+ assertEqual "Age after first eviction cycle" 1 age1++ -- Round 2: bump key 1 freq more, evict again+ let c4 = foldl' (\c _ -> case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) c3 [1..3 :: Int]+ -- key 1 now has freq 6+ let c5 = insert (3 :: Int) (30 :: Int) c4+ -- key 3 (freq 1) evicted, but its priority was 1 + age1 = 2+ -- age should be set to the evicted entry's frequency (1), NOT the priority+ let age2 = age c5+ assertEqual "Age after second eviction cycle" 1 age2++ -- Round 3: create a scenario where an entry with freq > 1 gets evicted.+ -- Use a size-2 cache for this.+ let cache2 :: LfudaCache Int Int+ cache2 = newLFUDA 2++ let d1 = insert (10 :: Int) (100 :: Int) cache2+ let d2 = insert (20 :: Int) (200 :: Int) d1+ -- Bump key 20 freq to 3+ let d3 = foldl' (\c _ -> case lookup (20 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) d2 [1..2 :: Int]+ -- key 10 has freq 1, key 20 has freq 3+ -- Insert key 30: evicts key 10 (freq 1), age becomes 1+ let d4 = insert (30 :: Int) (300 :: Int) d3+ assertEqual "Age after evicting freq-1 entry" 1 (age d4)++ -- Now bump key 30 freq to 4+ let d5 = foldl' (\c _ -> case lookup (30 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) d4 [1..3 :: Int]+ -- key 20 has freq 3, stale priority = 3 (set when age was 0, never recalculated)+ -- key 30 has freq 4, priority = 4 + 1 = 5 (recalculated on each lookup)+ -- Insert key 40: priority = 1 + age(1) = 2+ -- Eviction order by priority: key 40 (2) < key 20 (3) < key 30 (5)+ -- key 40 gets evicted immediately (lowest priority), age = freq(40) = 1+ let d6 = insert (40 :: Int) (400 :: Int) d5+ assertEqual "Age stays 1 (key 40 evicted, not key 20)" 1 (age d6)++ -- To actually evict a high-freq entry, we need to lookup key 20 first+ -- to refresh its priority with the current age+ let d7 = case lookup (20 :: Int) d6 of+ Just (_, c') -> c' -- key 20 freq becomes 4, priority = 4 + 1 = 5+ Nothing -> d6+ -- key 20 now has freq 4, priority 5. key 30 has freq 4, priority 5.+ -- Insert key 50: priority = 1 + 1 = 2. Still lowest, key 50 evicted.+ let d8 = insert (50 :: Int) (500 :: Int) d7+ assertEqual "Age still 1 (new entry evicted again)" 1 (age d8)++-- After re-inserting a key, lookup should return the new value+-- but with reset frequency (making it vulnerable to eviction)+testLookupAfterReinsert :: Assertion+testLookupAfterReinsert = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 2++ let c1 = insert (1 :: Int) (10 :: Int) cache+ let c2 = insert (2 :: Int) (20 :: Int) c1++ -- Bump key 1 frequency high+ let c3 = foldl' (\c _ -> case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) c2 [1..5 :: Int]++ -- Re-insert key 1 with new value (resets freq to 1!)+ let c4 = insert (1 :: Int) (999 :: Int) c3++ -- Lookup should return new value+ case lookup (1 :: Int) c4 of+ Just (v, _) -> assertEqual "Should get new value" (999 :: Int) v+ Nothing -> assertFailure "Key 1 should be in cache"++ -- But now key 1 has low freq again.+ -- Bump key 2 freq so key 1 becomes eviction target+ let c5 = case lookup (2 :: Int) c4 of+ Just (_, c') -> c'+ Nothing -> c4++ -- Insert key 3: should evict key 1 (lowest freq after re-insert)+ let c6 = insert (3 :: Int) (30 :: Int) c5+ assertBool "Key 1 should be evicted (freq was reset)" (not (contains (1 :: Int) c6))+ assertBool "Key 2 should survive" (contains (2 :: Int) c6)++-- Rapid insert-remove cycles should keep size correct+testInsertRemoveCycles :: Assertion+testInsertRemoveCycles = do+ let cache :: LfudaCache Int Int+ cache = newLFUDA 5++ -- Insert and remove 100 keys rapidly+ let finalCache = foldl' (\c i ->+ let c1 = insert i i c+ c2 = remove i c1+ in c2+ ) cache [1..100 :: Int]++ assertEqual "Size should be 0 after insert-remove cycles" 0 (size finalCache)+ assertEqual "Keys should be empty" [] (keys finalCache)++ -- Insert-remove with some surviving (use capacity 10 to avoid eviction interference)+ let cache10 :: LfudaCache Int Int+ cache10 = newLFUDA 10+ let finalCache2 = foldl' (\c i ->+ let c1 = insert i i c+ in if even i+ then remove i c1+ else c1+ ) cache10 [1..10 :: Int]++ assertEqual "Size should be 5 (odd keys survive)" 5 (size finalCache2)+ forM_ [1, 3, 5, 7, 9 :: Int] $ \i ->+ assertBool ("Key " ++ show i ++ " should be present") (contains i finalCache2)+ forM_ [2, 4, 6, 8, 10 :: Int] $ \i ->+ assertBool ("Key " ++ show i ++ " should be absent") (not (contains i finalCache2))++ -- Verify that with tight capacity, eviction CAN steal surviving entries+ -- Capacity 5, insert keys 1-10, keep odd, remove even.+ -- At i=10, cache has [1,3,5,7,9] (full), inserting 10 evicts an odd key first!+ let finalCache3 = foldl' (\c i ->+ let c1 = insert i i c+ in if even i+ then remove i c1+ else c1+ ) cache [1..10 :: Int]++ assertEqual "Size should be 4 (one odd key was evicted by insert 10)" 4 (size finalCache3)++-- LFU Tests++testLFU :: Assertion+testLFU = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFU 5++ -- Insert 5 elements+ let cache1 = foldl' (\c i -> insert i (i * 10) c) initialCache [1..5 :: Int]+ assertEqual "Cache size should be 5" 5 (size cache1)++ -- All 5 elements should be present+ forM_ [1..5 :: Int] $ \i -> do+ let result = peek i cache1+ assertEqual ("Value for key " ++ show i) (Just (i * 10)) result++ -- Insert 6th element, should evict one+ let (evicted6, cache2) = insertView (6 :: Int) (60 :: Int) cache1+ assertBool "Should have evicted" (evicted6 /= Nothing)+ assertEqual "Cache size should still be 5" 5 (size cache2)++ -- Key 6 should be present+ let result6 = peek (6 :: Int) cache2+ assertEqual "Key 6 should be present" (Just 60) result6++testLFUNoAging :: Assertion+testLFUNoAging = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFU 1++ -- Insert key 1, then bump its frequency+ let cache1 = insert (1 :: Int) (10 :: Int) initialCache+ let cache1' = case lookup (1 :: Int) cache1 of+ Just (_, c) -> c+ Nothing -> cache1++ -- Age should be 0 before any eviction+ assertEqual "Age should be 0 initially" 0 (age cache1')++ -- Insert key 2, which evicts key 2 (lower priority) since key 1 has freq 2+ let cache2 = insert (2 :: Int) (20 :: Int) cache1'++ -- Age should STILL be 0 for LFU (no dynamic aging)+ assertEqual "Age should remain 0 for LFU" 0 (age cache2)++ -- Key 1 should survive (higher frequency)+ assertBool "Key 1 should still be in cache" (contains (1 :: Int) cache2)++testLFUFrequencyEviction :: Assertion+testLFUFrequencyEviction = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFU 3++ -- Insert 3 elements+ let cache1 = insert (1 :: Int) (10 :: Int) initialCache+ let cache2 = insert (2 :: Int) (20 :: Int) cache1+ let cache3 = insert (3 :: Int) (30 :: Int) cache2++ -- Bump frequency of key 1 (3 extra lookups -> freq 4)+ let cache3' = foldl' (\c _ ->+ case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache3 [1..3 :: Int]++ -- Bump frequency of key 3 (1 extra lookup -> freq 2)+ let cache3'' = case lookup (3 :: Int) cache3' of+ Just (_, c) -> c+ Nothing -> cache3'++ -- Key 2 still has freq 1 (lowest), so inserting key 4 should evict key 2+ let cache4 = insert (4 :: Int) (40 :: Int) cache3''++ -- Key 2 should be gone (lowest frequency)+ assertBool "Key 2 should be evicted" (not (contains (2 :: Int) cache4))++ -- Keys 1 and 3 should still be present+ assertBool "Key 1 should survive" (contains (1 :: Int) cache4)+ assertBool "Key 3 should survive" (contains (3 :: Int) cache4)++ -- Key 4 should be present+ assertBool "Key 4 should be present" (contains (4 :: Int) cache4)++testLFUInsertView :: Assertion+testLFUInsertView = do+ let cache :: LfudaCache Int Int+ cache = newLFU 2++ -- First insert returns Nothing (no eviction)+ let (evicted1, cache1) = insertView (1 :: Int) (10 :: Int) cache+ assertEqual "No eviction on first insert" Nothing evicted1++ -- Second insert returns Nothing (still room)+ let (evicted2, cache2) = insertView (2 :: Int) (20 :: Int) cache1+ assertEqual "No eviction on second insert" Nothing evicted2++ -- Third insert should evict the lowest frequency entry+ let (evicted3, cache3) = insertView (3 :: Int) (30 :: Int) cache2+ assertBool "Should have evicted something" (evicted3 /= Nothing)+ assertEqual "Cache size should be 2" 2 (size cache3)++-- GDSF Tests++testGDSFSizeEviction :: Assertion+testGDSFSizeEviction = do+ -- GDSF priority = frequency + age * size+ -- All new entries have frequency 1 and size 1, so initially priority = 1 + 0*1 = 1+ -- After eviction, age increases, making new entries have higher priority+ let initialCache :: LfudaCache Int Int+ initialCache = newGDSF 2++ let cache1 = insert (1 :: Int) (10 :: Int) initialCache+ let cache2 = insert (2 :: Int) (20 :: Int) cache1++ -- Bump key 1 frequency to 2+ let cache2' = case lookup (1 :: Int) cache2 of+ Just (_, c) -> c+ Nothing -> cache2++ -- Insert key 3, should evict key 2 (freq 1 < key 1's freq 2)+ let cache3 = insert (3 :: Int) (30 :: Int) cache2'+ assertBool "Key 2 should be evicted" (not (contains (2 :: Int) cache3))+ assertBool "Key 1 should survive" (contains (1 :: Int) cache3)++testGDSFAging :: Assertion+testGDSFAging = do+ let initialCache :: LfudaCache Int Int+ initialCache = newGDSF 1++ -- Insert key 1, bump frequency to 3+ let cache1 = insert (1 :: Int) (10 :: Int) initialCache+ let cache1' = foldl' (\c _ ->+ case lookup (1 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache1 [1..2 :: Int]++ assertEqual "Age should be 0 before eviction" 0 (age cache1')++ -- Insert key 2, it will be evicted (freq 1 < key 1's freq 3)+ let cache2 = insert (2 :: Int) (20 :: Int) cache1'++ -- Age should now be 1 (frequency of the evicted key)+ assertEqual "Age should be 1 after eviction" 1 (age cache2)+ assertBool "Key 1 should survive" (contains (1 :: Int) cache2)++testGDSFFrequencyAndSize :: Assertion+testGDSFFrequencyAndSize = do+ -- Test that GDSF uses both frequency and age*size in priority+ let initialCache :: LfudaCache Int Int+ initialCache = newGDSF 3++ -- Insert 3 entries+ let cache1 = insert (1 :: Int) (10 :: Int) initialCache+ let cache2 = insert (2 :: Int) (20 :: Int) cache1+ let cache3 = insert (3 :: Int) (30 :: Int) cache2++ -- Bump key 2's frequency to 3+ let cache3' = foldl' (\c _ ->+ case lookup (2 :: Int) c of+ Just (_, c') -> c'+ Nothing -> c+ ) cache3 [1..2 :: Int]++ -- Bump key 3's frequency to 2+ let cache3'' = case lookup (3 :: Int) cache3' of+ Just (_, c) -> c+ Nothing -> cache3'++ -- Key 1 has freq 1, Key 2 has freq 3, Key 3 has freq 2+ -- Insert key 4, should evict key 1 (lowest frequency)+ let cache4 = insert (4 :: Int) (40 :: Int) cache3''+ assertBool "Key 1 should be evicted (lowest freq)" (not (contains (1 :: Int) cache4))+ assertBool "Key 2 should survive" (contains (2 :: Int) cache4)+ assertBool "Key 3 should survive" (contains (3 :: Int) cache4)+ assertBool "Key 4 should be present" (contains (4 :: Int) cache4)++ -- Verify age was updated after eviction+ let ageAfter = age cache4+ assertBool "Age should have increased" (ageAfter > 0)++-- Pure implementation of random number generation for testing+type SimpleRandom :: Type+data SimpleRandom :: Type where+ SimpleRandom :: Int -> SimpleRandom++nextRandom :: SimpleRandom -> (Int, SimpleRandom)+nextRandom (SimpleRandom seed) =+ let newSeed = (seed * 1103515245 + 12345) `mod` 2147483647+ value = newSeed `mod` 32768+ in (value, SimpleRandom newSeed)++rangeRandom :: Int -> Int -> SimpleRandom -> (Int, SimpleRandom)+rangeRandom low high rand =+ let (val, rand') = nextRandom rand+ scaled = low + (val `mod` (high - low + 1))+ in (scaled, rand')++generateTrace :: Int -> SimpleRandom -> ([Int], SimpleRandom)+generateTrace n rand =+ go n rand []+ where+ go :: Int -> SimpleRandom -> [Int] -> ([Int], SimpleRandom)+ go 0 r acc = (reverse acc, r)+ go i r acc =+ let evenOdd = i `mod` 2 == 0+ (val, r') = if evenOdd+ then rangeRandom 0 16383 r+ else rangeRandom 0 32767 r+ in go (i-1) r' (val:acc)++-- Benchmark tests (simplified versions for HUnit)+testBenchmark :: String -> Assertion -> TestTree+testBenchmark name benchmark = testCase name benchmark++benchmarkLFUDA :: Assertion+benchmarkLFUDA = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 1000 -- Smaller cache size to ensure evictions++ -- Generate deterministic random trace+ let traceSeed = SimpleRandom 42+ (trace, _) = generateTrace 2000 traceSeed++ -- Split the trace: first half for setting, second half for getting+ let setTrace = take 1000 trace+ queryTrace = drop 1000 trace++ -- Set operations+ let cacheAfterSet = foldl' (\cache i ->+ insert i i cache+ ) initialCache setTrace++ -- Get operations and count hits/misses+ let hitsAndMisses = foldl' (\(h, m) i ->+ case lookup i cacheAfterSet of+ Just _ -> (h + 1, m)+ Nothing -> (h, m + 1)+ ) (0 :: Int, 0 :: Int) queryTrace+ hits = fst hitsAndMisses+ misses = snd hitsAndMisses++ -- With our cache size of 1000 and different query items,+ -- we should have both hits and misses+ assertBool "Should have some hits" (hits > (0 :: Int))+ assertBool "Should have some misses" (misses > (0 :: Int))++benchmarkLFUDARand :: Assertion+benchmarkLFUDARand = do+ let initialCache :: LfudaCache Int Int+ initialCache = newLFUDA 1000 -- Smaller cache size to ensure evictions++ -- Generate deterministic random trace+ let traceSeed = SimpleRandom 24+ (trace, _) = generateTrace 2000 traceSeed++ -- Process the trace in a pure way+ let processItem :: (LfudaCache Int Int, Int, Int) -> (Int, Int) -> (LfudaCache Int Int, Int, Int)+ processItem (cache, h, m) (idx, val) =+ -- Set on even indices+ let cache' = if even idx+ then insert val val cache+ else cache++ -- Check get result+ getResult = lookup val cache'+ h' = case getResult of { Just _ -> h + 1; Nothing -> h }+ m' = case getResult of { Just _ -> m; Nothing -> m + 1 }++ -- Extra hits/misses for idx mod 7 = 0+ extras =+ if idx `mod` 7 == 0+ then foldl' (\(eh, em) _ ->+ if contains val cache'+ then (eh + 1, em)+ else (eh, em + 1)+ ) (0 :: Int, 0 :: Int) [1..19 :: Int]+ else (0, 0)++ -- Update cache if we got a hit+ cache'' = case getResult of+ Just (_, c) -> c+ Nothing -> cache'++ in (cache'', h' + fst extras, m' + snd extras)++ let fullResult = foldl' processItem (initialCache, 0 :: Int, 0 :: Int) (zip [0 :: Int ..] trace)++ -- Check results+ case fullResult of+ (_, hits, misses) -> do+ assertBool "Should have some hits" (hits > (0 :: Int))+ assertBool "Should have some misses" (misses > (0 :: Int))