Is there already an abstraction for this?

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
13 messages Options
Reply | Threaded
Open this post in threaded view
|

Is there already an abstraction for this?

Jeremy Shaw-3
Hello,

I am trying to figure out if there is an existing abstraction I am
missing here.

I have an expression data-type:

> data Expr
>    = Quotient Expr Expr
>    | Product Expr Expr
>    | Sum Expr Expr
>    | Difference Expr Expr
>    | Lit Double
>    | Var Char
>      deriving (Eq, Ord, Data, Typeable, Read, Show)
>

And I want to write a function that will take an expression and
automatically apply the identity laws to simplify the expression.

The basic identity laws are:

 a + 0 = a
 a * 1 = a

I can implement these with some 'sugar' as:

> identity (Sum (Lit 0) a)        = a
> identity (Sum a (Lit 0))        = a
> identity (Difference a (Lit 0)) = a
> identity (Product a (Lit 1))    = a
> identity (Product (Lit 1) a)    = a
> identity (Quotient a (Lit 1))   = a
> identity a                      = a

This works fine when the identity only needs to be applied to the root
of the expression tree:

*Main> ppExpr $ identity (expr "1 + 0")
1

But for more complicated trees it does not fully apply the identity laws:

*Main> ppExpr $ identity (expr "0 + (0 + 0) + (0 + 0)")
((0 + 0) + (0 + 0))

What we need to do is first apply the identity function to the
children, and then apply them to the parent of the updated children. A
first attempt would be to extend the identity function like this:

> identity (Sum a b)              = identity (Sum (identity a) (identity b))

However, that will not terminate because that same case will keep
matching over and over. Another approach is to have two mutually
recursive functions like:

> identity' (Sum (Lit 0) a)        = identityRec a
> identity' (Sum a (Lit 0))        = identityRec a
> identity' a = a

> identityRec (Sum a b) = identity' (Sum (identity' a) (identity' b))

This prevents non-termination, but you have to be careful about
calling identity' vs identityRec or you will either re-introduce
non-termination, or you may not fully apply the identity laws.

Another option to create a helper function like:

> -- |Deep map of an expression.
> eMap :: (Expr -> Expr) -> Expr -> Expr
> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
> eMap f (Var v) = f (Var v)
> eMap f (Lit i) = f (Lit i)

Now we can easily apply the identity law recursively like:

> deepIdentity :: Expr -> Expr
> deepIdentity = eMap identity

*Main> ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)"))
0

Sweet!

But, having to write eMap out by hand like that somehow feels wrong --
as if I am missing some additional abstraction. In some respects eMap
is like a Functor, but not quite. I expect there is a way to implement
eMap using Data.Generics, which is perhaps better, but I still feel
like that is missing something?

Anyway, I just thought I would ask in case someone recognized this
pattern and could point me in the right direction. I have attached a
working example program you can play with.

I would also be interested in alternative approaches besides the ones
I outlined.

thanks!
j.

