packages feed

unfoldable 0.2.0 → 0.3.0

raw patch · 4 files changed

+239/−152 lines, 4 files

Files

− src/Data/Splittable.hs 
@@ -1,84 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Data.Splittable (-    Splittable(..)-  -  , boundedEnum-  -  , Left(..)-  , Right(..)-  -  ) where --import qualified System.Random as R-import Data.List (mapAccumR)-import Data.Monoid (Dual(..))---- | Splittable datatypes are datatypes that can be used as seeds for unfolds.-class Splittable s where-  -- | @split n s@ splits the seed @s@ in @n@ seeds. -  split  :: Int -> s -> [s]-  -- | @choose fs s@ uses part of the seed @s@ to choose a function from the list @fs@,-  -- and passes the remainder to that function.-  choose :: [s -> x] -> s -> x-  -- | Convert the seed value to an @int@.-  getInt :: s -> Int---- | If a datatype is bounded and enumerable, we can use 'getInt' to produce a value from a seed.-boundedEnum :: forall s a. (Splittable s, Bounded a, Enum a) => s -> a-boundedEnum s = toEnum $ (getInt s `mod'` (1 + ub - lb)) + lb-  where -    lb = fromEnum (minBound :: a)-    ub = fromEnum (maxBound :: a)-    n `mod'` 0 = n - lb-    n `mod'` m = n `mod` m --data Left = L--- | Always choose the first item.-instance Splittable Left where-  split = replicate-  choose fs = head fs-  getInt L = 0--data Right = R--- | Always choose the last item.-instance Splittable Right where-  split = replicate-  choose fs = last fs-  getInt R = 0---- | Choose randomly-instance Splittable R.StdGen where-  split 0 _ = []-  split 1 s = [s]-  split n s = let (s1, s2) = R.split s in s1 : split (n - 1) s2 -  choose fs s = let (n, s') = R.next s in fs !! (n `mod` length fs) $ s'-  getInt = fst . R.next---- | The 'Integer' instance uses modulo to choose, and splits breadth-first by --- distributing bits in a round-robin fashion.-instance Splittable Integer where-  split n t = split' 1 (t, replicate n 0)-    where-      split' _ (0, l) = l-      split' p (s, l) = split' (p * 2) $ mapAccumR (\s' i -> let (s'', b) = s' `divMod` 2 in (s'', i + b * p)) s l-  choose fs s = let (s', n) = s `divMod` toInteger (length fs) in fs !! fromInteger n $ s'-  getInt = fromInteger---- | The @(a, b)@ instance uses only @a@ for 'choose' and @b@ for 'getInt'.-instance (Splittable a, Splittable b) => Splittable (a, b) where-  split n (a, b) = zip (split n a) (split n b)-  choose = uncurry . choose . map curry-  getInt (_, b) = getInt b---- | Choose between 2 ways to split and choose.-instance (Splittable a, Splittable b) => Splittable (Either a b) where-  split n   = either (map Left . split n) (map Right . split n)-  choose fs = either (choose (map (. Left) fs)) (choose (map (. Right) fs))-  getInt (Left a) = getInt a * 2-  getInt (Right a) = getInt a * 2 + 1---- | Reverse the split output and the choose input.-instance Splittable s => Splittable (Dual s) where-  split n = map Dual . reverse . split n . getDual-  choose fs = choose (map (. Dual) $ reverse fs) . getDual-  getInt = negate . getInt . getDual
src/Data/Unfoldable.hs view
@@ -1,27 +1,34 @@-module Data.Unfoldable (--    Unfoldable(..)-+module Data.Unfoldable +  (+    Unfolder(..)+  +  , Unfoldable(..)+  , unfold_+  , unfoldBF+  , unfoldBF_+     -- ** Specific unfolds-  , unfold   , leftMost   , rightMost--  -- ** Helper functions-  , spread-  , to--  ) where+  , allDepthFirst+  , allBreadthFirst+  , randomDefault+  , fromList+  +  ) +  where      import Control.Applicative-import Control.Monad.Trans.State-import Data.Splittable-import Data.Monoid (Dual(..))+import Control.Monad+import Data.Unfolder import Data.Functor.Compose import Data.Functor.Constant import Data.Functor.Identity import Data.Functor.Product import Data.Functor.Reverse+import Control.Monad.Trans.State+import qualified System.Random as R+import Data.Maybe (listToMaybe)  -- | Data structures that can be unfolded. --@@ -32,72 +39,94 @@ -- a suitable instance would be -- -- > instance Unfoldable Tree where--- >   unfoldMap f = choose--- >     [ spread $ pure Empty--- >     , spread $ Leaf <$> to f--- >     , spread $ Node <$> to (unfoldMap f) <*> to f <*> to (unfoldMap f)+-- >   unfold fa = choose+-- >     [ pure Empty+-- >     , Leaf <$> fa+-- >     , Node <$> unfold fa <*> fa <*> unfold fa -- >     ] ----- i.e. it follows closely the instance for 'Traversable', with the addition of 'choose', 'spread' and 'to'.--- --- The instance can be simplified to:------ > instance Unfoldable Tree where--- >   unfoldMap f = choose--- >     [ const Empty--- >     , Leaf . f--- >     , spread $ Node <$> to (unfoldMap f) <*> to f <*> to (unfoldMap f)--- >     ]-class Unfoldable f where-  -- | Given a function to generate an element from a seed, -  -- and an initial seed, generate a structure.-  unfoldMap :: Splittable s => (s -> a) -> s -> f a+-- i.e. it follows closely the instance for 'Traversable', but instead of matching on an input value,+-- we 'choose' from a list of all cases.+class Unfoldable t where+  -- | Given a way to generate elements, return a way to generate structures containing those elements.+  unfold :: Unfolder f => f a -> f (t a) --- | The same as @unfoldMap id@.-unfold :: (Unfoldable f, Splittable s) => s -> f s-unfold = unfoldMap id+-- | Unfold the structure, always using '()' as elements.+unfold_ :: (Unfoldable t, Unfolder f) => f (t ())+unfold_ = unfold (pure ()) +-- | Breadth-first unfold+unfoldBF :: (Unfoldable t, Unfolder f, Alternative f) => f a -> f (t a)+unfoldBF = runBFS . unfold . packBFS++-- | Unfold the structure breadth-first, always using '()' as elements.+unfoldBF_ :: (Unfoldable t, Unfolder f, Alternative f) => f (t ())+unfoldBF_ = unfoldBF (pure ())+ -- | Always choose the first constructor.-leftMost :: Unfoldable f => f ()-leftMost = unfoldMap (const ()) L+leftMost :: Unfoldable t => t ()+leftMost = runIdentity $ getL unfold_  -- | Always choose the last constructor.-rightMost :: Unfoldable f => f ()-rightMost = unfoldMap (const ()) R+rightMost :: Unfoldable t => t ()+rightMost = runIdentity $ getR unfold_ --- | Count the number of times 'to' is used, and split the seed in that many parts.-spread :: Splittable s => State ([s], Int) a -> s -> a-spread f s = let (a, (_, i)) = runState f (split i s, 0) in a+-- | Generate all the values depth first.+allDepthFirst :: Unfoldable t => [t ()]+allDepthFirst = unfold_ --- | Signal to 'spread' that this is a subpart that needs a seed.-to :: (s -> a) -> State ([s], Int) a-to f = state $ \(ss, i) -> (f (head ss), (tail ss, i + 1))+-- | Generate all the values breadth first.+allBreadthFirst :: Unfoldable t => [t ()]+allBreadthFirst = unfoldBF_ +-- | Generate a random value, can be used as default instance for Random.+randomDefault :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)+randomDefault = runState . getRandom . unfold . Random . state $ R.random++fromList' :: (Unfolder f, MonadPlus f, Unfoldable t) => [a] -> f (t a, [a])+fromList' as = flip runStateT as . unfoldBF . StateT $ uncons+  where+    uncons [] = mzero+    uncons (a:as') = return (a, as')++-- | Create a data structure using the list as input.+--   This can fail because there might not be a data structure with the same number+--   of element positions as the number of elements in the list.+fromList :: Unfoldable t => [a] -> Maybe (t a)+fromList as = listToMaybe [ t | (t, []) <- fromList' as ]+ instance Unfoldable [] where-  unfoldMap f = go-    where-      go = choose [const [], spread $ (:) <$> to f <*> to go]+  unfold f = choose +    [ pure []+    , (:) <$> f <*> unfold f+    ]  instance Unfoldable Maybe where-  unfoldMap f = choose [const Nothing, Just . f]+  unfold f = choose +    [ pure Nothing+    , Just <$> f+    ]  instance (Bounded a, Enum a) => Unfoldable (Either a) where-  unfoldMap f = choose [Left . boundedEnum, Right . f]+  unfold f = choose +    [ Left <$> boundedEnum+    , Right <$> f+    ]  instance (Bounded a, Enum a) => Unfoldable ((,) a) where-  unfoldMap f = spread $ (,) <$> to boundedEnum <*> to f+  unfold f = (,) <$> boundedEnum <*> f  instance Unfoldable Identity where-  unfoldMap f = Identity . f+  unfold f = Identity <$> f  instance (Bounded a, Enum a) => Unfoldable (Constant a) where-  unfoldMap _ = Constant . boundedEnum+  unfold _ = Constant <$> boundedEnum    instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where-  unfoldMap f = spread $ Pair <$> to (unfoldMap f) <*> to (unfoldMap f)+  unfold f = Pair <$> unfold f <*> unfold f  instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where-  unfoldMap f = Compose . unfoldMap (unfoldMap f)+  unfold f = Compose <$> unfold (unfold f)  instance Unfoldable f => Unfoldable (Reverse f) where-  unfoldMap f = Reverse . unfoldMap (f . getDual) . Dual+  unfold f = Reverse <$> getReverse (unfold (Reverse f))
+ src/Data/Unfolder.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE +    ScopedTypeVariables+  , GeneralizedNewtypeDeriving+  #-}+module Data.Unfolder +  (+    Unfolder(..)+  , chooseDefault+  +  , boundedEnum+  +  , Left(..)+  , Right(..)+  , Random(..)++  , BFS(..)+  , runBFS+  , packBFS+  +  ) +  where ++import Control.Applicative+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Compose+import Data.Functor.Reverse+import Control.Monad.Trans.Cont+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import qualified System.Random as R+import Data.Foldable (asum)+import Data.Maybe (catMaybes)++-- | Unfolders provide a way to unfold data structures. The minimal implementation is 'choose'.+class Applicative f => Unfolder f where+  -- | Choose one of the values from the list.+  choose :: [f x] -> f x+  -- | Given a number 'n', return a number between '0' and 'n - 1'.+  chooseInt :: Int -> f Int+  chooseInt n = choose $ map pure [0 .. n - 1]++-- | If an unfolder is monadic, 'choose' can be implemented in terms of 'chooseInt'.+chooseDefault :: (Monad m, Unfolder m) => [m x] -> m x+chooseDefault ms = chooseInt (length ms) >>= (ms !!)++-- | If a datatype is bounded and enumerable, we can use 'chooseInt' to generate a value.+boundedEnum :: forall f a. (Unfolder f, Bounded a, Enum a) => f a+boundedEnum = (\x -> toEnum (x + lb)) <$> chooseInt (1 + ub - lb)+  where+    lb = fromEnum (minBound :: a)+    ub = fromEnum (maxBound :: a)++newtype Left x = L { getL :: Identity x } deriving (Functor, Applicative, Monad)+-- | Always choose the first item.+instance Unfolder Left where+  choose = head+  chooseInt _ = pure 0++newtype Right x = R { getR :: Identity x } deriving (Functor, Applicative, Monad)+-- | Always choose the last item.+instance Unfolder Right where+  choose = last+  chooseInt n = pure (n - 1)++-- | Don't choose but return all items.+instance Unfolder [] where+  choose = concat+  chooseInt n = [0 .. n - 1]++fstP :: Product p q a -> p a+fstP (Pair p _) = p++sndP :: Product p q a -> q a+sndP (Pair _ q) = q++instance (Unfolder p, Unfolder q) => Unfolder (Product p q) where+  chooseInt n = Pair (chooseInt n) (chooseInt n)+  choose ps = Pair (choose $ map fstP ps) (choose $ map sndP ps)++instance (Unfolder p, Applicative q) => Unfolder (Compose p q) where+  chooseInt n = Compose $ pure <$> chooseInt n+  choose = Compose . choose . map getCompose++instance Unfolder m => Unfolder (Reverse m) where+  chooseInt n = Reverse $ (\x -> n - 1 - x) <$> chooseInt n+  choose = Reverse . choose . reverse . map getReverse+  +instance (Monad m, Unfolder m) => Unfolder (StateT s m) where+  choose ms = StateT $ \as -> choose $ map (`runStateT` as) ms++instance Unfolder m => Unfolder (ContT r m) where+  choose ms = ContT $ \k -> choose $ map (`runContT` k) ms++instance Unfolder m => Unfolder (ReaderT r m) where+  choose ms = ReaderT $ \r -> choose $ map (`runReaderT` r) ms+  +newtype Random g m a = Random { getRandom :: StateT g m a } +  deriving (Functor, Applicative, Monad)+-- | Choose randomly.+instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where+  choose = chooseDefault+  chooseInt n = Random . StateT $ return . R.randomR (0, n - 1)+  +-- | Return a generator of values of a given depth.+--   Returns 'Nothing' if there are no values of that depth or deeper.+newtype BFS f x = BFS { getBFS :: Int -> Maybe (f x) }++instance Functor f => Functor (BFS f) where +  fmap f = BFS . (fmap (fmap f) .) . getBFS++instance Alternative f => Applicative (BFS f) where+  pure = packBFS . pure+  BFS ff <*> BFS fx = BFS $ \d -> flattenBFS asum $+    [ (<*>) <$> ff i <*> fx d | i <- [0 .. d - 1] ] +++    [ (<*>) <$> ff d <*> fx i | i <- [0 .. d] ]++-- | Choose between values of a given depth only.+instance (Alternative f, Unfolder f) => Unfolder (BFS f) where+  choose ms = BFS $ \d -> if d == 0 +    then Just empty+    else flattenBFS choose (map (`getBFS` (d - 1)) ms)++runBFS :: Alternative f => BFS f x -> f x+runBFS (BFS f) = loop 0 where loop d = maybe empty (<|> loop (d + 1)) (f d)++packBFS :: f x -> BFS f x+packBFS r = BFS $ \d -> if d == 0 then Just r else Nothing++flattenBFS :: ([a] -> a) -> [Maybe a] -> Maybe a+flattenBFS f ms = case catMaybes ms of+  [] -> Nothing+  ms' -> Just (f ms')
unfoldable.cabal view
@@ -1,20 +1,29 @@-Name:                unfoldable-Version:             0.2.0-Synopsis:            Class of data structures that can be unfolded from a seed value.-Homepage:            https://github.com/sjoerdvisscher/unfoldable-License:             BSD3-License-file:        LICENSE-Author:              Sjoerd Visscher-Maintainer:          sjoerd@w3future.com-Category:            Generics-Build-type:          Simple-Cabal-version:       >= 1.6+Name:                 unfoldable+Version:              0.3.0+Synopsis:             Class of data structures that can be unfolded.+Description:          Just as there's a Foldable class, there should also be an Unfoldable class. +                      This package provides one. Example unfolds are:+                      .+                      * Random values+                      * Enumeration of all values (depth-first or breadth-first)+                      * Convert from a list+                      .+                      The package provides examples in the examples directory.+Homepage:             https://github.com/sjoerdvisscher/unfoldable+Bug-reports:          https://github.com/sjoerdvisscher/data-category/issues+License:              BSD3+License-file:         LICENSE+Author:               Sjoerd Visscher+Maintainer:           sjoerd@w3future.com+Category:             Generics+Build-type:           Simple+Cabal-version:        >= 1.6  Library   HS-Source-Dirs:  src      Exposed-modules:-    Data.Splittable+    Data.Unfolder     Data.Unfoldable        Build-depends: