conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- added two argument version of log 

- handled (/ flonum complexnum)
This commit is contained in:
Abdulaziz Ghuloum 2008-08-08 08:21:23 -07:00
parent 53cc48d23c
commit b7d9c0cf1f
2 changed files with 43 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
scheme/ikarus.numerics.ss
View File

@ -1174,6 +1174,7 @@
[(fixnum? y) ($fl/ x ($fixnum->flonum y))] [(fixnum? y) ($fl/ x ($fixnum->flonum y))]
[(bignum? y) ($fl/ x (bignum->flonum y))] [(bignum? y) ($fl/ x (bignum->flonum y))]
[(ratnum? y) ($fl/ x (ratnum->flonum y))] [(ratnum? y) ($fl/ x (ratnum->flonum y))]
[(or (cflonum? y) (compnum? y)) (x/compy x y)]
[else (err '/ y)])] [else (err '/ y)])]
[(fixnum? x) [(fixnum? x)
(cond (cond
@ -2756,42 +2757,48 @@
[else x]))) [else x])))
(define log (define log
(lambda (x) (case-lambda
(cond [(x)
[(fixnum? x) (cond
(cond [(fixnum? x)
[($fx= x 1) 0] (cond
[($fx= x 0) (die 'log "undefined around 0")] [($fx= x 1) 0]
[($fx> x 0) (foreign-call "ikrt_fx_log" x)] [($fx= x 0) (die 'log "undefined around 0")]
[else (make-rectangular (log (- x)) (acos -1))])] [($fx> x 0) (foreign-call "ikrt_fx_log" x)]
[(flonum? x) [else (make-rectangular (log (- x)) (acos -1))])]
(cond [(flonum? x)
[(fl>=? x 0.0) (foreign-call "ikrt_fl_log" x)] (cond
[else [(fl>=? x 0.0) (foreign-call "ikrt_fl_log" x)]
(make-rectangular [else
(log (fl- 0.0 x))
(acos -1))])]
[(bignum? x)
(if ($bignum-positive? x)
(let ([v (log (inexact x))])
(cond
[(infinite? v)
(let-values ([(s r) (exact-integer-sqrt x)])
;;; could the [dropped] residual ever affect the answer?
(fl* 2.0 (log s)))]
[else v]))
(make-rectangular (log (- x)) (acos -1)))]
[(ratnum? x)
;;; FIXME: incorrect as per bug 180170
(- (log (numerator x)) (log (denominator x)))]
[(or (compnum? x) (cflonum? x))
(let ([e 2.718281828459045])
(define (ln x) (/ (log x) (log e)))
(let ([xr (real-part x)] [xi (imag-part x)])
(make-rectangular (make-rectangular
(/ (ln (+ (* xr xr) (* xi xi))) 2) (log (fl- 0.0 x))
(atan xi xr))))] (acos -1))])]
[else (die 'log "not a number" x)]))) [(bignum? x)
(if ($bignum-positive? x)
(let ([v (log (inexact x))])
(cond
[(infinite? v)
(let-values ([(s r) (exact-integer-sqrt x)])
;;; could the [dropped] residual ever affect the answer?
(fl* 2.0 (log s)))]
[else v]))
(make-rectangular (log (- x)) (acos -1)))]
[(ratnum? x)
;;; FIXME: incorrect as per bug 180170
(- (log (numerator x)) (log (denominator x)))]
[(or (compnum? x) (cflonum? x))
(let ([e 2.718281828459045])
(define (ln x) (/ (log x) (log e)))
(let ([xr (real-part x)] [xi (imag-part x)])
(make-rectangular
(/ (ln (+ (* xr xr) (* xi xi))) 2)
(atan xi xr))))]
[else (die 'log "not a number" x)])]
[(x y)
(let ([ly (log y)])
(if (eqv? ly 0)
(die 'log "invalid arguments" x y)
(/ (log x) ly)))]))
(define (random n) (define (random n)
(if (fixnum? n) (if (fixnum? n)

2
scheme/last-revision
View File

@ -1 +1 @@
1574 1575