Added make-polar.
This commit is contained in:
parent
195dc0ea45
commit
0ef81aa13e
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1539
|
1540
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue