Symbolic Integration

Schw"achen: konstante Funktionen werden nicht erkannt.
Warning/bug: constant functions will not be recognized

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

> module Integrate      (  integrate
>                       )
> where

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

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

> import Data.List ( partition )

> import CPS            --renaming (zero to dontknow)
> import Sort           (  mergeSort  )
>
> import Prim
> import Expr
> import Function      (  Function(..), Prim(..), constant,
>                         factors, prod,
>                         (+++), (***), half, one, mone, two  )
> import Derive        (  derive  )
> import Simplify      (  standard1 )
> 
> import Table         (  Table(..), retrieve  )

> dontknow = zzero
> sort = mergeSort

----------------------------------------------------------------------
Integration

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

> integrate             :: Table -> Function -> Maybe Function
> integrate t f         =  firstSolution (integr 25 t f) ()

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

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

> integr 0 _ _          =  dontknow
> integr d t f          =  retrieve t f ? int f
>     where
>     int (Const c)     =  unit (Const c *** Id)
>     int (Ratio n)     =  unit (Ratio n *** Id)
>     int Id            =  unit (half *** Id :^: two)
>     int (Prim Abs)    =  dontknow
>     int (Prim f)      =  unit (case f of
>         Sin           -> mone *** Prim Cos
>         Cos           -> Prim Sin
>         Tan           -> mone *** (Prim Ln :.: Prim Abs :.: Prim Cos)
>         Cot           -> Prim Ln :.: Prim Abs :.: Prim Sin
>         Exp           -> Prim Exp
>         Ln            -> Id *** Prim Ln +++ mone *** Id
>         Arcsin        -> Id *** Prim Arcsin +++ h1
>         Arccos        -> Id *** Prim Arccos +++ mone *** h1
>         Arctan        -> Id *** Prim Arctan +++ mone *** h2
>         Arccot        -> Id *** Prim Arccot +++ h2
>         Sinh          -> Prim Cosh
>         Cosh          -> Prim Sinh
>         Tanh          -> Prim Ln :.: Prim Abs :.: Prim Cosh
>         Coth          -> Prim Ln :.: Prim Abs :.: Prim Sinh)
>             where
>             h1        =  (one +++ mone *** Id :^: two) :^: half
>             h2        =  half *** (Prim Ln :.: Id :^: two +++ one)
>     int (Fun f)       =  dontknow
>     int (Derive 1 f)  =  unit f
>     int (Derive (n + 1) f)    =  unit (Derive n f)
>     int (Summ fs)     =  accumulat [ integr d t f| f<-fs ]    &= \ffs ->
>                          unit (Summ ffs)
>     int (Id :^: n)
>         | n == mone   =  unit (Prim Ln :.: Prim Abs)
>     int (Id :^: n)
>         | constant n  =  unit ((n +++ one) :^: mone *** Id :^: (n +++ one))
>     int h             =  (substIntegr d t hs
>                           ?? partIntegr d t hs)               &= \hh ->
>                          unit (prod ns *** hh)
>         where
>         (ns, hs)      =  partition constant (factors h)

----------------------------------------------------------------------
Substitutionsregel
Substitution rules

Realisiert die Regel @int (f @circ g)@cdot g' = F @circ g.
Realize: the rule @int (f @circ g)@cdot g' = F @circ g

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

> substIntegr d t hs    =  select hs                            &= \(f, g, gs)->
>                          let g' = standard1 (derive g)        in
>                          match gs (factors g')                &= \n ->
>                          integr (d - 1) t f                   &= \ff ->
>                          unit (n *** ff :.: g)

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

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

> select hs             =  (pick1 hs                            &= \(h, gs) ->
>                           case h of
>                           f :.: g              -> unit (f, g, gs)
>                           g :^: n | constant n -> unit (Id :^: n, g, gs)
>                           _                    -> dontknow)
>                       ?? (split hs                            &= \(fs, gs) ->
>                           unit (Id, prod fs, gs))

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

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

> match fs gs
>     | sort fs' == sort gs'    =  unit (prod m *** prod n :^: mone)
>     | otherwise               =  dontknow
>     where (m, fs')            =  partition constant fs
>           (n, gs')            =  partition constant gs

----------------------------------------------------------------------
Partielle Integration
Partial Integration

Realisiert die Regel @[ @int f @cdot g = f @cdot G - @int f' @cdot G . @]
Realize, the rule    @[ @int f @cdot g = f @cdot G - @int f' @cdot G . @]

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

> partIntegr d t hs     =  let hs' = sort hs                    in
>                          (pickn 1 hs'
>                           ?? pickn 2 hs'
>                           ?? pickn 3 hs')                     &= \(gs, fs) ->
>                          let g = prod gs                      in
>                          let f = prod fs                      in
>                          integr (d - 1) t g                   &= \gg ->
>                          let h = standard1 (derive f *** gg)  in
>                          integr (d - 1) t h                   &= \hh ->
>                          unit (f *** gg +++ mone *** hh)

----------------------------------------------------------------------
Helperfunctions

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

> pick1 []              =  dontknow
> pick1 (a:x)           =  unit (a, x)
>                       ?? pick1 x &= \(b, y) -> unit (b, a:y)

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

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

> pickn 0 x             =  unit ([], x)
> pickn (n + 1) x       =  pick1 x &= \(a, x') -> pickn n x' &= \(as, y) ->
>                          unit (a:as, y)

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

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

> split x               =  alternate [ pickn i x | i<-[1..length x-1] ]

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