The post below will only compile on a version of GHC >= 6.9, since it uses type families.

There has been a lot of posting recently about automatic differentiation in Haskell, and I wanted to try the same thing with functors in the spirit of Conor McBride's Clowns to the Left of me, Jokers to the Right and The derivative of a regular type is its type of one hole contexts, figuring that a Power Series could fully generalize Christophe Poucet's Higher Order Zippers, and might provide me with a neat extension to the zipper comonadic automata I've been aluding to recently.


{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}
module Derivatives where
import Control.Arrow ((+++),(***),(&&&))
import Data.Monoid
infixl 9 :.:
infixl 7 :*:
infixl 6 :+:


To avoid importing category-extras and keep this post self-contained (modulo GHC 6.9!), we'll define some preliminaries such as Bifunctors:


class Bifunctor f where
bimap :: (a -> c) -> (b -> d) -> f a b -> f c d

instance Bifunctor (,) where
bimap f g ~(a,b) = (f a, g b)

instance Bifunctor Either where
bimap f _ (Left a) = Left (f a)
bimap _ g (Right b) = Right (g b)


Constant functors:


data Void
instance Show Void where show _ = "Void"
newtype Const k a = Const { runConst :: k } deriving (Show)
type Zero = Const Void
type One = Const ()
instance Functor (Const k) where
fmap f = Const . runConst


and functor products and coproducts:


newtype Lift p f g a = Lift { runLift ::  p (f a) (g a) }
type (:+:) = Lift Either
type (:*:) = Lift (,)
instance Show (p (f a) (g a)) => Show (Lift p f g a) where
show (Lift x) = "(Lift (" ++ show x ++ "))"
instance (Bifunctor p, Functor f, Functor g) => Functor (Lift p f g) where
fmap f = Lift . bimap (fmap f) (fmap f) . runLift


and finally functor composition


newtype (f :.: g) a = Comp { runComp :: f (g a) } deriving (Show)
instance (Functor f, Functor g) => Functor (f :.: g) where
fmap f = Comp . fmap (fmap f) . runComp


So then, an ideal type for repeated differentiation would look something like the following, for some definition of D.

[Edit: sigfpe pointed out, quite rightly, that this is just repeated differentiation, and apfelmus pointed out that it not a power series, because I have no division!]




As a first crack at D, you might be tempted to just go with a type family:


{-
type family D (f :: * -> *) :: * -> *
type instance D Identity = One
type instance D (Const k) = Zero
type instance D (f :+: g) = D f :+: D g
type instance D (f :*: g) = f :*: D g :+: D f :*: g
type instance D (f :.: g) = (D f :.: g) :*: D g
-}


This could take you pretty far, but unfortunately doesn't adequately provide you with any constraints on the type so that we can treat AD f as a functor.

So, we'll go with:


class (Functor (D f), Functor f) => Derivable (f :: * -> *) where
type D f :: * -> *


and cherry pick the instances necessary to handle the above cases:


instance Derivable Identity where
type D Identity = One

instance Derivable (Const k) where
type D (Const k) = Zero

instance (Derivable f, Derivable g) => Derivable (f :+: g) where
type D (f :+: g) = D f :+: D g

instance (Derivable f, Derivable g) => Derivable (f :*: g) where
type D (f :*: g) = f :*: D g :+: D f :*: g

instance (Derivable f, Derivable g) => Derivable (f :.: g) where
type D (f :.: g) = (D f :.: g) :*: D g


With those instances in hand, we can define the definition of a Functor for the automatic differentiation of a Functor built out of these primitives:


instance (Derivable f, Functor (AD (D f))) => Functor (AD f) where
fmap f = Power . bimap (fmap f) (fmap f) . runPower


Unfortunately, here is where I run out of steam, because any attempt to actually use the construct in question blows the context stack because the recursion for Functor (AD f) isn't well founded and my attempts to force it to be so through overlapping-instances have thus-far failed.

Thoughts?