data-findcycle 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+149/−22 lines, 5 filesdep +arraydep +mtldep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: array, mtl, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• bench/Main.hs +4/−0
• data-findcycle.cabal +8/−2
• src/Data/FindCycle.hs +127/−19
• test/Main.hs +4/−1

@@ -1,5 +1,11 @@ # Revision history for data-findcycle +## 0.1.1.0 -- 2025-04-24++* Add `nivashPart` and `nivashPartWithinBounds` as variants of `nivash` using+  stack partitioning.+* Minor documentation fixes and improvements.+ ## 0.1.0.0 -- 2025-03-08  * First version. Released on an unsuspecting world.

@@ -3,11 +3,13 @@ {-# LANGUAGE RecordWildCards #-}  import Control.DeepSeq+import Data.Bits ((.&.)) import Data.FindCycle import Data.Foldable (find) import Data.List (intercalate) import Data.Maybe import Data.Numbers.Primes+import Data.Word import GHC.Generics import Test.Tasty.Bench import Test.Tasty.Patterns.Printer@@ -87,6 +89,8 @@     [ ("brent", brent)     , ("floyd", floyd)     , ("nivash", nivash)+    , ("nivashPart", nivashPart (fromIntegral :: Int -> Word8))+    , ("nivashPartWithinBounds", nivashPartWithinBounds (0, 0xff) (.&. 0xff))     , ("naiveHashable", naiveHashable)     , ("naiveOrd", naiveOrd)     ]

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               data-findcycle-version:            0.1.0.0+version:            0.1.1.0 synopsis:           Find cycles in periodic functions (and lists) description:   Any function @f :: a -> a@ where the type @a@ has finitely many values@@ -29,7 +29,13 @@         base >= 4.7 && < 4.23,         containers >= 0.5 && < 0.9,         hashable >= 1.2 && < 1.6,-        unordered-containers >= 0.2 && < 0.3+        unordered-containers >= 0.2 && < 0.3,+        mtl >= 2.1 && < 2.4,+        array >= 0.5 && < 0.6+    -- Data.Functor.Identity used to be in transformers instead of base.+    if impl(ghc<7.10.1)+        build-depends:+            transformers >= 0.3 && < 0.5     hs-source-dirs:   src     default-language: Haskell2010     ghc-options: -Wall

@@ -1,5 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}  {- |   Module: Data.FindCycle@@ -108,6 +115,8 @@      -- ** Memory/Time Compromise     nivash,+    nivashPart,+    nivashPartWithinBounds,      -- * Running algorithms     findCycle,@@ -121,13 +130,21 @@ ) where  import Control.Applicative ((<*>), (<|>))+import Control.Monad.ST+import qualified Data.Array.ST as A import Data.Functor ((<$), (<$>))+import Data.Functor.Identity import qualified Data.HashMap.Strict as HM import Data.Hashable (Hashable) import qualified Data.Map.Strict as M import Data.Maybe (fromJust, fromMaybe)-import Prelude hiding ((<$), (<$>), (<*>))+import Data.Traversable (traverse)+import Prelude hiding (traverse, (<$), (<$>), (<*>)) +#if __GLASGOW_HASKELL__ >= 800+import Data.Kind (Type)+#endif+ data Input s a = Input     { inpUncons :: s -> Maybe (a, s)     , inpAdvance :: Int -> s -> s@@ -253,14 +270,16 @@   The lazy list might also be evaluated further than \(\mu + \lambda\)   depending on the cycle finding algorithm chosen ('brent', 'floyd'). -  >>> f x = x^42 `mod` 1000003 -- cycle (1, 83333)+  >>> -- cycle μ=1, λ=83333 when starting from 23+  >>> let f :: Integer -> Integer; f x = x^(42 :: Int) `mod` 1000003+  >>>   >>> g = cycleExp nivash f 23   >>> g 0 -- after 0 iterations-  > 23+  23   >>> -- after a googol iterations, but finishes in less than the current   >>> -- age of the universe-  >>> g (10^100)-  > 671872+  >>> g (10^(100 :: Int))+  671872 -} cycleExp :: CycleFinder a -> (a -> a) -> a -> Integer -> a cycleExp alg f x = cycleExpWith alg listInput (iterate f x)@@ -322,21 +341,56 @@ brent :: (Eq a) => CycleFinder a brent = CycleFinder brent' +#if __GLASGOW_HASKELL__ < 800+#define Type *+#endif++class NivashSt st m where+    type State st m a :: Type+    newSt :: st a -> m (State st m a)+    checkSt :: (Ord a) => st a -> a -> Int -> State st m a -> m (Either Int (State st m a))++#undef Type++data NivashStack a = NivashStack++instance (Monad m) => NivashSt NivashStack m where+    type State NivashStack m a = [(a, Int)]+    newSt _ = return []+    {-# INLINE checkSt #-}+    checkSt _ x i xs+        | (sx, si) : _ <- xs', sx == x = return (Left si)+        | otherwise = return . Right $ (x, i) : xs'+      where+        xs' = dropWhile ((> x) . fst) xs++data NivashMultiStack st k a = NivashMultiStack+    { partBounds :: (k, k)+    , partF :: a -> k+    , partDelegate :: st a+    }++instance (A.Ix k, NivashSt st (ST s)) => NivashSt (NivashMultiStack st k) (ST s) where+    type State (NivashMultiStack st k) (ST s) a = A.STArray s k (State st (ST s) a)+    newSt NivashMultiStack{..} = newSt partDelegate >>= A.newArray partBounds+    {-# INLINE checkSt #-}+    checkSt NivashMultiStack{..} x i stacks =+        A.readArray stacks k+            >>= checkSt partDelegate x i+            >>= traverse ((stacks <$) . A.writeArray stacks k)+      where+        k = partF x+ {-# INLINE nivash' #-}--- TODO: add a variant with stack partitioning, probably requiring a partitioning---       function as an extra argument. this version can use (const 0).-nivash' :: (Ord a) => Input s a -> s -> (Int, Int)-nivash' Input{..} = go 0 []+nivash' :: (Ord a, NivashSt st m, Monad m) => st a -> Input s a -> s -> m (Int, Int)+nivash' stack Input{..} = (newSt stack >>=) . flip (go 0)   where-    go i stack = maybe (i, 0) (uncurry go') . inpUncons+    go i st = maybe (return (i, 0)) (uncurry go') . inpUncons       where-        go' x s-            | (sx, si) : _ <- stack', sx == x = (si, i - si)-            | otherwise = go (i + 1) ((x, i) : stack') s-          where-            stack' = dropWhile ((> x) . fst) stack---- TODO: Gosper? maybe not really that useful in practice.+        go' x s =+            checkSt stack x i st >>= \case+                Left si -> return (si, i - si)+                Right st' -> go (i + 1) st' s  {- |   Nivash's cycle finding algorithm.@@ -353,8 +407,61 @@   * [G. Nivasch, "Cycle detection using a stack", Information Processing Letters 90/3, pp. 135-140, 2004.](https://drive.google.com/file/d/16H_lrjeaBJqWvcn07C_w-6VNHldJ-ZZl/view) -} nivash :: (Ord a) => CycleFinder a-nivash = CycleFinder nivash'+nivash = CycleFinder $ (runIdentity .) . nivash' NivashStack +{- $+  >>> :seti -XDataKinds -XTypeApplications -XFlexibleContexts+-}++{- |+  Like 'nivash', but uses multiple independent stacks as determined by a partitioning+  function.++  This trades off some additional memory usage for the ability to detect cycles earlier+  in the sequence.++  Using \(k\) stacks, the cycle will be identified after, on average, a fraction of+  \(\dfrac{1}{k+1}\) of the cycle length. E.g 50% above the absolute minimum achievable+  for \(k=1\) ('nivash' without partitioning), or 1% above that minimum for \(k=99\).++  The entire range of @k@ will be used for partitioning, with each value from 'minBound'+  to 'maxBound' having its own partition. Use a type appropriate for the number of+  partitions you'd like to use. Use 'nivashPartWithinBounds' if you'd like to explicitly+  use a continuous subrange of @k@ instead.++  >>> import Data.Word (Word8)+  >>> let alg256 = nivashPart (fromIntegral :: Integer -> Word8)++  >>> import Data.Finite (modulo) -- >= 0.2 for the Ix instance+  >>> let alg100 = nivashPart (modulo @100)+-}+nivashPart :: (A.Ix k, Bounded k, Ord a) => (a -> k) -> CycleFinder a+nivashPart = nivashPartWithinBounds (minBound, maxBound)++{- |+  Like 'nivashPart', but allows for a specific continuous subrange of @k@ to be used for+  partitioning rather than creating a partition for each possible value of @k@.++  >>> let alg100 = nivashPartWithinBounds (0, 99) (`mod` 100)+-}+nivashPartWithinBounds ::+    forall k a.+    (A.Ix k, Ord a) =>+    {- |+      the lower and upper bound (inclusive), respectively, of the partition keys+      returned by the partition function+    -}+    (k, k) ->+    {- |+      the partition function. Returning values outside of the specified bounds will+      cause run-time errors.+    -}+    (a -> k) ->+    CycleFinder a+nivashPartWithinBounds bounds f = CycleFinder $ \inp s ->+    runST $ nivash' (NivashMultiStack bounds f NivashStack) inp s++-- TODO: Gosper? maybe not really that useful in practice. -- TODO: Sedgewick, Szymanski, Yao  {-# INLINE floyd' #-}@@ -396,9 +503,10 @@   if you're running the t'CycleFinder' using any of the functions which cache   the sequence of values (any but 'findCycle' and 'cycleExp''). -}-minimalMu :: (Eq a) => CycleFinder a -> CycleFinder a+minimalMu :: forall a. (Eq a) => CycleFinder a -> CycleFinder a minimalMu alg = CycleFinder go   where+    go :: forall s. Input s a -> s -> (Int, Int)     go inp@Input{..} s = maybeFindMu (runCycleFinder alg inp s)       where         maybeFindMu r@(_, lambda)

@@ -7,6 +7,7 @@ import Data.Functor ((<$>)) import Data.Maybe import Data.Numbers.Primes+import Data.Word import Test.Tasty import Test.Tasty.QuickCheck import Prelude hiding (Foldable, foldMap, (<$>), (<*>))@@ -62,7 +63,9 @@ partialAlgs =     AlgClass         (Labeled "nivash" nivash)-        [ Labeled "brent" brent+        [ Labeled "nivashPart" (nivashPart (fromIntegral :: Integer -> Word8))+        , Labeled "nivashPartWithinBounds" (nivashPartWithinBounds (0, 99) (`mod` 100))+        , Labeled "brent" brent         , Labeled "floyd" floyd         ]