如何使用PureScript中的futumorphism转换树?

时间:2017-06-22 04:12:37

标签: recursion purescript recursion-schemes

我有以下数据类型和示例等式,我想用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

使用futu 这是我尝试编写一个函数来从等式中分解(Div (Num 1.0) (Num 4.0))。 最后,我希望生成的树为(Mult (Div (Num 1.0) (Num 4.0)) (Add (Num 3.0) (Num 3.0)))。 这个函数类型检查但我必须做错了,因为它在运行时没有评估。

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)

1 个答案:

答案 0 :(得分:0)

我似乎错过了Recursive / Corecursive和Nu的观察和展开方法之间的联系。

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)

最后我能像这样编写futu的GCoalgebra:

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)

出于某种原因,我可以制作像a -> M.project a这样的大型案例,因此在处理默认案例时会有一些冗长。可能有更好的方法来做到这一点。