Automatic Recognition of Functors

Folks, Given f:: a -> b it is very natural to lift f to P f :: P a -> P b where P is the power set functor. Or L f :: [a] -> [b]. We are modeling structures using repeated application of the power functor, via repeated application of [ ]. It would be very nice if Haskell would recognize this lifting. That is, if f :: a -> b then one automatically has f :: [a] -> [b] without using fMap. We can do something similar with classes in the following way: Given class Addy a where (+.) :: a -> a -> a instance(Addy a) => Addy [ a] (+.) w [ ] = w (+.) [ ] w = w (+.) (a:as) (b:bs) = (a+b) :(as + bs) Now given instance Addy Int (+.) x y = x+y One can compute [[1,2],[3,4]] +. [ [2,3],[1,2,.3]]. I know I'm asking for a bit more here. I might need to use fMap f : [ a] -> [ b]. But I can't seem to get by with fMap f [[1,2],[3,4]] when f :: Int -> Int We often need to lift functions to higher power maps. It would be nice to have a way to do this with ease. Suggestions are welcome. Walt

Walter Potter wrote:
Folks,
Given f:: a -> b it is very natural to lift f to P f :: P a -> P b where P is the power set functor. Or L f :: [a] -> [b].
We are modeling structures using repeated application of the power functor, via repeated application of [ ].
It would be very nice if Haskell would recognize this lifting. That is, if f :: a -> b then one automatically has f :: [a] -> [b] without using fMap.
We can do something similar with classes in the following way:
Given
class Addy a where (+.) :: a -> a -> a
instance(Addy a) => Addy [ a] (+.) w [ ] = w (+.) [ ] w = w (+.) (a:as) (b:bs) = (a+b) :(as + bs)
Now given
instance Addy Int (+.) x y = x+y
One can compute [[1,2],[3,4]] +. [ [2,3],[1,2,.3]].
I know I'm asking for a bit more here. I might need to use fMap f : [ a] -> [ b]. But I can't seem to get by with fMap f [[1,2],[3,4]] when f :: Int -> Int
We often need to lift functions to higher power maps.
It would be nice to have a way to do this with ease.
You could try to overload the specific f you want to lift, but I guess that you have arbitrary f that need to be lifted. By introducing explicit functor composition, you can reduce multiple liftings to a single one: newtype Comp f g a = Comp { unComp :: f (g a)) } deriving (Show,Eq) instance (Functor f, Functor g) => Functor (Comp f g) where fmap f = Comp . fmap (fmap f) . unComp
fmap (+1) $ Comp [[1,2],[3,4]] Comp {unComp = [[2,3],[4,5]]}
Of course, this shifts the problem because now, you have to lift into a stack of 'Comp's like 'Comp (Comp f g) h'. But it may be useful if you are working with abstract types anyway. Regards, apfelmus

This link might be what you are after:
http://okmij.org/ftp/Haskell/typecast.html#deepest-functor
On 3/1/07, Walter Potter
Folks,
Given f:: a -> b it is very natural to lift f to P f :: P a -> P b where P is the power set functor. Or L f :: [a] -> [b].
We are modeling structures using repeated application of the power functor, via repeated application of [ ].
It would be very nice if Haskell would recognize this lifting. That is, if f :: a -> b then one automatically has f :: [a] -> [b] without using fMap.
We can do something similar with classes in the following way:
Given
class Addy a where (+.) :: a -> a -> a
instance(Addy a) => Addy [ a] (+.) w [ ] = w (+.) [ ] w = w (+.) (a:as) (b:bs) = (a+b) :(as + bs)
Now given
instance Addy Int (+.) x y = x+y
One can compute [[1,2],[3,4]] +. [ [2,3],[1,2,.3]].
I know I'm asking for a bit more here. I might need to use fMap f : [ a] -> [ b]. But I can't seem to get by with fMap f [[1,2],[3,4]] when f :: Int -> Int
We often need to lift functions to higher power maps.
It would be nice to have a way to do this with ease.
Suggestions are welcome.
Walt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (3)
-
apfelmus@quantentunnel.de
-
Nicolas Frisby
-
Walter Potter