Annotation of gforth/complex.fs, revision 1.1
1.1 ! pazsan 1: \ *** Complex arithmetic *** 23sep91py
! 2:
! 3: : complex' 2* floats ;
! 4: : complex+ float+ float+ ;
! 5:
! 6: \ simple operations 02mar05py
! 7:
! 8: : fl> f@local0 lp+ ;
! 9:
! 10: : zdup fover fover ;
! 11: : zdrop fdrop fdrop ;
! 12: : zover 3 fpick 3 fpick ;
! 13: : z>r f>l f>l ;
! 14: : zr> fl> fl> ;
! 15: : zswap frot f>l frot fl> ;
! 16: : zpick 2* 1+ >r r@ fpick r> fpick ;
! 17: \ : zpin 2* 1+ >r r@ fpin r> fpin ;
! 18: : zdepth fdepth 2/ ;
! 19: : zrot z>r zswap zr> zswap ;
! 20: : z-rot zswap z>r zswap zr> ;
! 21: : z@ dup >r f@ r> float+ f@ ;
! 22: : z! dup >r float+ f! r> f! ;
! 23:
! 24: \ simple operations 02mar05py
! 25: : z+ frot f+ f>l f+ fl> ;
! 26: : z- fnegate frot f+ f>l f- fl> ;
! 27: : zr- frot f- f>l fswap f- fl> ;
! 28: : x+ frot f+ fswap ;
! 29: : x- fnegate x+ ;
! 30: : z* fdup 4 fpick f* f>l fover 3 fpick f* f>l
! 31: f>l fswap fl> f* f>l f* fl> f- fl> fl> f+ ;
! 32: : zscale ftuck f* f>l f* fl> ;
! 33:
! 34: \ simple operations 02mar05py
! 35:
! 36: : znegate fnegate fswap fnegate fswap ;
! 37: : zconj fnegate ;
! 38: : z*i fnegate fswap ;
! 39: : z/i fswap fnegate ;
! 40: : zsqabs fdup f* fswap fdup f* f+ ;
! 41: : 1/z zconj zdup zsqabs 1/f zscale ;
! 42: : z/ 1/z z* ;
! 43: : |z| zsqabs fsqrt ;
! 44: : zabs |z| 0e ;
! 45: : z2/ f2/ f>l f2/ fl> ;
! 46: : z2* f2* f>l f2* fl> ;
! 47:
! 48: : >polar ( z -- r theta ) zdup |z| fswap frot fatan2 ;
! 49: : polar> ( r theta -- z ) fsincos frot zscale fswap ;
! 50:
! 51: \ zexp zln 02mar05py
! 52:
! 53: : zexp fsincos fswap frot fexp zscale ;
! 54: : pln zdup fswap fatan2 frot frot |z| fln fswap ;
! 55: : zln >polar fswap fln fswap ;
! 56:
! 57: : z0= f0= >r f0= r> and ;
! 58: : zsqrt zdup z0= 0= IF
! 59: fdup f0= IF fdrop fsqrt 0e EXIT THEN
! 60: zln z2/ zexp THEN ;
! 61: : z** zswap zln z* zexp ;
! 62: \ Test: Fibonacci-Zahlen
! 63: 1e 5e fsqrt f+ f2/ fconstant g 1e g f- fconstant -h
! 64: : zfib zdup z>r g 0e zswap z**
! 65: zr> zswap z>r -h 0e zswap z** znegate zr> z+
! 66: [ g -h f- 1/f ] FLiteral zscale ;
! 67:
! 68: \ complexe Operationen 02mar05py
! 69:
! 70: : zsinh zexp zdup 1/z z- z2/ ;
! 71: : zcosh zexp zdup 1/z z+ z2/ ;
! 72: : ztanh z2* zexp zdup 1e 0e z- zswap 1e 0e z+ z/ ;
! 73:
! 74: : zsin z*i zsinh z/i ;
! 75: : zcos z*i zcosh ;
! 76: : ztan z*i ztanh z/i ;
! 77:
! 78: : Real fdrop ;
! 79: : Imag fnip ;
! 80:
! 81: : Re Real 0e ;
! 82: : Im Imag 0e ;
! 83:
! 84: \ complexe Operationen 02mar05py
! 85:
! 86: : zasinh zdup 1e f+ zover 1e f- z* zsqrt z+ pln ;
! 87: : zacosh zdup 1e x- z2/ zsqrt zswap 1e x+ z2/ zsqrt z+
! 88: pln z2* ;
! 89: : zatanh zdup 1e x+ zln zswap 1e x- znegate pln z- z2/ ;
! 90: : zacoth znegate zdup 1e x- pln zswap 1e x+ pln z- z2/ ;
! 91:
! 92: pi f2/ FConstant pi/2
! 93:
! 94: : zasin ( f: z -- -iln[iz+sqrt[1-z^~2]] ) z*i zasinh z/i ;
! 95: : zacos ( f: z -- pi/2-asin[z] ) pi/2 0e zswap zasin z- ;
! 96: : zatan ( f: z -- [ln[1+iz]-ln[1-iz]]/2i ) z*i zatanh z/i ;
! 97: : zacot ( f: z -- [ln[[z+i]/[z-i]]/2i ) z*i zacoth z/i ;
! 98:
! 99: \ Ausgabe 24sep05py
! 100:
! 101: Defer fc. ' f. IS fc.
! 102: : z. zdup z0= IF zdrop ." 0 " exit THEN
! 103: fdup f0= IF fdrop fc. exit THEN fswap
! 104: fdup f0= IF fdrop
! 105: ELSE fc.
! 106: fdup f0> IF ." +" THEN THEN
! 107: fc. ." i " ;
! 108: : z.s zdepth 0 ?DO i zpick zswap z>r z. zr> LOOP ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>