>{-# LANGUAGE DeriveDataTypeable #-}

>
> import Control.Applicative (Applicative((<*>), pure), (*>), (<*))
> import Control.Monad (ap)
> import Data.Generics (Typeable, Data)
> import Data.List (isSuffixOf)
> import           Text.ParserCombinators.Parsec  ((<|>))
> import qualified Text.ParserCombinators.Parsec as P
> import qualified Text.ParserCombinators.Parsec.Expr as P
> import           Text.PrettyPrint.HughesPJ ((<+>))
> import qualified Text.PrettyPrint.HughesPJ as H
> import Prelude hiding (sum, product)
>
> data Expr
>    = Quotient Expr Expr
>    | Product Expr Expr
>    | Sum Expr Expr
>    | Difference Expr Expr
>    | Lit Double
>    | Var Char
>      deriving (Eq, Ord, Data, Typeable, Read, Show)
>
> instance Applicative (P.GenParser token state) where
>     pure = return
>     (<*>) = ap
>
> parseExpr :: P.GenParser Char st Expr
> parseExpr = P.buildExpressionParser optable (lit <|> var <|> parenExpr)
>     where
>       parenExpr =
>           (P.char '(' >> P.skipMany P.space) *> parseExpr <* (P.char ')' >> P.skipMany P.space)
>       optable =
>           [ [ P.Infix (P.char '/' >> P.skipMany P.space >> return Quotient)  P.AssocLeft  ]
>           , [ P.Infix (P.char '*' >> P.skipMany P.space >> return Product)    P.AssocRight ]
>           , [ P.Infix (P.char '+' >> P.skipMany P.space >> return Sum)        P.AssocRight ]
>           , [ P.Infix (P.char '-' >> P.skipMany P.space >> return Difference) P.AssocLeft  ]
>           ]
>       lit =
>           do d <- P.try (P.many1 $ P.oneOf ('-' : '.' : ['0'..'9']))
>              P.skipMany P.space
>              return (Lit (read d))
>       var =
>           do sign <- (P.char '-' >> return (\x -> (Product (Lit (-1)) x))) <|> (return id)
>              v <- (P.upper <|> P.lower)
>              P.skipMany P.space
>              return (sign (Var v))
>
> expr :: String -> Expr
> expr str = either (error .show) id (P.parse parseExpr str str)
>
> ppExpr :: Expr -> H.Doc
> ppExpr (Lit i)          = H.text (let f s = if isSuffixOf ".0" s then init(init s) else s in f $ show i)
> ppExpr (Var v)          = H.char v
> ppExpr (Quotient x y)   = H.parens (ppExpr x <+> H.char '/' <+> ppExpr y)
> ppExpr (Product x y)    = H.parens (ppExpr x <+> H.char '*' <+> ppExpr y)
> ppExpr (Sum x y)        = H.parens (ppExpr x <+> H.char '+' <+> ppExpr y)
> ppExpr (Difference x y) = H.parens (ppExpr x <+> H.char '-' <+> ppExpr y)

> -- |Deep map of an expression.
> eMap :: (Expr -> Expr) -> Expr -> Expr
> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
> eMap f (Var v) = f (Var v)
> eMap f (Lit i) = f (Lit i)

> identity (Sum (Lit 0) a)        = a
> identity (Sum a (Lit 0))        = a
> identity (Difference a (Lit 0)) = a
> identity (Product a (Lit 1))    = a
> identity (Product (Lit 1) a)    = a
> identity (Quotient a (Lit 1))   = a
> identity a                      = a

> deepIdentity :: Expr -> Expr
> deepIdentity = eMap identity

> test :: IO ()
> test =
>     do print (ppExpr (deepIdentity (expr "1 + 2")))
>        print (ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)")))

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Dan Weston
 > I can implement these with some 'sugar' as:
 >
 >> identity (Sum (Lit 0) a)        = a
 >> identity (Sum a (Lit 0))        = a
 >> identity (Difference a (Lit 0)) = a
 >> identity (Product a (Lit 1))    = a
 >> identity (Product (Lit 1) a)    = a
 >> identity (Quotient a (Lit 1))   = a
 >> identity a                      = a

Why do you need mutual recursion? What's wrong with:

  identity (Sum (Lit 0) a)        = identity a
   ...
  identity (Quotient a (Lit 1))   = identity a
  identity a                      = a

Structural recursion ensures that this always terminates.

Dan

Jeremy Shaw wrote:

> Hello,
>
> I am trying to figure out if there is an existing abstraction I am
> missing here.
>
> I have an expression data-type:
>
>> data Expr
>>    = Quotient Expr Expr
>>    | Product Expr Expr
>>    | Sum Expr Expr
>>    | Difference Expr Expr
>>    | Lit Double
>>    | Var Char
>>      deriving (Eq, Ord, Data, Typeable, Read, Show)
>>
>
> And I want to write a function that will take an expression and
> automatically apply the identity laws to simplify the expression.
>
> The basic identity laws are:
>
>  a + 0 = a
>  a * 1 = a
>
> I can implement these with some 'sugar' as:
>
>> identity (Sum (Lit 0) a)        = a
>> identity (Sum a (Lit 0))        = a
>> identity (Difference a (Lit 0)) = a
>> identity (Product a (Lit 1))    = a
>> identity (Product (Lit 1) a)    = a
>> identity (Quotient a (Lit 1))   = a
>> identity a                      = a
>
> This works fine when the identity only needs to be applied to the root
> of the expression tree:
>
> *Main> ppExpr $ identity (expr "1 + 0")
> 1
>
> But for more complicated trees it does not fully apply the identity laws:
>
> *Main> ppExpr $ identity (expr "0 + (0 + 0) + (0 + 0)")
> ((0 + 0) + (0 + 0))
>
> What we need to do is first apply the identity function to the
> children, and then apply them to the parent of the updated children. A
> first attempt would be to extend the identity function like this:
>
>> identity (Sum a b)              = identity (Sum (identity a) (identity b))
>
> However, that will not terminate because that same case will keep
> matching over and over. Another approach is to have two mutually
> recursive functions like:
>
>> identity' (Sum (Lit 0) a)        = identityRec a
>> identity' (Sum a (Lit 0))        = identityRec a
>> identity' a = a
>
>> identityRec (Sum a b) = identity' (Sum (identity' a) (identity' b))
>
> This prevents non-termination, but you have to be careful about
> calling identity' vs identityRec or you will either re-introduce
> non-termination, or you may not fully apply the identity laws.
>
> Another option to create a helper function like:
>
>> -- |Deep map of an expression.
>> eMap :: (Expr -> Expr) -> Expr -> Expr
>> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
>> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
>> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
>> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
>> eMap f (Var v) = f (Var v)
>> eMap f (Lit i) = f (Lit i)
>
> Now we can easily apply the identity law recursively like:
>
>> deepIdentity :: Expr -> Expr
>> deepIdentity = eMap identity
>
> *Main> ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)"))
> 0
>
> Sweet!
>
> But, having to write eMap out by hand like that somehow feels wrong --
> as if I am missing some additional abstraction. In some respects eMap
> is like a Functor, but not quite. I expect there is a way to implement
> eMap using Data.Generics, which is perhaps better, but I still feel
> like that is missing something?
>
> Anyway, I just thought I would ask in case someone recognized this
> pattern and could point me in the right direction. I have attached a
> working example program you can play with.
>
> I would also be interested in alternative approaches besides the ones
> I outlined.
>
> thanks!
> j.
>
>
> ------------------------------------------------------------------------
>
> _______________________________________________
> Haskell-Cafe mailing list
> [hidden email]
> http://www.haskell.org/mailman/listinfo/haskell-cafe


_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Dan Weston
Oops, never mind. This is just the shallow application you referred to.
Too fast with that send button!

Dan Weston wrote:

