packages feed

category-extras 0.1 → 0.2

raw patch · 12 files changed

+382/−83 lines, 12 files

Files

Control/Comonad.hs view
@@ -2,7 +2,7 @@ -- | -- Module      :  Control.Comonad -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental
+ Control/Comonad/Cofree.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Free+-- Copyright   :  2004 Dave Menendez+-- License     :  BSD3+-- +-- Maintainer  :  dan.doel@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- An implementation of the cofree comonad of a functor, used in+-- histomorphisms and chronomorphisms in Control.Recursion. The+-- cofree comonad can also be seen as a stream parameterized by a+-- functor that controls its branching factor.+--+-----------------------------------------------------------------------------++module Control.Comonad.Cofree+  ( Cofree(..)+  , headCofree+  , tailCofree+  , anaCofree+  , cofreeToList+  , distribCofree+  ) where++import Control.Arrow ((&&&),(***),(>>>), second)+import Control.Comonad++{-|+The cofree comonad of a functor @h@ (also known as an H-branching stream).+Various comonads are a special instance of the cofree comonad:++* @Cofree Identity@ is an infinite stream++* @Cofree Maybe@ is a non-empty stream++* @Cofree []@ is a rose tree++formally:++> Cofree H A = nu X. A * HX+-}+data Cofree h a = Cofree { unCofree :: (a, h (Cofree h a)) }++-- | anamorphism for building a cofree comonad from a seed+anaCofree :: Functor h => (a -> b) -> (a -> h a) -> a -> Cofree h b+anaCofree g1 g2 = g1 &&& fmap (anaCofree g1 g2) . g2 >>> Cofree++headCofree :: Cofree h a -> a+headCofree = fst . unCofree++tailCofree :: Cofree h a -> h (Cofree h a)+tailCofree = snd . unCofree++instance Functor h => Functor (Cofree h) where+  fmap g = unCofree >>> g *** fmap (fmap g) >>> Cofree++instance Functor h => Comonad (Cofree h) where+  extract   = headCofree+  duplicate = anaCofree id tailCofree++-- | Converts a value of the cofree comonad over Maybe into a non-empty list.+cofreeToList :: Cofree Maybe a -> [a]+cofreeToList = unCofree >>> second (maybe [] cofreeToList) >>> uncurry (:) ++-- | Lifts a distributive law of @f@ over @h@ to a distributive law+-- of @f@ over @Cofree h@.+distribCofree :: (Functor h, Functor f) =>+                 (forall a. f (h a) -> h (f a))+                   -> (forall a. f (Cofree h a) -> Cofree h (f a))+distribCofree d = anaCofree (fmap headCofree) (d . fmap tailCofree)
Control/Comonad/Context.hs view
@@ -2,7 +2,7 @@ -- | -- Module      :  Control.Comonad.Context -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental
Control/Functor.hs view
@@ -2,7 +2,7 @@ -- | -- Module      :  Control.Functor -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental
Control/Functor/Adjunction.hs view
@@ -2,7 +2,7 @@ -- | -- Module      :  Control.Functor.Adjunction -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental
Control/Functor/Transform.hs view
@@ -4,7 +4,7 @@ -- | -- Module      :  Control.Functor.Transform -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental
+ Control/Monad/Free.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Free+-- Copyright   :  2008 Dan Doel, Edward Kmett+-- License     :  BSD3+-- +-- Maintainer  :  dan.doel@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 types)+--+-- An implementation of the free monad of a functor, used in (at the least)+-- futumorphisms and chronomorphisms in Control.Recursion+--+-----------------------------------------------------------------------------++module Control.Monad.Free +       ( Free()+       , inFree+       , cataFree+       , distribFree+       ) where++import Control.Arrow ((|||), (+++), (>>>))+import Control.Applicative+import Control.Monad++-- | The free monad of a functor 'f', formally,+--+-- > Free F A = mu X. A + FX+newtype Free f a = Free { unFree :: Either a (f (Free f a)) }++instance (Functor f) => Functor (Free f) where+  fmap f = unFree >>> f +++ fmap (fmap f) >>> Free+++instance (Functor f) => Applicative (Free f) where+  pure = return+  (<*>) = ap++instance (Functor f) => Monad (Free f) where+  return = Free . Left+  (Free e) >>= f = either f (inFree . fmap (>>= f)) e++-- | The catamorphism for the free monad+cataFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b+cataFree f g = unFree >>> f ||| g . fmap (cataFree f g)++inFree :: f (Free f a) -> Free f a+inFree = Free . Right++-- | Lifts a distributive law of @h@ over @f@ to a distributive+-- law of @Free h@ over @f@+distribFree :: (Functor f, Functor h) =>+               (forall a. h (f a) -> f (h a))+                 -> (forall a. Free h (f a) -> f (Free h a))+distribFree d = cataFree (fmap return) (fmap inFree . d)
Control/Recursion.hs view
@@ -1,11 +1,15 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies,-  FlexibleInstances #-}+{-# LANGUAGE +    Rank2Types+  , MultiParamTypeClasses+  , FunctionalDependencies+  , FlexibleInstances+  #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Control.Recursion -- Copyright   :  2004 Dave Menendez--- License     :  public domain+-- License     :  BSD3 --  -- Maintainer  :  dan.doel@gmail.com -- Stability   :  experimental@@ -21,6 +25,9 @@ -- standard functors for natural numbers and lists ('ConsPair'), -- and a fixpoint type for arbitrary functors ('Fix'). --+-- Several combinators herein ((g_)futu, (g_)chrono, refoldWith, ...)+-- are due to substantial help by Edward Kmett.+-- -----------------------------------------------------------------------------  module Control.Recursion@@ -38,10 +45,21 @@   , apo   , g_apo   , unfoldWith-+  , futu+  , g_futu+       -- * Transforming   , refold-  +  , refoldWith+  , chrono+  , g_chrono++  -- * Dynamic Programming+  , dyna+  , g_dyna+  , codyna+  , g_codyna+       -- * Functor fixpoints   , Fixpoint(..)   , Fix(..)@@ -53,9 +71,10 @@ ---- import Control.Arrow import Control.Functor-import Control.Monad+import Control.Monad.Identity+import Control.Monad.Free import Control.Comonad-import Data.BranchingStream+import Control.Comonad.Cofree  class Functor f => Fixpoint f t | t -> f where   inF  :: f t -> t@@ -64,7 +83,7 @@   outF :: t -> f t   -- ^ formally, @in^-1[f]: mu f -> f@ -{-| Creates a fixpoint for any functor. -}+-- | Creates a fixpoint for any functor. newtype Fix f = In (f (Fix f))  instance Functor f => Fixpoint f (Fix f) where@@ -89,8 +108,6 @@   outF n | n > 0     = Just (n - 1)          | otherwise = Nothing ---- -- | Fixpoint of lists data ConsPair a b = Nil | Pair a b deriving (Eq, Show) @@ -111,8 +128,6 @@ cons d _ Nil        = d cons _ f (Pair a b) = f a b ------ {-| A generalized @map@, known formally as a /hylomorphism/ and written [| f, g |]. @@ -128,7 +143,7 @@  @ 	fold f == 'refold' f 'outF'-	fold f == 'foldWith' ('Id' . fmap 'unId') (f . fmap 'unId')+	fold f == 'foldWith' ('Identity' . fmap 'runIdentity') (f . fmap 'runIdentity') @ -} fold :: Fixpoint f t => (f a -> a) -> t -> a@@ -139,7 +154,7 @@  @ 	unfold f == 'refold' 'inF' f-	unfold f == 'unfoldWith' (fmap 'Id' . 'unId') (fmap 'Id' . f)+	unfold f == 'unfoldWith' (fmap 'Identity' . 'unIdentity') (fmap 'Identity' . f) @ -} unfold :: Fixpoint f t => (a -> f a) -> a -> t@@ -189,7 +204,7 @@  {-| Implements course-of-value recursion. At each step, the function-receives an F-branching stream ('Strf') containing the previous+receives an F-branching stream ('Cofree') containing the previous values. Formally known as a /histomorphism/ and written {| f |}.  @@@ -201,7 +216,7 @@ > fibo :: Integer -> Integer > fibo = histo next >   where->     next :: Maybe (Strf Maybe Integer) -> Integer+>     next :: Maybe (Cofree Maybe Integer) -> Integer >     next Nothing                             = 0 >     next (Just (Consf _ Nothing))            = 1 >     next (Just (Consf m (Just (Consf n _)))) = m + n@@ -216,7 +231,7 @@  -} -histo :: Fixpoint f t => (f (Strf f a) -> a) -> t -> a+histo :: Fixpoint f t => (f (Cofree f a) -> a) -> t -> a histo = g_histo id  -----@@ -239,13 +254,13 @@ stream functor are distinct. Known as a /g-histomorphism/.  @-	g_histo g == 'foldWith' ('genStrf' (fmap 'hdf') (g . fmap 'tlf'))+	g_histo g == 'foldWith' ('anaCofree' (fmap 'headCofree') (g . fmap 'tailCofree')) @ -} g_histo :: (Functor h, Fixpoint f t)        => (forall b. f (h b) -> h (f b))  --  distributive law for /h/ and /f/-       -> (f (Strf h a) -> a) -> t -> a-g_histo g = foldWith (genStrf (fmap hdf) (g . fmap tlf))+       -> (f (Cofree h a) -> a) -> t -> a+g_histo = foldWith . distribCofree   {-|@@ -255,11 +270,11 @@  The behavior of @foldWith@ is determined by the comonad /w/. -* 'Id' recovers 'fold'+* 'Identity' recovers 'fold'  * @((,) a)@ recovers 'zygo' (and 'para') -* 'Strf' recovers 'g_histo' (and 'histo')+* 'Cofree' recovers 'g_histo' (and 'histo')  -} foldWith :: (Fixpoint f t, Comonad w)@@ -290,7 +305,8 @@ apo :: Fixpoint f t => (a -> f (Either t a)) -> a -> t apo = g_apo outF -{-| generalized apomorphisms, dual to 'zygo'+{-|+Generalized apomorphisms, dual to 'zygo'  @ 	g_apo g == 'unfoldWith' (fmap Left . g ||| fmap Right)@@ -300,22 +316,212 @@ g_apo g f = unfold (fmap Left . g ||| f) . Right  -{-| generalized anamorphisms parameterized by a monad, dual to 'foldWith'--* 'Id' recovers 'unfold'+{-|+Generalized anamorphisms parameterized by a monad, dual to 'foldWith' -* @(Either a)@ recovers 'g_apo' (and 'apo')+ * @Identity@ recovers 'unfold' + * @(Either a)@ recovers 'g_apo' (and 'apo') -} unfoldWith :: (Fixpoint f t, Monad m)            => (forall b. m (f b) -> f (m b)) -> (a -> f (m a)) -> a -> t unfoldWith k f = unfold (fmap join . k . liftM f) . return ----- --- defined for internal use-{--infixr 2 &&&, |||-f &&& g = \x -> (f x, g x)-(|||) = either+{-|+Generalized hylomorphisms parameterized by both a monad and a comonad.+This one combinator subsumes most-if-not-all the other combinators in+this library.++ * @w = Identity@ yields 'unfoldWith'++ * @m = Identity@ yields 'foldWith'++ * @Free m@ and @Cofree w@ yields 'g_chrono', and therefore 'g_histo' and 'g_futu'++@e@ and @g@ are additional functors related to @f@ by natural transformations+that have been fused into the distributive laws. -}+refoldWith :: (Comonad w, Functor f, Monad m) =>+              (forall c. f (w c) -> w (g c)) ->+              (forall c. m (e c) -> f (m c)) ->+              (g (w b) -> b) ->+              (a -> e (m a)) ->+              a -> b+refoldWith w m f g = extract . refoldWith' w m f g . return++-- | The kernel of the generalized hylomorphism.+refoldWith' :: (Comonad w, Functor f, Monad m) =>+               (forall c. f (w c) -> w (g c)) ->+               (forall c. m (e c) -> f (m c)) ->+               (g (w b) -> b) ->+               (a -> e (m a)) ->+               (m a -> w b)+refoldWith' w m f g = liftW f . w . fmap (duplicate . refoldWith' w m f g . join) . m . liftM g++{-|+Futumorphism: course of argument coiteration++@+        futu == 'chrono' ('inF' . fmap 'headCofree')+        futu == 'g_futu' id+@++Example, translated from /Primitive (Co)Recursion and Course-of-Value+(Co)Iteration, Categorically/ +(<http://citeseer.ist.psu.edu/uustalu99primitive.html>):++> phi (x:y:zs) = Pair y . inFree . Pair x $ return zs++> exch = futu phi++> l = exch [1..] -- [2,1,4,3,6,5,8,7,10,9..]+-}+futu :: (Fixpoint f t) => (a -> f (Free f a)) -> a -> t+futu = g_futu id++{-|+Generalized futumorphism++@+        g_futu m == 'g_chrono' (const 'Unit') m ('inF' . fmap 'headCofree')+        g_futu m == 'unfoldWith' ('distribFree' m)+@+-}+g_futu :: (Functor h, Fixpoint f t) =>+          (forall b. h (f b) -> f (h b)) ->+          (a -> f (Free h a)) ->+          a -> t+g_futu = unfoldWith . distribFree++-- | a chronomorphism, coined by Edward Kmett, subsumes both histo+-- and futumorphisms.+chrono :: Functor f =>+          (f (Cofree f b) -> b) ->+          (a -> f (Free f a)) ->+          a -> b+chrono = g_chrono id id++{-|+Generalized chronomorphism. The recursion functor is separated from+the Free and Cofree functors, and related by distributive laws.++@+        g_chrono w m == 'refoldWith' ('distribCofree' w) ('distribFree' m)+@+-}+g_chrono :: (Functor f, Functor m, Functor w) =>+            (forall c. f (w c) -> w (f c)) ->+            (forall c. m (f c) -> f (m c)) ->+            (f (Cofree w b) -> b) ->+            (a -> f (Free m a)) ->+            a -> b+g_chrono w m = refoldWith (distribCofree w) (distribFree m)++{-|+Dynamorphisms: a hylomorphism like combinator that captures dynamic+programming.++@+        dyna f g == 'g_dyna' id (fmap Identity . runIdentity) f (fmap Identity . g)+        dyna f g == 'chrono' f (fmap return . g)+@++Example, translated from /Recursion Schemes for Dynamic Programming/+(<http://citeseer.ist.psu.edu/748315.html>) section 4.2:++> data Poly a = Term | Single a | Double a a++> instance Functor Poly where+>   fmap _ Term = Term+>   fmap f (Single a) = Single (f a)+>   fmap f (Double a b) = Double (f a) (f b)++> psi 0 = Term+> psi n+>   | odd n  = Single (n-1)+>   | even n = Double (n-1) (n `div` 2)++> phi Term = 1+> phi (Single n) = n+> phi (Double m n) = m + n++> bp1 = refold phi psi -- hylo version; ineffcient++> zeta 0 = Nil+> zeta n = Pair n (n-1)++> epsilon = headCofree++> theta = tailCofree++> pie x = let (Pair m y) = theta x in y++> pieN 0 x = x+> pieN n x = pieN (n-1) (pie x)++> sigma Nil = Term+> sigma (Pair n x)+>   | odd n  = Single (epsilon x)+>   | even n = Double (epsilon x) (epsilon (pieN (n`div`2 - 1) x))++> bp2 = dyna (phi . sigma) zeta -- dynamically programmed++-}+dyna :: (Functor f) =>+        (f (Cofree f b) -> b) ->+        (a -> f a) ->+        a -> b+dyna f g = extract . dyna' f g++-- | Kernel of the dynamorphism+dyna' :: (Functor f) =>+         (f (Cofree f b) -> b) ->+         (a -> f a) ->+         a -> Cofree f b+dyna' f g = refold (f &&& id >>> Cofree) g++{-|+Generalized dynamorphism++@+        g_dyna w == 'refoldWith' ('distribCofree' w)+@+-}+g_dyna :: (Functor f, Functor h, Monad m) =>+          (forall c. f (h c) -> h (f c)) ->+          (forall c. m (e c) -> f (m c)) ->+          (f (Cofree h b) -> b) ->+          (a -> e (m a)) ->+          a -> b+g_dyna = refoldWith . distribCofree++{- Generalized dynamorphism kernel+g_dyna' :: (Functor f, Functor h, Monad m) =>+           (forall c. f (h c) -> h (f c)) ->+           (forall c. m (e c) -> f (m c)) ->+           (f (Cofree h b) -> b) ->+           (a -> e (m a)) ->+           m a -> Cofree h b+g_dyna' = refoldWith' . distribCofree+-}++{-|+The dual of dynamorphisms.+-}+codyna :: (Functor f) =>+          (f b -> b) ->+          (a -> f (Free f a)) ->+          a -> b+codyna f g = chrono (f . fmap extract) g++{-|+Generalized codynamorphisms.+-}+g_codyna :: (Functor f, Functor h, Comonad w) =>+            (forall c. f (w c) -> w (g c)) ->+            (forall c. h (f c) -> f (h c)) ->+            (g (w b) -> b) ->+            (a -> f (Free h a)) ->+            a -> b+g_codyna w = refoldWith w . distribFree
− Data/BranchingStream.hs 
@@ -1,42 +0,0 @@-module Data.BranchingStream-  ( Strf(..)-  , hdf-  , tlf-  , genStrf-  , strfToList-  ) where--import Control.Comonad-  --{-|-An H-branching stream. The specific functor chosen for /H/ determines-its behavior:--* @Strf 'Id'@ is an infinite stream--* @Strf Maybe@ is a non-empty stream--* @Strf []@ is a rose tree--}-data Strf h c = Consf c (h (Strf h c))--hdf :: Strf h c -> c-hdf (Consf x _) = x--tlf :: Strf h c -> h (Strf h c)-tlf (Consf _ xs) = xs--genStrf :: Functor h-        => (a -> c) -> (a -> h a) -> a -> Strf h c-genStrf g1 g2 z = Consf (g1 z) (fmap (genStrf g1 g2) (g2 z))--instance Functor h => Functor (Strf h) where-  fmap g = genStrf (g . hdf) tlf--instance Functor h => Comonad (Strf h) where-  extract   = hdf-  duplicate = genStrf id tlf--strfToList :: Strf Maybe a -> [a]-strfToList (Consf x xs) = x : maybe [] strfToList xs
Data/Stream.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Rank2Types, ExistentialQuantification #-}+ module Data.Stream   ( Stream   , mkStream
LICENSE view
@@ -14,7 +14,7 @@    may be used to endorse or promote products derived from this software    without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
category-extras.cabal view
@@ -1,5 +1,5 @@ Name:			category-extras-Version:		0.1+Version:		0.2 Description:		A collection of modules implementing various ideas from 			category theory. Notable bits include: comonads, adjunctions, 			functor fixedpoints and various recursion operaters ala@@ -21,11 +21,12 @@  Exposed-Modules:	Control.Comonad 			Control.Comonad.Context+			Control.Comonad.Cofree 			Control.Functor 			Control.Functor.Adjunction 			Control.Functor.Transform 			Control.Recursion-			Data.BranchingStream+			Control.Monad.Free 			Data.InfiniteSeq 			Data.InfiniteTree 			Data.Stream