unfoldable 0.3.0 → 0.4.0
raw patch · 6 files changed
+185/−53 lines, 6 files
Files
- examples/btree.hs +24/−0
- examples/tree.hs +25/−0
- src/Data/Unfoldable.hs +43/−25
- src/Data/Unfolder.hs +44/−25
- src/Data/Unfolder/Arbitrary.hs +39/−0
- unfoldable.cabal +10/−3
+ examples/btree.hs view
@@ -0,0 +1,24 @@+import Control.Applicative+import Data.Unfoldable+import Data.Unfolder++import Data.Maybe+import System.Random+++data TB a = LB a | BB (TB (a, a)) deriving Show++instance Unfoldable TB where+ unfold fa = choose+ [ LB <$> fa+ , BB <$> unfold ((,) <$> fa <*> fa)+ ]++btree8 :: TB Int+btree8 = fromJust $ fromList [0..7]++btreeShapes :: [TB ()]+btreeShapes = take 5 unfold_++randomBTree :: IO (TB Bool)+randomBTree = getStdRandom randomValue
+ examples/tree.hs view
@@ -0,0 +1,25 @@+import Control.Applicative+import Data.Unfoldable+import Data.Unfolder++import Data.Maybe+import System.Random+++data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Show++instance Unfoldable Tree where+ unfold fa = choose+ [ pure Empty+ , Leaf <$> fa+ , Node <$> unfold fa <*> fa <*> unfold fa+ ]+ +tree7 :: Tree Int+tree7 = fromJust $ fromList [0..6]++treeShapes :: [Tree ()]+treeShapes = take 10 unfoldBF_++randomTree :: IO (Tree Bool)+randomTree = getStdRandom randomValue
src/Data/Unfoldable.hs view
@@ -1,25 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Unfoldable+-- Copyright : (c) Sjoerd Visscher 2012+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : sjoerd@w3future.com+-- Stability : experimental+-- Portability : non-portable+--+-- Class of data structures that can be unfolded.+----------------------------------------------------------------------------- module Data.Unfoldable (- Unfolder(..) - , Unfoldable(..)+ -- * Unfoldable+ Unfoldable(..) , unfold_ , unfoldBF , unfoldBF_ -- ** Specific unfolds+ , unfoldr+ , fromList , leftMost , rightMost , allDepthFirst , allBreadthFirst- , randomDefault- , fromList+ , randomValue ) where import Control.Applicative-import Control.Monad import Data.Unfolder import Data.Functor.Compose import Data.Functor.Constant@@ -28,7 +40,7 @@ import Data.Functor.Reverse import Control.Monad.Trans.State import qualified System.Random as R-import Data.Maybe (listToMaybe)+import Data.Maybe -- | Data structures that can be unfolded. --@@ -51,18 +63,36 @@ -- | Given a way to generate elements, return a way to generate structures containing those elements. unfold :: Unfolder f => f a -> f (t a) --- | Unfold the structure, always using '()' as elements.+-- | 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)+-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.+unfoldBF :: (Unfoldable t, Unfolder 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 ())+-- | Unfold the structure breadth-first, always using @()@ as elements.+unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ()) unfoldBF_ = unfoldBF (pure ()) +-- | @unfoldr@ builds a data structure from a seed value. It can be specified as:+-- +-- > unfoldr f z == fromList (Data.List.unfoldr f z)+unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a)+unfoldr f z = terminate . flip runStateT z . unfoldBF . StateT $ maybeToList . f+ where+ terminate [] = Nothing+ terminate ((t, b):ts) = if isNothing (f b) then Just t else terminate ts++-- | 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 = unfoldr uncons+ where+ uncons [] = Nothing+ uncons (a:as) = Just (a, as)+ -- | Always choose the first constructor. leftMost :: Unfoldable t => t () leftMost = runIdentity $ getL unfold_@@ -80,20 +110,8 @@ 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 ]+randomValue :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)+randomValue = runState . getRandom . unfold . Random . state $ R.random instance Unfoldable [] where unfold f = choose
src/Data/Unfolder.hs view
@@ -1,14 +1,32 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Unfolder+-- Copyright : (c) Sjoerd Visscher 2012+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : sjoerd@w3future.com+-- Stability : experimental+-- Portability : non-portable+--+-- Unfolders provide a way to unfold data structures.+-- They are applicative functors that can perform a choice.+-- (Which is basically @Alternative@ without @empty@.)+----------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables , GeneralizedNewtypeDeriving #-} module Data.Unfolder (+ + -- * Unfolder Unfolder(..)- , chooseDefault+ , chooseAltDefault+ , chooseMonadDefault , boundedEnum + -- ** Unfolder instances , Left(..) , Right(..) , Random(..)@@ -29,7 +47,6 @@ 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'.@@ -40,9 +57,13 @@ chooseInt :: Int -> f Int chooseInt n = choose $ map pure [0 .. n - 1] +-- | If an unfolder is an instance of 'Alternative', 'choose' can be implemented in terms of '<|>'.+chooseAltDefault :: (Alternative f, Unfolder f) => [f x] -> f x+chooseAltDefault = foldr (<|>) empty+ -- | 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 !!)+chooseMonadDefault :: (Monad m, Unfolder m) => [m x] -> m x+chooseMonadDefault 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@@ -75,16 +96,16 @@ 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)+ chooseInt n = Pair (chooseInt n) (chooseInt n) instance (Unfolder p, Applicative q) => Unfolder (Compose p q) where- chooseInt n = Compose $ pure <$> chooseInt n choose = Compose . choose . map getCompose+ chooseInt n = Compose $ pure <$> chooseInt n instance Unfolder m => Unfolder (Reverse m) where- chooseInt n = Reverse $ (\x -> n - 1 - x) <$> chooseInt n choose = Reverse . choose . reverse . map getReverse+ chooseInt n = Reverse $ (\x -> n - 1 - x) <$> chooseInt n instance (Monad m, Unfolder m) => Unfolder (StateT s m) where choose ms = StateT $ \as -> choose $ map (`runStateT` as) ms@@ -99,35 +120,33 @@ deriving (Functor, Applicative, Monad) -- | Choose randomly. instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where- choose = chooseDefault+ choose = chooseMonadDefault 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) }+newtype BFS f x = BFS { getBFS :: Int -> Maybe [f x] } instance Functor f => Functor (BFS f) where - fmap f = BFS . (fmap (fmap f) .) . getBFS+ fmap f = BFS . (fmap (map (fmap f)) .) . getBFS -instance Alternative f => Applicative (BFS f) where+instance Applicative 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] ]+ BFS ff <*> BFS fx = BFS $ \d -> flattenBFS $+ [ liftA2 (liftA2 (<*>)) (ff i) (fx d) | i <- [0 .. d - 1] ] +++ [ liftA2 (liftA2 (<*>)) (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)+instance Applicative f => Unfolder (BFS f) where+ choose ms = BFS $ \d -> if d == 0 then Just [] else flattenBFS (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)+runBFS :: Unfolder f => BFS f x -> f x+runBFS (BFS f) = choose (loop 0) where loop d = maybe [] (++ loop (d + 1)) (f d) packBFS :: f x -> BFS f x-packBFS r = BFS $ \d -> if d == 0 then Just r else Nothing+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+flattenBFS :: [Maybe [a]] -> Maybe [a]+flattenBFS ms = case catMaybes ms of [] -> Nothing- ms' -> Just (f ms')+ ms' -> Just (concat ms')
+ src/Data/Unfolder/Arbitrary.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE + ScopedTypeVariables+ , GeneralizedNewtypeDeriving+ #-}+module Data.Unfolder.Arbitrary where+ +import Control.Applicative+import Data.Unfoldable+import Data.Unfolder+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen++import Control.Monad.Trans.Reader+import Data.Functor.Constant+import Data.Monoid (Sum(..))++-- This is somewhat of a hack. It assumes that choose always chooses from a list of Gen (t a),+-- which is true at the top-level, but might not be when recursing.++newtype CountPos a = CountPos { getCountPos :: Constant (Sum Int, Sum Int, [(Int, Int)]) a }+ deriving (Functor, Applicative)+instance Unfolder CountPos where+ choose ms = CountPos . Constant $ + (Sum 0, Sum 1, map (\(CountPos (Constant (Sum c, Sum r, _))) -> (c, r)) ms)++newtype Arb a = Arb { getArb :: ReaderT [(Int, Int)] Gen a }+ deriving (Functor, Applicative)+instance Unfolder Arb where+ choose ms = Arb (ReaderT f)+ where + f poss = sized (\n -> oneof . map (resz n) . filter ((<= n) . fst . fst) . zip poss $ ms)+ where+ resz n ((c, r), Arb (ReaderT g)) = resize ((n - c) `div` max r 1) (g poss)++arbitraryDefault :: forall t a. (Unfoldable t, Arbitrary a) => Gen (t a)+arbitraryDefault = flip runReaderT poss . getArb $ unfold (Arb . ReaderT $ const arbitrary)+ where+ CountPos (Constant (_, _, poss)) = + unfold (CountPos $ Constant (Sum 1, Sum 0, [])) :: CountPos (t ())
unfoldable.cabal view
@@ -1,16 +1,19 @@ Name: unfoldable-Version: 0.3.0+Version: 0.4.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.+ Some examples can be found in the examples directory. Homepage: https://github.com/sjoerdvisscher/unfoldable-Bug-reports: https://github.com/sjoerdvisscher/data-category/issues+Bug-reports: https://github.com/sjoerdvisscher/unfoldable/issues License: BSD3 License-file: LICENSE Author: Sjoerd Visscher@@ -18,6 +21,10 @@ Category: Generics Build-type: Simple Cabal-version: >= 1.6++Extra-Source-Files:+ examples/*.hs+ src/Data/Unfolder/Arbitrary.hs Library HS-Source-Dirs: src