>
>  > I can implement these with some 'sugar' as:
>  >
>  >> identity (Sum (Lit 0) a)        = a
>  >> identity (Sum a (Lit 0))        = a
>  >> identity (Difference a (Lit 0)) = a
>  >> identity (Product a (Lit 1))    = a
>  >> identity (Product (Lit 1) a)    = a
>  >> identity (Quotient a (Lit 1))   = a
>  >> identity a                      = a
>
> Why do you need mutual recursion? What's wrong with:
>
>  identity (Sum (Lit 0) a)        = identity a
>   ...
>  identity (Quotient a (Lit 1))   = identity a
>  identity a                      = a
>
> Structural recursion ensures that this always terminates.
>
> Dan
>
> Jeremy Shaw wrote:
>> Hello,
>>
>> I am trying to figure out if there is an existing abstraction I am
>> missing here.
>>
>> I have an expression data-type:
>>
>>> data Expr    = Quotient Expr Expr
>>>    | Product Expr Expr
>>>    | Sum Expr Expr
>>>    | Difference Expr Expr
>>>    | Lit Double
>>>    | Var Char
>>>      deriving (Eq, Ord, Data, Typeable, Read, Show)
>>>
>>
>> And I want to write a function that will take an expression and
>> automatically apply the identity laws to simplify the expression.
>>
>> The basic identity laws are:
>>
>>  a + 0 = a
>>  a * 1 = a
>>
>> I can implement these with some 'sugar' as:
>>
>>> identity (Sum (Lit 0) a)        = a
>>> identity (Sum a (Lit 0))        = a
>>> identity (Difference a (Lit 0)) = a
>>> identity (Product a (Lit 1))    = a
>>> identity (Product (Lit 1) a)    = a
>>> identity (Quotient a (Lit 1))   = a
>>> identity a                      = a
>>
>> This works fine when the identity only needs to be applied to the root
>> of the expression tree:
>>
>> *Main> ppExpr $ identity (expr "1 + 0")
>> 1
>>
>> But for more complicated trees it does not fully apply the identity laws:
>>
>> *Main> ppExpr $ identity (expr "0 + (0 + 0) + (0 + 0)")
>> ((0 + 0) + (0 + 0))
>>
>> What we need to do is first apply the identity function to the
>> children, and then apply them to the parent of the updated children. A
>> first attempt would be to extend the identity function like this:
>>
>>> identity (Sum a b)              = identity (Sum (identity a)
>>> (identity b))
>>
>> However, that will not terminate because that same case will keep
>> matching over and over. Another approach is to have two mutually
>> recursive functions like:
>>
>>> identity' (Sum (Lit 0) a)        = identityRec a
>>> identity' (Sum a (Lit 0))        = identityRec a
>>> identity' a = a
>>
>>> identityRec (Sum a b) = identity' (Sum (identity' a) (identity' b))
>>
>> This prevents non-termination, but you have to be careful about
>> calling identity' vs identityRec or you will either re-introduce
>> non-termination, or you may not fully apply the identity laws.
>>
>> Another option to create a helper function like:
>>
>>> -- |Deep map of an expression.
>>> eMap :: (Expr -> Expr) -> Expr -> Expr
>>> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
>>> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
>>> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
>>> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
>>> eMap f (Var v) = f (Var v)
>>> eMap f (Lit i) = f (Lit i)
>>
>> Now we can easily apply the identity law recursively like:
>>
>>> deepIdentity :: Expr -> Expr
>>> deepIdentity = eMap identity
>>
>> *Main> ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)"))
>> 0
>>
>> Sweet!
>>
>> But, having to write eMap out by hand like that somehow feels wrong --
>> as if I am missing some additional abstraction. In some respects eMap
>> is like a Functor, but not quite. I expect there is a way to implement
>> eMap using Data.Generics, which is perhaps better, but I still feel
>> like that is missing something?
>>
>> Anyway, I just thought I would ask in case someone recognized this
>> pattern and could point me in the right direction. I have attached a
>> working example program you can play with.
>>
>> I would also be interested in alternative approaches besides the ones
>> I outlined.
>>
>> thanks!
>> j.
>>
>>
>> ------------------------------------------------------------------------
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> [hidden email]
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>


_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Sebastian Fischer
In reply to this post by Jeremy Shaw-3
Hi Jeremy,

There are some approaches that support such generic transformations.  
The simplest is probably Uniplate by Neil Mitchell:

   http://www-users.cs.york.ac.uk/~ndm/uniplate/

The function 'rewrite' is what you are looking for. If you change the  
definition of 'identity' to:

> identity (Sum (Lit 0) a)        = Just a
> identity (Sum a (Lit 0))        = Just a
> identity (Difference a (Lit 0)) = Just a
> identity (Product a (Lit 1))    = Just a
> identity (Product (Lit 1) a)    = Just a
> identity (Quotient a (Lit 1))   = Just a
> identity _                      = Nothing

then the function 'rewrite identity :: Expr -> Expr' does what you want.

Cheers,
Sebastian
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Nicolas Pouillard-2
In reply to this post by Jeremy Shaw-3
Excerpts from Jeremy Shaw's message of Mon Sep 22 18:46:22 -0700 2008:
> Hello,
>
> I am trying to figure out if there is an existing abstraction I am
> missing here.

You can try to pick some information in the mocac [1] project, that is for
OCaml.

 <<
  Moca is a general construction functions generator for Caml data types with
  invariants.

  Moca supports two kinds of relations:

  * algebraic relations (such as associativity or commutativity of a
    binary constructor),
  * general rewrite rules that map some pattern of constructors and
    variables to some arbitrary user's define expression.
 >>

[1]: http://moca.inria.fr/eng.htm

Best regards,

