Added make-polar.

This commit is contained in:
Abdulaziz Ghuloum 2008-07-15 23:13:59 -07:00
parent 195dc0ea45
commit 0ef81aa13e
5 changed files with 22 additions and 14 deletions

View File

@ -1,7 +1,6 @@
(library (ikarus not-yet-implemented) (library (ikarus not-yet-implemented)
(export (export
make-polar
bitwise-copy-bit-field bitwise-reverse-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field
bitwise-rotate-bit-field bitwise-if fxreverse-bit-field bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
fxrotate-bit-field fxrotate-bit-field
@ -17,7 +16,6 @@
string-upcase) string-upcase)
(import (except (ikarus) (import (except (ikarus)
make-polar
bitwise-copy-bit-field bitwise-reverse-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field
bitwise-rotate-bit-field bitwise-if fxreverse-bit-field bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
fxrotate-bit-field fxrotate-bit-field
@ -57,7 +55,6 @@
(not-yet (not-yet
;;; should be implemented ;;; should be implemented
string-downcase string-titlecase string-upcase string-downcase string-titlecase string-upcase
make-polar
bitwise-if bitwise-if
bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field
fxreverse-bit-field fxrotate-bit-field fxreverse-bit-field fxrotate-bit-field

View File

@ -3620,11 +3620,11 @@
(library (ikarus complex-numbers) (library (ikarus complex-numbers)
(export make-rectangular $make-rectangular (export make-rectangular $make-rectangular make-polar
real-part imag-part angle magnitude) real-part imag-part angle magnitude)
(import (import
(except (ikarus) (except (ikarus) make-rectangular make-polar
make-rectangular real-part imag-part angle magnitude) real-part imag-part angle magnitude)
(except (ikarus system $compnums) $make-rectangular)) (except (ikarus system $compnums) $make-rectangular))
(define ($make-rectangular r i) (define ($make-rectangular r i)
@ -3655,6 +3655,16 @@
[else (err r)])] [else (err r)])]
[else (err i)])) [else (err i)]))
(define (make-polar mag angle)
(define who 'make-polar)
(unless (number? mag)
(die who "not a number" mag))
(unless (number? angle)
(die who "not a number" angle))
(make-rectangular
(* mag (cos angle))
(* mag (sin angle))))
(define magnitude (define magnitude
(lambda (x) (lambda (x)
(cond (cond

View File

@ -205,7 +205,7 @@
[(#\i) [(#\i)
(let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next im:done (make-rectangular 0.0 real)))] (next im:done (make-rectangular 0.0 real)))]
[(#\e) [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10) (if (fx=? r 10)
(next exponent r ex sn ac exp) (next exponent r ex sn ac exp)
(fail))]) (fail))])
@ -218,7 +218,7 @@
[(#\i) [(#\i)
(let ([imag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]) (let ([imag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next im:done (make-rectangular real imag)))] (next im:done (make-rectangular real imag)))]
[(#\e) [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(next im:exponent r real ex sn ac exp)]) (next im:exponent r real ex sn ac exp)])
(digit+ (r ex sn ac) (digit+ (r ex sn ac)
@ -238,7 +238,7 @@
(next im:sign r real ex -1))] (next im:sign r real ex -1))]
[(#\i) [(#\i)
(next im:done (make-rectangular 0 (do-sn/ex sn ex ac)))] (next im:done (make-rectangular 0 (do-sn/ex sn ex ac)))]
[(#\e) [(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10) (if (fx=? r 10)
(next exponent r ex sn ac 0) (next exponent r ex sn ac 0)
(fail))]) (fail))])
@ -252,12 +252,12 @@
(fail))] (fail))]
[(#\/) [(#\/)
(next im:ratio r real ex sn ac)] (next im:ratio r real ex sn ac)]
[(#\e) [(#\i)
(next im:done (make-rectangular real (do-sn/ex sn ex ac)))]
[(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)
(if (fx=? r 10) (if (fx=? r 10)
(next im:exponent r real ex sn ac 0) (next im:exponent r real ex sn ac 0)
(fail))] (fail))])
[(#\i)
(next im:done (make-rectangular real (do-sn/ex sn ex ac)))])
(sign-i (r ex sn) (sign-i (r ex sn)
[(eof) [(eof)

View File

@ -1 +1 @@
1539 1540

View File

@ -239,6 +239,7 @@
(test "-0e-0" -0.0) (test "-0e-0" -0.0)
(test "#d-0e-10-0e-0i" (make-rectangular -0.0 -0.0)) (test "#d-0e-10-0e-0i" (make-rectangular -0.0 -0.0))
(test "-0.i" (make-rectangular 0.0 -0.0)) (test "-0.i" (make-rectangular 0.0 -0.0))
(test "#d#e-0.0f-0-.0s-0i" 0)
) )