<div dir="ltr">Thank you Sergey for the link. Very nice presentation<br><br></div><div class="gmail_extra"><br><div class="gmail_quote">On Fri, May 15, 2015 at 6:26 PM, Sergey Vinokurov <span dir="ltr"><<a href="mailto:serg.foo@gmail.com" target="_blank">serg.foo@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">Hi anakreon,<br>
<br>
You should look at paramorphism and histomorphism recursion schemes.<br>
<br>
Paramorphism has type f (a, Fix f) -> a, and thus allows you to<br>
pattern match on the subtree that produced the result.<br>
But it's not enough to write simplification of (Not (Not x)) -> x<br>
because it'll have to access simplification result that is more than<br>
</span>one level deep. But this recursion scheme would be helpful for<br>
simpler transformations like (And True x) -> x.<br>
<span class=""><br>
As for original optimization of double negation I'd suggest to use<br>
histomorphism where you'll have access to all the expression<br>
</span>subtrees annotated with intermediate results.<br>
<div class="HOEnZb"><div class="h5"><br>
 E.g.<br>
<br>
{-# LANGUAGE DeriveFunctor        #-}<br>
{-# LANGUAGE StandaloneDeriving   #-}<br>
{-# LANGUAGE UndecidableInstances #-}<br>
<br>
data Cofree f a = a :< f (Cofree f a)<br>
  deriving (Functor)<br>
<br>
strip :: (Functor f) => Cofree f a -> Fix f<br>
strip (_ :< x) = Fix $ fmap strip x<br>
<br>
newtype Fix f = Fix (f (Fix f))<br>
<br>
deriving instance (Show (f (Fix f))) => Show (Fix f)<br>
<br>
unFix :: Fix f -> f (Fix f)<br>
unFix (Fix x) = x<br>
<br>
histo :: (Functor f) => (f (Cofree f a) -> a) -> Fix f -> a<br>
histo alg x = case histo' alg x of y :< _ -> y<br>
<br>
histo' :: (Functor f) => (f (Cofree f a) -> a) -> Fix f -> Cofree f a<br>
histo' alg = (\x -> alg x :< x) . fmap (histo' alg) . unFix<br>
<br>
simplify :: Fix BExpr -> Fix BExpr<br>
simplify = histo alg<br>
  where<br>
    alg :: BExpr (Cofree BExpr Expr) -> Expr<br>
    alg (Not (_ :< (Not (x :< _)))) = x<br>
    alg x                           = Fix $ fmap strip x<br>
<br>
main :: IO ()<br>
main = do<br>
  print $ simplify $ Fix (Not (Fix (Not (Fix (Not (Fix (And (Fix<br>
BTrue) (Fix BFalse))))))))<br>
<br>
<br>
For more detailed exposition I'd suggest to look into<br>
<a href="https://github.com/willtim/recursion-schemes/raw/master/slides-final.pdf" target="_blank">https://github.com/willtim/recursion-schemes/raw/master/slides-final.pdf</a><br>
<br>
Sergey.<br>
<br>
On Fri, May 15, 2015 at 7:08 PM, anakreon <<a href="mailto:anakreonmejdi@gmail.com">anakreonmejdi@gmail.com</a>> wrote:<br>
> This might be a duplicated message. The first time I posted it I  had not<br>
> subscribed to haskell cafe.<br>
><br>
> Suppose the following data type for encoding Boolean expressions:<br>
><br>
> data BExpr  a = BTrue<br>
>               | BFalse<br>
>               | Id String<br>
>               | Not a<br>
>               | And a a<br>
>               | Or  a a<br>
>               | BEq a a<br>
>           deriving (Functor)<br>
> type Expr = Fix BExpr<br>
><br>
> It is easy to produce a string representation of an expression or evaluate<br>
> it:<br>
><br>
> estr :: BExpr String -> String<br>
> eval :: BExpr Bool  -> Bool<br>
><br>
> with the cata function from Data.Functor.Fixedpoint.<br>
><br>
> Could you suggest a solution for transforming trees encoded as Exp into<br>
> equivalent Expr (e.g Not Not a ~> a)?<br>
> cata does not work since it expects a function f a -> a while a<br>
> transformation would be f a -> f a.<br>
><br>
> _______________________________________________<br>
> Haskell-Cafe mailing list<br>
> <a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
><br>
</div></div></blockquote></div><br></div>