Conversions

----------------------------------------------------------------------

> module Convert        (  abstract, apply
>                       )
> where
>
> import Ratio
>
> import Prim           (  Ident, Prim (..)  )
> import Expr           (  Expr (..)  )
> import Function       (  Function (..), minus, mone  )
> import Derive         (  derive  )

----------------------------------------------------------------------

Abstraction

----------------------------------------------------------------------

> abstract                      :: Ident -> Expr -> Function
> abstract x (Lit n)            =  Ratio n
> abstract x (Var y)
>     | x == y                  =  Id
>     | otherwise               =  Const y
> abstract x (AppPrim Log n e)  =  abstract x (Div (AppPrim Ln n e)
>                                                  (AppPrim Ln 0 (Lit (10%1))))
> abstract x (AppPrim f n e)    =  times n derive (Prim f) :.: abstract x e
> abstract x (AppFun f n e)     =  times n derive (Fun f) :.: abstract x e
> abstract x (Negg e)           =  minus (abstract x e)
> abstract x (Add e1 e2)        =  Summ [abstract x e1, abstract x e2]
> abstract x (Sub e1 e2)        =  Summ [abstract x e1, minus (abstract x e2)]
> abstract x (Mul e1 e2)        =  Prod [abstract x e1, abstract x e2]
> abstract x (Div (Lit m) (Lit n))
>                               =  Ratio (m / n)
> abstract x (Div e1 e2)        =  Prod [abstract x e1, abstract x e2 :^: mone]
> abstract x (Pow e1 e2)        =  abstract x e1 :^: abstract x e2

----------------------------------------------------------------------

Application

----------------------------------------------------------------------

TODO make
Prod [f :^: -g, h] ==> Div h (f^g)

> apply                         :: Function -> Expr -> Expr
> apply (Ratio n) e             =  Lit n
> apply (Const c) e             =  Var c
> apply Id e                    =  e
> apply (Prim f) e              =  AppPrim f 0 e
> apply (Derive n (Prim f)) e   =  AppPrim f n e
> apply (Fun f) e               =  AppFun f 0 e
> apply (Derive n (Fun f)) e    =  AppFun f n e
> apply (f :.: g) e             =  apply f (apply g e)
> apply (Summ []) e             =  Lit (0 % 0)
> apply (Summ [f]) e            =  smartApply f e
> apply (Summ fs) e             =  foldl1 smartAdd [ smartApply f e | f<-fs ]
> apply (Prod []) e             =  Lit (1 % 1)
> apply f@(Prod (fs@[_,_])) e   | negative f   = Negg (apply (negat f) e)
>                               | otherwise    = foldr1 Mul [ apply f e | f<-fs ]
> apply (Prod fs) e             =  foldr1 Mul [ apply f e | f<-fs ]
> apply (f :^: g) e             =  Pow (apply f e) (apply g e)

> smartAdd x (Negg y) = Sub x y
> smartAdd x y        = Add x y

> smartApply f e | negative f  = Negg (apply (negat f) e) 
>                | otherwise   = apply f e

> negat :: Function -> Function
> negat (Ratio n)     = Ratio (negate n)
> negat (Prod (Ratio p:ps)) | p == -1   = Prod ps
>                           | p <   0   = Prod (Ratio (negate p):ps)
> negat x             = x

> negative :: Function -> Bool
> negative (Ratio n) = n < 0
> negative (Prod ps) = any negative ps
> negative _         = False

----------------------------------------------------------------------

Helper functions

----------------------------------------------------------------------

> times 0 f             =  id
> times (n + 1) f       =  f . times n f

----------------------------------------------------------------------