fcos.txt


\ fcos 6/21/00 7:36 pm NAB
 
fvariable n 
fvariable x 
3.14159265e fdup 2e f* fconstant 2pi 
fconstant pi 
 
: fsgn ( F: r -- -1|0|1 ) 
  fpdissect  2drop drop  0 d>f ; 
 
: fcos ( F: rad -- cos ) 
\ Adjust between pi and -pi:
  fdup 2pi f/  floor 2pi f*  f- 
  pi fover f< if 
    fdup fsgn 2pi f* f- 
  then 
\ Series expansion:
  fdup f* x f!  1e n f! 
  2  1e  ( F: y ) 
  begin  fdup  ( F: old y ) 
    n f@ x f@ f*  dup dup 1- *  0 d>f 
    f/ fnegate  fdup  n f!  f+ 
  fover fover f-  f0= 0= while 
    2 +  fswap fdrop 
  repeat  drop 
  fswap fdrop  ( F: cos ) ;


  HTMLized by Forth2HTML