Is there already an abstraction for this?
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)")))
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 Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
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 Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
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
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
-----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-----
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?
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
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: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Larry Evans Sent: 18 October 2008 10:48 pm To: haskell-cafe@haskell.org Subject: [Haskell-cafe] Re: Is there already an abstraction for this?
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1
The first thing I thought of was to try to apply one of
On 09/23/08 01:01, Jake Mcarthur wrote: 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 ==============================================================================
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.
...
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".
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
G'day.
Quoting Jeremy Shaw
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
participants (11)
-
ajb＠spamcop.net -
Christian Maeder -
Dan Weston -
Jake Mcarthur -
Jeremy Shaw -
Larry Evans -
Mitchell, Neil -
Nicolas Pouillard -
Sebastiaan Visser -
Sebastian Fischer -
wren ng thornton