> I have an expression data-type:
>
> > data Expr
> >    = Quotient Expr Expr
> >    | Product Expr Expr
> >    | Sum Expr Expr
> >    | Difference Expr Expr
> >    | Lit Double
> >    | Var Char
> >      deriving (Eq, Ord, Data, Typeable, Read, Show)
> >
>
> And I want to write a function that will take an expression and
> automatically apply the identity laws to simplify the expression.
>
> The basic identity laws are:
>
>  a + 0 = a
>  a * 1 = a
>
> I can implement these with some 'sugar' as:
>
> > identity (Sum (Lit 0) a)        = a
> > identity (Sum a (Lit 0))        = a
> > identity (Difference a (Lit 0)) = a
> > identity (Product a (Lit 1))    = a
> > identity (Product (Lit 1) a)    = a
> > identity (Quotient a (Lit 1))   = a
> > identity a                      = a
>
> This works fine when the identity only needs to be applied to the root
> of the expression tree:
>
> *Main> ppExpr $ identity (expr "1 + 0")
> 1
>
> But for more complicated trees it does not fully apply the identity laws:
>
> *Main> ppExpr $ identity (expr "0 + (0 + 0) + (0 + 0)")
> ((0 + 0) + (0 + 0))
>
> What we need to do is first apply the identity function to the
> children, and then apply them to the parent of the updated children. A
> first attempt would be to extend the identity function like this:
>
> > identity (Sum a b)              = identity (Sum (identity a) (identity b))
>
> However, that will not terminate because that same case will keep
> matching over and over. Another approach is to have two mutually
> recursive functions like:
>
> > identity' (Sum (Lit 0) a)        = identityRec a
> > identity' (Sum a (Lit 0))        = identityRec a
> > identity' a = a
>
> > identityRec (Sum a b) = identity' (Sum (identity' a) (identity' b))
>
> This prevents non-termination, but you have to be careful about
> calling identity' vs identityRec or you will either re-introduce
> non-termination, or you may not fully apply the identity laws.
>
> Another option to create a helper function like:
>
> > -- |Deep map of an expression.
> > eMap :: (Expr -> Expr) -> Expr -> Expr
> > eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
> > eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
> > eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
> > eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
> > eMap f (Var v) = f (Var v)
> > eMap f (Lit i) = f (Lit i)
>
> Now we can easily apply the identity law recursively like:
>
> > deepIdentity :: Expr -> Expr
> > deepIdentity = eMap identity
>
> *Main> ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)"))
> 0
>
> Sweet!
>
> But, having to write eMap out by hand like that somehow feels wrong --
> as if I am missing some additional abstraction. In some respects eMap
> is like a Functor, but not quite. I expect there is a way to implement
> eMap using Data.Generics, which is perhaps better, but I still feel
> like that is missing something?
>
> Anyway, I just thought I would ask in case someone recognized this
> pattern and could point me in the right direction. I have attached a
> working example program you can play with.
>
> I would also be interested in alternative approaches besides the ones
> I outlined.
>
> thanks!
> j.
> >{-# LANGUAGE DeriveDataTypeable #-}
> >
> > import Control.Applicative (Applicative((<*>), pure), (*>), (<*))
> > import Control.Monad (ap)
> > import Data.Generics (Typeable, Data)
> > import Data.List (isSuffixOf)
> > import           Text.ParserCombinators.Parsec  ((<|>))
> > import qualified Text.ParserCombinators.Parsec as P
> > import qualified Text.ParserCombinators.Parsec.Expr as P
> > import           Text.PrettyPrint.HughesPJ ((<+>))
> > import qualified Text.PrettyPrint.HughesPJ as H
> > import Prelude hiding (sum, product)
> >
> > data Expr
> >    = Quotient Expr Expr
> >    | Product Expr Expr
> >    | Sum Expr Expr
> >    | Difference Expr Expr
> >    | Lit Double
> >    | Var Char
> >      deriving (Eq, Ord, Data, Typeable, Read, Show)
> >
> > instance Applicative (P.GenParser token state) where
> >     pure = return
> >     (<*>) = ap
> >
> > parseExpr :: P.GenParser Char st Expr
> > parseExpr = P.buildExpressionParser optable (lit <|> var <|> parenExpr)
> >     where
> >       parenExpr =
> >           (P.char '(' >> P.skipMany P.space) *> parseExpr <* (P.char ')' >> P.skipMany P.space)
> >       optable =
> >           [ [ P.Infix (P.char '/' >> P.skipMany P.space >> return Quotient)  P.AssocLeft  ]
> >           , [ P.Infix (P.char '*' >> P.skipMany P.space >> return Product)    P.AssocRight ]
> >           , [ P.Infix (P.char '+' >> P.skipMany P.space >> return Sum)        P.AssocRight ]
> >           , [ P.Infix (P.char '-' >> P.skipMany P.space >> return Difference) P.AssocLeft  ]
> >           ]
> >       lit =
> >           do d <- P.try (P.many1 $ P.oneOf ('-' : '.' : ['0'..'9']))
> >              P.skipMany P.space
> >              return (Lit (read d))
> >       var =
> >           do sign <- (P.char '-' >> return (\x -> (Product (Lit (-1)) x))) <|> (return id)
> >              v <- (P.upper <|> P.lower)
> >              P.skipMany P.space
> >              return (sign (Var v))
> >
> > expr :: String -> Expr
> > expr str = either (error .show) id (P.parse parseExpr str str)
> >
> > ppExpr :: Expr -> H.Doc
> > ppExpr (Lit i)          = H.text (let f s = if isSuffixOf ".0" s then init(init s) else s in f $ show i)
> > ppExpr (Var v)          = H.char v
> > ppExpr (Quotient x y)   = H.parens (ppExpr x <+> H.char '/' <+> ppExpr y)
> > ppExpr (Product x y)    = H.parens (ppExpr x <+> H.char '*' <+> ppExpr y)
> > ppExpr (Sum x y)        = H.parens (ppExpr x <+> H.char '+' <+> ppExpr y)
> > ppExpr (Difference x y) = H.parens (ppExpr x <+> H.char '-' <+> ppExpr y)
>
> > -- |Deep map of an expression.
> > eMap :: (Expr -> Expr) -> Expr -> Expr
> > eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
> > eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
> > eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
> > eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
> > eMap f (Var v) = f (Var v)
> > eMap f (Lit i) = f (Lit i)
>
> > identity (Sum (Lit 0) a)        = a
> > identity (Sum a (Lit 0))        = a
> > identity (Difference a (Lit 0)) = a
> > identity (Product a (Lit 1))    = a
> > identity (Product (Lit 1) a)    = a
> > identity (Quotient a (Lit 1))   = a
> > identity a                      = a
>
> > deepIdentity :: Expr -> Expr
> > deepIdentity = eMap identity
>
> > test :: IO ()
> > test =
> >     do print (ppExpr (deepIdentity (expr "1 + 2")))
> >        print (ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)")))
--
Nicolas Pouillard aka Ertai

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe

signature.asc (201 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Jake Mcarthur-2
In reply to this post by Jeremy Shaw-3
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

The first thing I thought of was to try to apply one of the recursion  
schemes
in the category-extras package. Here is what I managed using  
catamorphism.

- - Jake

- --------------------------------------------------------------------------------

data Expr' a
   = Quotient a a
   | Product a a
   | Sum a a
   | Difference a a
   | Lit Double
   | Var Char

type Expr = FixF Expr'

instance Functor Expr' where
     fmap f (a `Quotient` b) = f a `Quotient` f b
     fmap f (a `Product` b) = f a `Product` f b
     fmap f (a `Sum` b) = f a `Sum` f b
     fmap f (a `Difference` b) = f a `Difference` f b
     fmap _ (Lit x) = Lit x
     fmap _ (Var x) = Var x

identity = cata ident
     where ident (a `Quotient` InF (Lit 1)) = a
           ident (a `Product` InF (Lit 1)) = a
           ident (InF (Lit 1) `Product` b) = b
           ident (a `Sum` InF (Lit 0)) = a
           ident (InF (Lit 0) `Sum` b) = b
           ident (a `Difference` InF (Lit 0)) = a
           ident (Lit x) = InF $ Lit x
           ident (Var x) = InF $ Var x
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.8 (Darwin)

iEYEARECAAYFAkjYhjwACgkQye5hVyvIUKnwhgCgypz0ppFgqn2dMhoJPUzO4+J1
BMUAni277vm9d2e5wTFt2Qrx+DDVjs6z
=0SHe
-----END PGP SIGNATURE-----
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Sebastiaan Visser-2
In reply to this post by Jeremy Shaw-3
This (recent) paper describes a very interesting way to perform  
generic term rewriting:
http://www.cs.uu.nl/research/techreps/repo/CS-2008/2008-020.pdf

On Sep 23, 2008, at 3:46 AM, Jeremy Shaw wrote:

> Hello,
>
> I am trying to figure out if there is an existing abstraction I am
> missing here.
>
> I have an expression data-type:
>
>> data Expr
>>   = Quotient Expr Expr
>>   | Product Expr Expr
>>   | Sum Expr Expr
>>   | Difference Expr Expr
>>   | Lit Double
>>   | Var Char
>>     deriving (Eq, Ord, Data, Typeable, Read, Show)
>>
>
> And I want to write a function that will take an expression and
> automatically apply the identity laws to simplify the expression.
>
> The basic identity laws are:
>
> a + 0 = a
> a * 1 = a
>
> I can implement these with some 'sugar' as:
>
>> identity (Sum (Lit 0) a)        = a
>> identity (Sum a (Lit 0))        = a
>> identity (Difference a (Lit 0)) = a
>> identity (Product a (Lit 1))    = a
>> identity (Product (Lit 1) a)    = a
>> identity (Quotient a (Lit 1))   = a
>> identity a                      = a
>
> This works fine when the identity only needs to be applied to the root
> of the expression tree:
>
> *Main> ppExpr $ identity (expr "1 + 0")
> 1
>
> But for more complicated trees it does not fully apply the identity  
> laws:
>
> *Main> ppExpr $ identity (expr "0 + (0 + 0) + (0 + 0)")
> ((0 + 0) + (0 + 0))
>
> What we need to do is first apply the identity function to the
> children, and then apply them to the parent of the updated children. A
> first attempt would be to extend the identity function like this:
>
>> identity (Sum a b)              = identity (Sum (identity a)  
>> (identity b))
>
> However, that will not terminate because that same case will keep
> matching over and over. Another approach is to have two mutually
> recursive functions like:
>
>> identity' (Sum (Lit 0) a)        = identityRec a
>> identity' (Sum a (Lit 0))        = identityRec a
>> identity' a = a
>
>> identityRec (Sum a b) = identity' (Sum (identity' a) (identity' b))
>
> This prevents non-termination, but you have to be careful about
> calling identity' vs identityRec or you will either re-introduce
> non-termination, or you may not fully apply the identity laws.
>
> Another option to create a helper function like:
>
>> -- |Deep map of an expression.
>> eMap :: (Expr -> Expr) -> Expr -> Expr
>> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
>> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
>> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
>> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
>> eMap f (Var v) = f (Var v)
>> eMap f (Lit i) = f (Lit i)
>
> Now we can easily apply the identity law recursively like:
>
>> deepIdentity :: Expr -> Expr
>> deepIdentity = eMap identity
>
> *Main> ppExpr (deepIdentity (expr "0 + (0 + 0) + (0 + 0)"))
> 0
>
> Sweet!
>
> But, having to write eMap out by hand like that somehow feels wrong --
> as if I am missing some additional abstraction. In some respects eMap
> is like a Functor, but not quite. I expect there is a way to implement
> eMap using Data.Generics, which is perhaps better, but I still feel
> like that is missing something?
>
> Anyway, I just thought I would ask in case someone recognized this
> pattern and could point me in the right direction. I have attached a
> working example program you can play with.
>
> I would also be interested in alternative approaches besides the ones
> I outlined.
>
> thanks!
> j.
>> ...
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Christian Maeder-2
In reply to this post by Jeremy Shaw-3
Jeremy Shaw wrote:

> I have an expression data-type:
>
>> data Expr
>>    = Quotient Expr Expr
>>    | Product Expr Expr
>>    | Sum Expr Expr
>>    | Difference Expr Expr
>>    | Lit Double
>>    | Var Char
>>      deriving (Eq, Ord, Data, Typeable, Read, Show)

I prefer such expressions written as:

 data BinOp = Quotient | Product | Sum | Difference
 data Expr =
     BinExpr BinOp Expr Expr
   | Lit Double
   | Var Char

This avoids a lot of code duplication, i.e. in your eMap function:

>> eMap :: (Expr -> Expr) -> Expr -> Expr
>> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
>> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
>> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
>> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
>> eMap f (Var v) = f (Var v)
>> eMap f (Lit i) = f (Lit i)

Furthermore, I usually write a fold Function via a record type as follows:

data ExprRecord a = ExprRecord
  { foldBinExpr :: BinOp -> a -> a -> a
  , foldLit :: Double -> a
  , foldVar :: Char -> a }

foldExpr :: ExprRecord a -> Expr -> a
foldExpr r e = case e of
  BinExpr o e1 e2 -> foldBinExpr r o (foldExpr r e1) (foldExpr r e2)
  Lit d -> foldLit r d
  Var c -> foldVar r c

Given an "ExprRecord a" an Expr is folded into something of type a. In
applications only the recursion does not need to be written (over and
over) again.

idRecord :: ExprRecord Expr
idRecord = ExprRecord
  { foldBinExpr = BinExpr
  , foldLit = Lit
  , foldVar = Var }

The identity record is only used to modify it for the map record

mapRecord :: (Expr -> Expr) -> ExprRecord Expr
mapRecord f = idRecord
  { foldBinExpr = \ o e1 e2 -> f (BinExpr o e1 e2) }

eMap f = foldExpr (mapRecord f)

ppBinOp :: BinOp -> Doc
ppBinOp = ...

ppExpr = foldExpr ExprRecord
  { foldBinExpr = \ o d1 d2 -> parens (d1 <+> ppBinOp o <+> d2)
  , foldLit = \ d -> text (show d)
  , foldVar = \ c -> text (show c) }

I wonder if the record data type and the fold function can be derived
automatically.

Cheers Christian

An extension is to add the original expression as argument, too, for
case I don't need the folded exprs or need to know both the original and
the folded exprs.

data ExprRecord a = ExprRecord
  { foldBinExpr :: Expr -> BinOp -> a -> a -> a
  , foldLit :: Expr -> Double -> a
  , foldVar :: Expr -> Char -> a }

foldExpr :: ExprRecord a -> Expr -> a
foldExpr r e = case e of
  BinExpr o e1 e2 -> foldBinExpr r e o (foldExpr r e1) (foldExpr r e2)
  Lit d -> foldLit r e d
  Var c -> foldVar r e c

idRecord :: ExprRecord Expr
idRecord = ExprRecord
  { foldBinExpr = \ _ -> BinExpr
  , foldLit = \ _ -> Lit
  , foldVar = \ _ -> Var }

mapRecord :: (Expr -> Expr) -> ExprRecord Expr
mapRecord f = idRecord
  { foldBinExpr = \ _ o e1 e2 -> f (BinExpr e1 e2) }

When defining foldBinExpr the first argument (unused for map) can be
assumed to be of case "BinExpr o t1 t2".

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

wren ng thornton
In reply to this post by Jeremy Shaw-3
Jeremy Shaw wrote:
>> -- |Deep map of an expression.
>> eMap :: (Expr -> Expr) -> Expr -> Expr
>> eMap f (Sum a b) = f (Sum (eMap f a) (eMap f b))
>> eMap f (Difference a b) = f (Difference (eMap f a) (eMap f b))
>> eMap f (Product a b) = f (Product (eMap f a) (eMap f b))
>> eMap f (Quotient a b) = f (Quotient (eMap f a) (eMap f b))
>> eMap f (Var v) = f (Var v)
>> eMap f (Lit i) = f (Lit i)


Jake beat me to the punch, but this is exactly a catamorphism[1].
Generally ---as in, "with full generality"--- this is phrased in terms
of recursion over the least fixed point of a functor (as presented by
Jake), but your version is more direct about what's going on.

The short explanation is that |cata f| applies |f| over a recursive
datastructure once at each level from the bottom up. A fairly trivial
example of this is the |maybe| function for Maybe, an easy non-trivial
example is the |foldr| function over lists[2]. Your code is giving the
version for binary trees (with Var/Lit serving as []/Nothing to
terminate the recursion).

A few months ago vicky wrote some code to automatically generate
catamorphisms at a particular recursive type[3], though I can't say that
it'd be very helpful if you didn't already know what was going on. In
addition to Edward Kmett's work, Wouter Swierstra's _Data Types a la
Carte_[4] may be helpful to work through.

In the end you'll probably just want to stick with the above, unless you
really have something to gain by adding in the additional generality of
category-extras or DTalC. Things you may wish to gain: a better
understanding of category theory; other recursion patterns for free;
ability to open up the Expr coproduct; higher-order aesthetics.



[1] http://comonad.com/reader/2008/catamorphism

[2] Though the Prelude/Data.List version of that abstract function
reifies the two bodies of "f" as two separate arguments. Similarly for
|maybe|. In general there's a body of f for each branch of the
union/coproduct.

[3] http://hpaste.org/7682

[4] http://wadler.blogspot.com/2008/02/data-types-la-carte.html

--
Live well,
~wren
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

ajb@spamcop.net
In reply to this post by Jeremy Shaw-3
G'day.

Quoting Jeremy Shaw <[hidden email]>:

> I have an expression data-type:
>
>> data Expr
>>    = Quotient Expr Expr
>>    | Product Expr Expr
>>    | Sum Expr Expr
>>    | Difference Expr Expr
>>    | Lit Double
>>    | Var Char
>>      deriving (Eq, Ord, Data, Typeable, Read, Show)

> And I want to write a function that will take an expression and
> automatically apply the identity laws to simplify the expression.

[...]

> I would also be interested in alternative approaches besides the ones
> I outlined.

A low-tech alternative that would work here is to use smart
constructors.  This approach avoids non-termination, and allows for
quite general transformations.

Example:

sum :: Expr -> Expr -> Expr
sum (Lit 0) y = y
sum x (Lit 0) = x
sum (Lit x) (Lit y) = lit (x+y)  -- Call smart constructors recursively
sum (Var v1) (Var v2) | v1 == v2 = product (Lit 2) (Var v1) -- Guards are OK
sum x y@(Sum _ _)
     = foldl1 sum x . getTerms y $ []
         -- So is complex stuff.
         -- This is a simple version, but it's also not too hard to write
         -- something which rewrites (x + 1) + (y + 2) to (x + y) + 3, say.
         -- Applying the Risch structure theorem is left as an exercise.
     where
         getTerms (Sum x y) = getTerms x . getTerms y
         getTerms e = (e:)
sum x y = Sum x y  -- And here's the default case

lit :: Double -> Expr
lit = Lit -- Some constructors are trivial.  Include them anyway.

You can now either aggressively replace instances of data constructors
with smart ones (except within the smart constructors themselves!) or
write a single traversal which rewrites an expression:

simplify :: Expr -> Expr
simplify (Sum x y) = sum (simplify x) (simplify y)
simplify (Lit x) = lit x
-- etc etc

Cheers,
Andrew Bromage
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Is there already an abstraction for this?

Larry Evans-3
In reply to this post by Jake Mcarthur-2
On 09/23/08 01:01, Jake Mcarthur wrote:
 > -----BEGIN PGP SIGNED MESSAGE-----
 > Hash: SHA1
 >
 > The first thing I thought of was to try to apply one of the recursion
 > schemes
 > in the category-extras package. Here is what I managed using
catamorphism.
 >
 > - - Jake
 >
 > -
 >
--------------------------------------------------------------------------------

 >
 >
 > data Expr' a
 >   = Quotient a a
 >   | Product a a
 >   | Sum a a
 >   | Difference a a
 >   | Lit Double
 >   | Var Char
 >
 > type Expr = FixF Expr'
 >
 > instance Functor Expr' where
 >     fmap f (a `Quotient` b) = f a `Quotient` f b
 >     fmap f (a `Product` b) = f a `Product` f b
 >     fmap f (a `Sum` b) = f a `Sum` f b
 >     fmap f (a `Difference` b) = f a `Difference` f b
 >     fmap _ (Lit x) = Lit x
 >     fmap _ (Var x) = Var x
 >
 > identity = cata ident
 >     where ident (a `Quotient` InF (Lit 1)) = a
 >           ident (a `Product` InF (Lit 1)) = a
 >           ident (InF (Lit 1) `Product` b) = b
 >           ident (a `Sum` InF (Lit 0)) = a
 >           ident (InF (Lit 0) `Sum` b) = b
 >           ident (a `Difference` InF (Lit 0)) = a
 >           ident (Lit x) = InF $ Lit x
 >           ident (Var x) = InF $ Var x

According to:

   cata :: Functor f => Algebra f a -> FixF f -> a

from:

   http://comonad.com/reader/2008/catamorphism

ident must be:

   Algebra f a

for some Functor f; however, I don't see any declaration
of ident as an Algebra f a.  Could you please elaborate.
I'm trying to apply this to a simple boolean simplifier
shown in the attachement.  As near as I can figure,
maybe the f could be the ArityN in the attachment and
maybe the a would be (Arity0 ConBool var).  The output
of the last line of attachment is:

   bool_eval:f+f+v0=(:+) (Op0 (OpCon BoolFalse)) (Op0 (OpVar V0))

however, what I want is a complete reduction to:

   (OpVar V0)

How can this be done using catamorphisms?



{-# LANGUAGE PatternSignatures #-}
{-
Purpose:
  "Try out" the use of catamorphism to simplify an expression
  as far as possible.
Reference:
  Post:
    http://www.nabble.com/Re%3A-Is-there-already-an-abstraction-for-this--p19641692.html
  Headers:
    From: wren ng thornton
    Newsgroups: gmane.comp.lang.haskell.cafe
    Subject: Re: Is there already an abstraction for this?
    Date: Wed, 24 Sep 2008 00:10:29 -0400
-}
module Main where

import Array

data Arity0 con var --nullary operators
  = OpCon con -- constant
  | OpVar var -- variable
  deriving(Show)

data ArityN arity0
  = Op0 arity0
  | (:+) (ArityN arity0) (ArityN arity0)
  | (:*) (ArityN arity0) (ArityN arity0)
  deriving(Show)

infixl 6 :+
infixl 7 :*

instance Functor ArityN where
  fmap f (Op0 e) =  Op0 (f e)
  fmap f ((:+) e0 e1) = (:+) (fmap f e0) (fmap f e1)
  fmap f ((:*) e0 e1) = (:*) (fmap f e0) (fmap f e1)

data ConBool --boolean constants
  = BoolFalse
  | BoolTrue
  deriving(Enum,Show,Ord,Eq,Bounded,Ix)

data VarName --varable names
  = V0
  | V1
  | V2
  deriving(Enum,Show,Ord,Eq,Bounded,Ix)

bool_eval :: ArityN (Arity0 ConBool var) -> ArityN (Arity0 ConBool var)

bool_eval e = case e of
  { (Op0 (OpCon BoolTrue ) :+ _                     ) -> Op0 (OpCon BoolTrue)
  ; (_                     :+ Op0 (OpCon BoolTrue ) ) -> Op0 (OpCon BoolTrue)
  ; (Op0 (OpCon BoolFalse) :+ e1                    ) -> e1
  ; (e0                    :+ Op0 (OpCon BoolFalse) ) -> e0
  ; (Op0 (OpCon BoolFalse) :* _                     ) -> Op0 (OpCon BoolFalse)
  ; (_                     :* Op0 (OpCon BoolFalse) ) -> Op0 (OpCon BoolFalse)
  ; (e0                    :+ e1                    ) -> (bool_eval e0) :+ (bool_eval e1)
  ; (e0                    :* e1                    ) -> (bool_eval e0) :* (bool_eval e1)
  ; e                                                 -> e
  }

main = do
  let bool_f::ArityN (Arity0 ConBool VarName) = Op0 (OpCon BoolFalse)
  let bool_expr_f_plus_v0 = bool_f :+ Op0 (OpVar V0)
  putStr "bool_expr:f+v0="
  print bool_expr_f_plus_v0
  let bool_eval_f_plus_v0 = bool_eval bool_expr_f_plus_v0
  putStr "bool_eval:f+v0="
  print bool_eval_f_plus_v0
  let bool_expr_f_plus_f_plus_v0 = bool_f :+ bool_expr_f_plus_v0
  putStr "bool_expr:f+f+f+v0="
  print bool_expr_f_plus_f_plus_v0
  let bool_eval_f_plus_f_plus_v0 = bool_eval bool_expr_f_plus_f_plus_v0
  putStr "bool_eval:f+f+v0="
  print bool_eval_f_plus_f_plus_v0


_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

howto catamorph monoid (was Re: Is there already an abstraction for this?

Larry Evans-3
On 10/18/08 16:48, Larry Evans wrote:
[snip]
> I'm trying to apply this to a simple boolean simplifier
> shown in the attachment.  
This attachment is the same as the previous except, instead
of a boolean algebra, an monoid is used.
[snip]
> The output
> of the last line of attachment is:
>
[snip]
   mon_eval:1*1*v0=(:*) (Op0 (OpCon MonoidOne)) (Op0 (OpVar V0))
>
> however, what I want is a complete reduction to:
>
>   (OpVar V0)
>
As in the previous line beginning with mon_eval:

   mon_eval:1*v0=Op0 (OpVar V0)

> How can this be done using catamorphisms?
>

Same question w.r.t. this attachment.

TIA.

-Larry

{-# LANGUAGE PatternSignatures #-}
{-
Purpose:
  "Try out" the use of catamorphism to simplify an expression
  as far as possible.
Reference:
  Post:
    http://www.nabble.com/Re%3A-Is-there-already-an-abstraction-for-this--p19641692.html
  Headers:
    From: wren ng thornton
    Newsgroups: gmane.comp.lang.haskell.cafe
    Subject: Re: Is there already an abstraction for this?
    Date: Wed, 24 Sep 2008 00:10:29 -0400
-}
module Main where

import Array

data Arity0 con var --nullary operators
  = OpCon con -- constant
  | OpVar var -- variable
  deriving(Show)

data ArityN arity0
  = Op0 arity0
  | (:*) (ArityN arity0) (ArityN arity0)
  deriving(Show)

infixl 7 :*

instance Functor ArityN where
  fmap f (Op0 e) =  Op0 (f e)
  fmap f ((:*) e0 e1) = (:*) (fmap f e0) (fmap f e1)

data ConMonoid --boolean constants
  = MonoidOne
  deriving(Enum,Show,Ord,Eq,Bounded,Ix)

data VarName --varable names
  = V0
  | V1
  | V2
  deriving(Enum,Show,Ord,Eq,Bounded,Ix)

mon_eval :: ArityN (Arity0 ConMonoid var) -> ArityN (Arity0 ConMonoid var)

mon_eval e = case e of
  { (Op0 (OpCon MonoidOne) :* e1                    ) -> e1
  ; (e0                    :* Op0 (OpCon MonoidOne) ) -> e0
  ; e                                                 -> e
  }

main = do
  let mon_1::ArityN (Arity0 ConMonoid VarName) = Op0 (OpCon MonoidOne)
  let mon_expr_1_v0 = mon_1 :* Op0 (OpVar V0)
  putStr "mon_expr:1*v0="
  print mon_expr_1_v0
  let mon_eval_1_v0 = mon_eval mon_expr_1_v0
  putStr "mon_eval:1*v0="
  print mon_eval_1_v0
  let mon_expr_1_1_v0 = mon_1 :* mon_expr_1_v0
  putStr "mon_expr:1*1*1*v0="
  print mon_expr_1_1_v0
  let mon_eval_1_1_v0 = mon_eval mon_expr_1_1_v0
  putStr "mon_eval:1*1*v0="
  print mon_eval_1_1_v0


_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

RE: Re: Is there already an abstraction for this?

Mitchell, Neil
In reply to this post by Larry Evans-3
Hi Larry,

There is already an abstraction for this, its called transform, and it
resides in the Uniplate library:
http://www-users.cs.york.ac.uk/~ndm/uniplate/

I have no idea what it is, or if it exists in the algebra library!

Thanks

Neil



> -----Original Message-----
> From: [hidden email]
> [mailto:[hidden email]] On Behalf Of Larry Evans
> Sent: 18 October 2008 10:48 pm
> To: [hidden email]
> Subject: [Haskell-cafe] Re: Is there already an abstraction for this?
>
> On 09/23/08 01:01, Jake Mcarthur wrote:
>  > -----BEGIN PGP SIGNED MESSAGE-----
>  > Hash: SHA1
>  >
>  > The first thing I thought of was to try to apply one of
> the recursion  > schemes  > in the category-extras package.
> Here is what I managed using catamorphism.
>  >
>  > - - Jake
>  >
>  > -
>  >
> --------------------------------------------------------------
> ------------------
>
>  >
>  >
>  > data Expr' a
>  >   = Quotient a a
>  >   | Product a a
>  >   | Sum a a
>  >   | Difference a a
>  >   | Lit Double
>  >   | Var Char
>  >
>  > type Expr = FixF Expr'
>  >
>  > instance Functor Expr' where
>  >     fmap f (a `Quotient` b) = f a `Quotient` f b
>  >     fmap f (a `Product` b) = f a `Product` f b
>  >     fmap f (a `Sum` b) = f a `Sum` f b
>  >     fmap f (a `Difference` b) = f a `Difference` f b
>  >     fmap _ (Lit x) = Lit x
>  >     fmap _ (Var x) = Var x
>  >
>  > identity = cata ident
>  >     where ident (a `Quotient` InF (Lit 1)) = a
>  >           ident (a `Product` InF (Lit 1)) = a
>  >           ident (InF (Lit 1) `Product` b) = b
>  >           ident (a `Sum` InF (Lit 0)) = a
>  >           ident (InF (Lit 0) `Sum` b) = b
>  >           ident (a `Difference` InF (Lit 0)) = a
>  >           ident (Lit x) = InF $ Lit x
>  >           ident (Var x) = InF $ Var x
>
> According to:
>
>    cata :: Functor f => Algebra f a -> FixF f -> a
>
> from:
>
>    http://comonad.com/reader/2008/catamorphism
>
> ident must be:
>
>    Algebra f a
>
> for some Functor f; however, I don't see any declaration of
> ident as an Algebra f a.  Could you please elaborate.
> I'm trying to apply this to a simple boolean simplifier shown
> in the attachement.  As near as I can figure, maybe the f
> could be the ArityN in the attachment and maybe the a would
> be (Arity0 ConBool var).  The output of the last line of
> attachment is:
>
>    bool_eval:f+f+v0=(:+) (Op0 (OpCon BoolFalse)) (Op0 (OpVar V0))
>
> however, what I want is a complete reduction to:
>
>    (OpVar V0)
>
> How can this be done using catamorphisms?
>
>
>

==============================================================================
Please access the attached hyperlink for an important electronic communications disclaimer:

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==============================================================================

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe