How to transform a tree using a futumorphism in PureScript?

Question

I have the following data type and example equation that I want to transform with a futumorphism...

import Matryoshka as M
import Data.Functor.Nu (Nu(..), observe, unfold)

data ArithmeticF a
  = Mult a a
  | Div a a
  | Add a a
  | Num Number

type Arithmetic = Nu ArithmeticF
derive instance functorArith :: Functor ArithmeticF

equation :: Arithmetic
equation = (div (n 3.0) (n 4.0)) `add` (div (n 3.0) (n 4.0))

mult :: Arithmetic -> Arithmetic -> Arithmetic
mult a b = M.embed $ Mult a b

div :: Arithmetic -> Arithmetic -> Arithmetic
div a b = M.embed $ Div a b

add :: Arithmetic -> Arithmetic -> Arithmetic
add a b = M.embed $ Add a b

n :: Number -> Arithmetic
n a = M.embed $ Num a

Using futu this is my attempt at writing a function to factor out (Div (Num 1.0) (Num 4.0)) from the equation. In the end I want the resulting tree to be (Mult (Div (Num 1.0) (Num 4.0)) (Add (Num 3.0) (Num 3.0))). This function type checks but I must be doing something wrong, since it doesn't evaluate when I run it.

solve :: Arithmetic -> Number
solve = M.cata algebra

simplify :: Arithmetic -> Arithmetic
simplify s = M.futu factor s

factor :: GCoalgebra (Free ArithmeticF) ArithmeticF Arithmetic
factor s = case M.project s of
  (Add a b) ->
    case (Tuple (M.project a) (M.project b)) of
      (Tuple (Div c d) (Div e f)) -> do
        let dd = solve d
        let ff = solve f
        if dd == ff
          then
            Mult
              (liftF $ observe (unfold dd (\m -> Div 1.0 dd )))
              (liftF $ observe (unfold c (\g -> Add c e )))
          else Add (liftF $ observe a) (liftF $ observe b)
      _ -> Add (liftF $ observe a) (liftF $ observe b)
  (Div a b) -> Div (liftF $ observe a) (liftF $ observe b)
  (Mult a b) -> Mult (liftF $ observe a) (liftF $ observe b)
  (Num a) -> (Num a)

main = log $ M.cata show (simplify equation)

Albtzrly Albtzrly · Accepted Answer · 2017-06-23T15:33:09

I seem to have missed the connection between Recursive/Corecursive and Nu's observe and unfold methods.

class (Functor f) <= Recursive t f | t -> f where
  project :: t -> f t
instance recursiveNu ∷ Functor f ⇒ Recursive (Nu f) f where
  project = observe  
class (Functor f) <= Corecursive t f | t -> f where
  embed :: f t -> t
instance corecursiveNu ∷ Functor f ⇒ Corecursive (Nu f) f where
  embed = flip unfold (map observe)

In the end I was able to write futu's GCoalgebra like so:

factor :: GCoalgebra (Free ArithmeticF) ArithmeticF Arithmetic
factor s = case M.project s of
  (Add a b) -> case Tuple (observe a) (observe b) of
    Tuple (Div c d) (Div e f) ->
      if solve d == solve f -- observe d == observe f
      then Mult (liftF $ Div (M.embed $ Num 1.0) d) (liftF $ Add c e)
      else Add (liftF $ observe a) (liftF $ observe b)
    _ -> Add (liftF $ observe a) (liftF $ observe b)
  (Div a b) -> Div (liftF $ observe a) (liftF $ observe b)
  (Mult a b) -> Mult (liftF $ observe a) (liftF $ observe b)  
  (Num a) -> (Num a)

For some reason, I could make a catchall case like a -> M.project a, so there's some verbosity in handling the default cases. There might be a better way to do this.

How to transform a tree using a futumorphism in PureScript?

1 Answers