Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.2 | \ complex numbers |
| 2 : | |||
| 3 : | \ Copyright (C) 2005 Free Software Foundation, Inc. | ||
| 4 : | |||
| 5 : | \ This file is part of Gforth. | ||
| 6 : | |||
| 7 : | \ Gforth is free software; you can redistribute it and/or | ||
| 8 : | \ modify it under the terms of the GNU General Public License | ||
| 9 : | \ as published by the Free Software Foundation; either version 2 | ||
| 10 : | \ of the License, or (at your option) any later version. | ||
| 11 : | |||
| 12 : | \ This program is distributed in the hope that it will be useful, | ||
| 13 : | \ but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 : | \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 : | \ GNU General Public License for more details. | ||
| 16 : | |||
| 17 : | \ You should have received a copy of the GNU General Public License | ||
| 18 : | \ along with this program; if not, write to the Free Software | ||
| 19 : | \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. | ||
| 20 : | |||
| 21 : | pazsan | 1.1 | \ *** Complex arithmetic *** 23sep91py |
| 22 : | |||
| 23 : | : complex' 2* floats ; | ||
| 24 : | : complex+ float+ float+ ; | ||
| 25 : | |||
| 26 : | \ simple operations 02mar05py | ||
| 27 : | |||
| 28 : | : fl> f@local0 lp+ ; | ||
| 29 : | |||
| 30 : | : zdup fover fover ; | ||
| 31 : | : zdrop fdrop fdrop ; | ||
| 32 : | : zover 3 fpick 3 fpick ; | ||
| 33 : | : z>r f>l f>l ; | ||
| 34 : | : zr> fl> fl> ; | ||
| 35 : | : zswap frot f>l frot fl> ; | ||
| 36 : | : zpick 2* 1+ >r r@ fpick r> fpick ; | ||
| 37 : | \ : zpin 2* 1+ >r r@ fpin r> fpin ; | ||
| 38 : | : zdepth fdepth 2/ ; | ||
| 39 : | : zrot z>r zswap zr> zswap ; | ||
| 40 : | : z-rot zswap z>r zswap zr> ; | ||
| 41 : | : z@ dup >r f@ r> float+ f@ ; | ||
| 42 : | : z! dup >r float+ f! r> f! ; | ||
| 43 : | |||
| 44 : | \ simple operations 02mar05py | ||
| 45 : | : z+ frot f+ f>l f+ fl> ; | ||
| 46 : | : z- fnegate frot f+ f>l f- fl> ; | ||
| 47 : | : zr- frot f- f>l fswap f- fl> ; | ||
| 48 : | : x+ frot f+ fswap ; | ||
| 49 : | : x- fnegate x+ ; | ||
| 50 : | : z* fdup 4 fpick f* f>l fover 3 fpick f* f>l | ||
| 51 : | f>l fswap fl> f* f>l f* fl> f- fl> fl> f+ ; | ||
| 52 : | : zscale ftuck f* f>l f* fl> ; | ||
| 53 : | |||
| 54 : | \ simple operations 02mar05py | ||
| 55 : | |||
| 56 : | : znegate fnegate fswap fnegate fswap ; | ||
| 57 : | : zconj fnegate ; | ||
| 58 : | : z*i fnegate fswap ; | ||
| 59 : | : z/i fswap fnegate ; | ||
| 60 : | : zsqabs fdup f* fswap fdup f* f+ ; | ||
| 61 : | : 1/z zconj zdup zsqabs 1/f zscale ; | ||
| 62 : | : z/ 1/z z* ; | ||
| 63 : | : |z| zsqabs fsqrt ; | ||
| 64 : | : zabs |z| 0e ; | ||
| 65 : | : z2/ f2/ f>l f2/ fl> ; | ||
| 66 : | : z2* f2* f>l f2* fl> ; | ||
| 67 : | |||
| 68 : | : >polar ( z -- r theta ) zdup |z| fswap frot fatan2 ; | ||
| 69 : | : polar> ( r theta -- z ) fsincos frot zscale fswap ; | ||
| 70 : | |||
| 71 : | \ zexp zln 02mar05py | ||
| 72 : | |||
| 73 : | : zexp fsincos fswap frot fexp zscale ; | ||
| 74 : | : pln zdup fswap fatan2 frot frot |z| fln fswap ; | ||
| 75 : | : zln >polar fswap fln fswap ; | ||
| 76 : | |||
| 77 : | : z0= f0= >r f0= r> and ; | ||
| 78 : | : zsqrt zdup z0= 0= IF | ||
| 79 : | fdup f0= IF fdrop fsqrt 0e EXIT THEN | ||
| 80 : | zln z2/ zexp THEN ; | ||
| 81 : | : z** zswap zln z* zexp ; | ||
| 82 : | \ Test: Fibonacci-Zahlen | ||
| 83 : | 1e 5e fsqrt f+ f2/ fconstant g 1e g f- fconstant -h | ||
| 84 : | : zfib zdup z>r g 0e zswap z** | ||
| 85 : | zr> zswap z>r -h 0e zswap z** znegate zr> z+ | ||
| 86 : | [ g -h f- 1/f ] FLiteral zscale ; | ||
| 87 : | |||
| 88 : | \ complexe Operationen 02mar05py | ||
| 89 : | |||
| 90 : | : zsinh zexp zdup 1/z z- z2/ ; | ||
| 91 : | : zcosh zexp zdup 1/z z+ z2/ ; | ||
| 92 : | : ztanh z2* zexp zdup 1e 0e z- zswap 1e 0e z+ z/ ; | ||
| 93 : | |||
| 94 : | : zsin z*i zsinh z/i ; | ||
| 95 : | : zcos z*i zcosh ; | ||
| 96 : | : ztan z*i ztanh z/i ; | ||
| 97 : | |||
| 98 : | : Real fdrop ; | ||
| 99 : | : Imag fnip ; | ||
| 100 : | |||
| 101 : | : Re Real 0e ; | ||
| 102 : | : Im Imag 0e ; | ||
| 103 : | |||
| 104 : | \ complexe Operationen 02mar05py | ||
| 105 : | |||
| 106 : | : zasinh zdup 1e f+ zover 1e f- z* zsqrt z+ pln ; | ||
| 107 : | : zacosh zdup 1e x- z2/ zsqrt zswap 1e x+ z2/ zsqrt z+ | ||
| 108 : | pln z2* ; | ||
| 109 : | : zatanh zdup 1e x+ zln zswap 1e x- znegate pln z- z2/ ; | ||
| 110 : | : zacoth znegate zdup 1e x- pln zswap 1e x+ pln z- z2/ ; | ||
| 111 : | |||
| 112 : | pi f2/ FConstant pi/2 | ||
| 113 : | |||
| 114 : | : zasin ( f: z -- -iln[iz+sqrt[1-z^~2]] ) z*i zasinh z/i ; | ||
| 115 : | : zacos ( f: z -- pi/2-asin[z] ) pi/2 0e zswap zasin z- ; | ||
| 116 : | : zatan ( f: z -- [ln[1+iz]-ln[1-iz]]/2i ) z*i zatanh z/i ; | ||
| 117 : | : zacot ( f: z -- [ln[[z+i]/[z-i]]/2i ) z*i zacoth z/i ; | ||
| 118 : | |||
| 119 : | \ Ausgabe 24sep05py | ||
| 120 : | |||
| 121 : | Defer fc. ' f. IS fc. | ||
| 122 : | : z. zdup z0= IF zdrop ." 0 " exit THEN | ||
| 123 : | fdup f0= IF fdrop fc. exit THEN fswap | ||
| 124 : | fdup f0= IF fdrop | ||
| 125 : | ELSE fc. | ||
| 126 : | fdup f0> IF ." +" THEN THEN | ||
| 127 : | fc. ." i " ; | ||
| 128 : | : z.s zdepth 0 ?DO i zpick zswap z>r z. zr> LOOP ; |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |