# LANGUAGE RebindableSyntax , TypeSynonymInstances #
module DSLsofMath.W08 where
import Prelude hiding (Num(..),(/),(^),Fractional(..),Floating(..),sum)
import DSLsofMath.W05
import qualified DSLsofMath.W06
import DSLsofMath.W06 (Taylor, integ, sinx, sinf, cosx, cosf)
import DSLsofMath.Algebra
import Data.Complex

expx :: Field a => PowerSeries a
expx = integ 1 expx

expf :: Field a => a -> a
expf = evalPS 100 expx

i :: Ring a => Complex a
i = zero :+ one

ex1 :: Field a => Complex a
ex1 = expf i

compScale :: Ring a => a -> PowerSeries a -> PowerSeries a
compScale c (Poly as) = Poly (zipWith (*) as (iterate (c*) 1))

type PSC a = PowerSeries (Complex a)
expix :: Field a => PSC a
expix = compScale i expx

cosxisinx :: Field a => PSC a
cosxisinx = cosx + Poly [i] * sinx

ex2, ex2' :: Field a => PSC a
ex2   = takePoly 8 expix
ex2'  = takePoly 8 cosxisinx

test2 :: Bool
test2 = ex2 == (ex2' :: PSC Rational)

check2 :: Bool
check2 = ex2 == coeff2

coeff2 ::  PSC Rational
coeff2 =   Poly [      1            :+ 0, {-"\qquad"-}  0 :+     1,
                   (-  1  /  2)     :+ 0, {-"\qquad"-}  0 :+ (-  1  /  6),
                       1  /  24     :+ 0, {-"\qquad"-}  0 :+     1  /  120,
                   (-  1  /  720)   :+ 0, {-"\qquad"-}  0 :+ (-  1  /  5040)]

ex2R :: Poly Rational
ex2R = takePoly 8 cosx

ex2I :: Poly Rational
ex2I = takePoly 8 sinx

derivT :: Taylor a -> Taylor a
derivT = tail

integT :: a -> Taylor a -> Taylor a
integT = (:)

val ::  Additive a => Taylor a  ->  a
val (a:_)   =   a
val _       =   zero

expT, sinT, cosT :: Transcendental a => Taylor a -> Taylor a
expT  as  = integT  (exp  (val as))  (expT as   * derivT as)
sinT  as  = integT  (sin  (val as))  (cosT as   * derivT as)
cosT  as  = integT  (cos  (val as))  (-sinT as  * derivT as)

instance Transcendental a => Transcendental (Taylor a) where
   pi   =  [pi]; exp  =  expT;  sin  =  sinT;  cos  =  cosT

instance Field a => MulGroup (Taylor a) where
  recip = recipStream

recipStream :: Field a => Taylor a -> Taylor a
recipStream [] = error "recipStream: divByZero"
recipStream (f0:f') = g
  where  g   = g0:g'
         g0  = recip f0
         g'  = negate (f' * g*g)

expTx :: Taylor REAL
expTx = expT [0,1]
testExpT = take 5 expTx == [1.0, 1.0, 1.0, 1.0, 1.0]

expix3 :: Taylor (Complex Double)
expix3 = exp (i * x)            where  i  = [0 :+ 1]; x  = [0,1]

ex2alt3 = take 10 expix3
testex2alt3 = ex2alt3 ==  take 10 (concat (repeat [1, i, -1, -i]))

cosxisinx3 :: Taylor (Complex Double)
cosxisinx3 = cos x + i * sin x  where  i  = [0 :+ 1];  x  = [0,1]

ex2'alt3 = take 10 cosxisinx3

fs :: Field a => PowerSeries a
fs = integ 1 fs'
   where  fs'   = integ 0 fs''
          fs''  = exp3x + 3 * fs' - 2 * fs
exp3x :: Field a => PowerSeries a
exp3x = compScale 3 expx


"\qquad"
"\qquad"
"\qquad"
"\qquad"
# LANGUAGE RebindableSyntax , TypeSynonymInstances #
module DSLsofMath.W08 where
import Prelude hiding (Num(..),(/),(^),Fractional(..),Floating(..),sum)
import DSLsofMath.W05
import qualified DSLsofMath.W06
import DSLsofMath.W06 (Taylor, integ, sinx, sinf, cosx, cosf)
import DSLsofMath.Algebra
import Data.Complex

expx :: Field a => PowerSeries a
expx = integ 1 expx

expf :: Field a => a -> a
expf = evalPS 100 expx

i :: Ring a => Complex a
i = zero :+ one

ex1 :: Field a => Complex a
ex1 = expf i

compScale :: Ring a => a -> PowerSeries a -> PowerSeries a
compScale c (Poly as) = Poly (zipWith (*) as (iterate (c*) 1))

type PSC a = PowerSeries (Complex a)
expix :: Field a => PSC a
expix = compScale i expx

cosxisinx :: Field a => PSC a
cosxisinx = cosx + Poly [i] * sinx

ex2, ex2' :: Field a => PSC a
ex2   = takePoly 8 expix
ex2'  = takePoly 8 cosxisinx

test2 :: Bool
test2 = ex2 == (ex2' :: PSC Rational)

check2 :: Bool
check2 = ex2 == coeff2

coeff2 ::  PSC Rational

ex2R :: Poly Rational
ex2R = takePoly 8 cosx

ex2I :: Poly Rational
ex2I = takePoly 8 sinx

derivT :: Taylor a -> Taylor a
derivT = tail

integT :: a -> Taylor a -> Taylor a
integT = (:)

val ::  Additive a => Taylor a  ->  a
val (a:_)   =   a
val _       =   zero

expT, sinT, cosT :: Transcendental a => Taylor a -> Taylor a
expT  as  = integT  (exp  (val as))  (expT as   * derivT as)
sinT  as  = integT  (sin  (val as))  (cosT as   * derivT as)
cosT  as  = integT  (cos  (val as))  (-sinT as  * derivT as)

instance Transcendental a => Transcendental (Taylor a) where
   pi   =  [pi]; exp  =  expT;  sin  =  sinT;  cos  =  cosT

instance Field a => MulGroup (Taylor a) where
  recip = recipStream

recipStream :: Field a => Taylor a -> Taylor a
recipStream [] = error "recipStream: divByZero"
recipStream (f0:f') = g
  where  g   = g0:g'
         g0  = recip f0
         g'  = negate (f' * g*g)

expTx :: Taylor REAL
expTx = expT [0,1]
testExpT = take 5 expTx == [1.0, 1.0, 1.0, 1.0, 1.0]

expix3 :: Taylor (Complex Double)
expix3 = exp (i * x)            where  i  = [0 :+ 1]; x  = [0,1]

ex2alt3 = take 10 expix3
testex2alt3 = ex2alt3 ==  take 10 (concat (repeat [1, i, -1, -i]))

cosxisinx3 :: Taylor (Complex Double)
cosxisinx3 = cos x + i * sin x  where  i  = [0 :+ 1];  x  = [0,1]

ex2'alt3 = take 10 cosxisinx3

fs :: Field a => PowerSeries a
fs = integ 1 fs'
   where  fs'   = integ 0 fs''
          fs''  = exp3x + 3 * fs' - 2 * fs
exp3x :: Field a => PowerSeries a
exp3x = compScale 3 expx

