# Is there already an abstraction for this? Classic List Threaded 13 messages Open this post in threaded view
|

## 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)"))) _______________________________________________ Haskell-Cafe mailing list [hidden email] http://www.haskell.org/mailman/listinfo/haskell-cafe
Open this post in threaded view
|

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

 > 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
Open this post in threaded view
|

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

 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
Open this post in threaded view
|

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

 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
Open this post in threaded view
|

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

 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  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.  >> : http://moca.inria.fr/eng.htmBest 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
Open this post in threaded view
|

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

 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
Open this post in threaded view
|

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

 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.pdfOn 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
Open this post in threaded view
|

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

 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
Open this post in threaded view
|

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

Open this post in threaded view
|

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

 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
Open this post in threaded view
|