update maintainer email
[complex-generic:complex-generic.git] / Data / Complex / Generic / Default.hs
1 {- |
2 Module      :  Data.Complex.Generic.Default
3 Copyright   :  (c) Claude Heiland-Allen 2012
4 License     :  BSD3
5
6 Maintainer  :  claude@mathr.co.uk
7 Stability   :  unstable
8 Portability :  MultiParamTypeClasses
9
10 Default implementations of complex number operations.
11 -}
12 {- heavily based on:
13 -- Module      :  Data.Complex
14 -- Copyright   :  (c) The University of Glasgow 2001
15 -- License     :  BSD-style (see the file libraries/base/LICENSE)
16 -- http://hackage.haskell.org/packages/archive/base/4.5.0.0/doc/html/src/Data-Complex.html
17 --}
18
19 module Data.Complex.Generic.Default where
20
21 import Data.Complex.Generic.Class
22
23 realDefault :: (Num r, ComplexRect c r) => r -> c
24 realDefault r = r .+ 0
25
26 imagDefault :: (Num r, ComplexRect c r) => r -> c
27 imagDefault i = 0 .+ i
28
29 rectDefault :: ComplexRect c r => c -> (r, r)
30 rectDefault c = (realPart c, imagPart c)
31
32 realPartDefault :: ComplexRect c r => c -> r
33 realPartDefault = fst . rect
34
35 imagPartDefault :: ComplexRect c r => c -> r
36 imagPartDefault = snd . rect
37
38 conjugateDefault :: (Num r, ComplexRect c r) => c -> c
39 conjugateDefault c =
40   let (x, y) = rect c
41   in  x .+ negate y
42
43 magnitudeSquaredDefault :: (Num r, ComplexRect c r) => c -> r
44 magnitudeSquaredDefault c =
45   let (x, y) = rect c
46   in  x * x + y * y
47
48 sqrDefault :: (Num r, ComplexRect c r) => c -> c
49 sqrDefault z =
50   let (x, y) = rect z
51       xy = x * y
52   in  (x + y) * (x - y) .+ (xy + xy)
53
54 sqrDefaultRF :: (RealFloat r, ComplexRect c r) => c -> c
55 sqrDefaultRF z =
56   let (x, y) = rect z
57   in  (x + y) * (x - y) .+ scaleFloat 1 (x * y)  -- FIXME assumes binary
58
59 rmulDefault :: (Num r, ComplexRect c r) => r -> c -> c
60 rmulDefault a z =
61   let (x, y) = rect z
62   in  (a * x) .+ (a * y)
63
64 mulrDefault :: (Num r, ComplexRect c r) => c -> r -> c
65 mulrDefault z a =
66   let (x, y) = rect z
67   in  (x * a) .+ (y * a)
68
69 mkPolarDefault :: (Floating r, ComplexRect c r) => r -> r -> c
70 mkPolarDefault r theta = r * cos theta .+ r * sin theta
71
72 cisDefault :: (Floating r, ComplexRect c r) => r -> c
73 cisDefault theta = cos theta .+ sin theta
74
75 polarDefault :: (ComplexPolar c r) => c -> (r, r)
76 polarDefault c = (magnitude c, phase c)
77
78 magnitudeDefault :: (Floating r, ComplexRect c r) => c -> r
79 magnitudeDefault = sqrt . magnitudeSquared
80
81 magnitudeDefaultRF :: (RealFloat r, ComplexRect c r) => c -> r
82 magnitudeDefaultRF w =
83   let (x, y) = rect w
84       k = max (exponent x) (exponent y)
85       mk = - k
86       sqr z = z * z
87   in  scaleFloat k (sqrt (sqr (scaleFloat mk x) + sqr (scaleFloat mk y)))
88
89 phaseDefaultRF :: (RealFloat r, ComplexRect c r) => c -> r
90 phaseDefaultRF c = case (realPart c, imagPart c) of
91   (0, 0) -> 0
92   (x, y) -> atan2 y x
93
94 addDefault :: (Num r, ComplexRect c r) => c -> c -> c
95 addDefault z w =
96   let (x,y) = rect z
97       (x',y') = rect w
98   in  (x+x') .+ (y+y')
99
100 subDefault :: (Num r, ComplexRect c r) => c -> c -> c
101 subDefault z w =
102   let (x,y) = rect z
103       (x',y') = rect w
104   in  (x-x') .+ (y-y')
105
106 mulDefault :: (Num r, ComplexRect c r) => c -> c -> c
107 mulDefault z w =
108   let (x,y) = rect z
109       (x',y') = rect w
110   in  (x*x'-y*y') .+ (x*y'+y*x')
111
112 negateDefault :: (Num r, ComplexRect c r) => c -> c
113 negateDefault z =
114   let (x,y) = rect z
115   in  negate x .+ negate y
116
117 absDefault :: (Num r, ComplexRect c r, ComplexPolar c r) => c -> c
118 absDefault = real . magnitude
119
120 signumDefault :: (Eq r, Fractional r, ComplexRect c r, ComplexPolar c r) => c -> c
121 signumDefault z = case rect z of
122   (0, 0) -> 0 .+ 0
123   (x, y) -> x/r .+ y/r
124   where r = magnitude z
125
126 fromIntegerDefault :: (Num r, ComplexRect c r) => Integer -> c
127 fromIntegerDefault = real . fromInteger
128
129 divDefault :: (Fractional r, ComplexRect c r) => c -> c -> c
130 divDefault z w =
131   let (x,y) = rect z
132       (x',y') = rect w
133       d = x'*x' + y'*y'
134   in  (x*x'+y*y') / d .+ (y*x'-x*y') / d
135
136 divDefaultRF :: (RealFloat r, ComplexRect c r) => c -> c -> c
137 divDefaultRF z w =
138   let (x,y) = rect z
139       (x',y') = rect w
140       x'' = scaleFloat k x'
141       y'' = scaleFloat k y'
142       k = max (exponent x') (exponent y')
143       d = x'*x'' + y'*y''
144   in  (x*x''+y*y'') / d .+ (y*x''-x*y'') / d
145
146 fromRationalDefault :: (Fractional r, ComplexRect c r) => Rational -> c
147 fromRationalDefault = real . fromRational
148
149 piDefault :: (Floating r, ComplexRect c r) => c
150 piDefault = real pi
151
152 expDefault :: (Floating r, ComplexRect c r) => c -> c
153 expDefault z =
154   let (x, y) = rect z
155       expx = exp x
156   in  expx * cos y .+ expx * sin y
157
158 logDefault :: (Floating r, ComplexRect c r, ComplexPolar c r) => c -> c
159 logDefault z = log (magnitude z) .+ phase z
160
161 sqrtDefault :: (Eq r, Ord r, Floating r, ComplexRect c r, ComplexPolar c r) => c -> c
162 sqrtDefault z = case rect z of
163   (0, 0) -> 0 .+ 0
164   (x, y) ->
165     let (u,v) = if x < 0 then (v',u') else (u',v')
166         v'    = abs y / (u'*2)
167         u'    = sqrt ((magnitude z + abs x) / 2)
168     in  u .+ (if y < 0 then -v else v)
169
170 sinDefault :: (Floating r, ComplexRect c r) => c -> c
171 sinDefault z =
172   let (x, y) = rect z
173   in  sin x * cosh y .+ cos x * sinh y
174
175 cosDefault :: (Floating r, ComplexRect c r) => c -> c
176 cosDefault z =
177   let (x, y) = rect z
178   in  cos x * cosh y .+ (- sin x * sinh y)
179
180 tanDefault :: (Floating r, Fractional c, ComplexRect c r) => c -> c
181 tanDefault z =
182   let (x, y) = rect z
183       sinx  = sin x
184       cosx  = cos x
185       sinhy = sinh y
186       coshy = cosh y
187   in  (sinx*coshy.+cosx*sinhy)/(cosx*coshy.+(-sinx*sinhy))
188
189 sinhDefault :: (Floating r, ComplexRect c r) => c -> c
190 sinhDefault z =
191   let (x, y) = rect z
192   in  cos y * sinh x .+ sin  y * cosh x
193
194 coshDefault :: (Floating r, ComplexRect c r) => c -> c
195 coshDefault z =
196   let (x, y) = rect z
197   in  cos y * cosh x .+ sin y * sinh x
198
199 tanhDefault :: (Floating r, Floating c, ComplexRect c r) => c -> c
200 tanhDefault z =
201   let (x, y) = rect z
202       siny  = sin y
203       cosy  = cos y
204       sinhx = sinh x
205       coshx = cosh x
206   in  (cosy*sinhx.+siny*coshx)/(cosy*coshx.+siny*sinhx)
207
208 asinDefault :: (Num r, Floating c, ComplexRect c r) => c -> c
209 asinDefault z =
210   let (x, y) = rect z
211       (x', y') = rect $ log (((-y).+x) + sqrt (1 - z*z))
212   in  y'.+(-x')
213
214 acosDefault :: (Num r, Floating c, ComplexRect c r) => c -> c
215 acosDefault z =
216   let (x'',y'') = rect $ log (z + ((-y').+x'))
217       (x',y')   = rect $ sqrt (1 - z*z)
218   in  y''.+(-x'')
219
220 atanDefault :: (Num r, Floating c, ComplexRect c r) => c -> c
221 atanDefault z =
222   let (x, y) = rect z
223       (x',y') = rect $ log (((1-y).+x) / sqrt (1+z*z))
224   in  y'.+(-x')
225
226 asinhDefault :: (Floating c, ComplexRect c r) => c -> c
227 asinhDefault z = log (z + sqrt (1+z*z))
228
229 acoshDefault :: (Floating c, ComplexRect c r) => c -> c
230 acoshDefault z = log (z + (z+1) * sqrt ((z-1)/(z+1)))
231
232 atanhDefault :: (Floating c, ComplexRect c r) => c -> c
233 atanhDefault z =  0.5 * log ((1.0+z) / (1.0-z))