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 |
> 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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
Free forum by Nabble | Edit this page |