suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change * to Karatsuba

Browse Source 
original commit: 8038a1745b8d176bc97c1dd69024da76626eb775
This commit is contained in:
Matthew Flatt 2020-01-26 10:51:38 -07:00
parent 5587285fac
commit 6962aceaf0
1 changed files with 34 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
s/5_3.ss
View File

@ -2129,7 +2129,40 @@
(type-case x
[(fixnum? bignum?)
(type-case y
[(fixnum? bignum?) (integer* x y)]
[(fixnum?) (integer* x y)]
[(bignum?) (if (fixnum? x)
(integer* x y)
(let ()
;; _Modern Computer Arithmetic_, Brent and Zimmermann
(define (karatsuba x y)
(define xl (if (bignum? x) ($bignum-length x) 0))
(define yl (if (bignum? y) ($bignum-length y) 0))
(cond
[(and (fx< xl 10) (fx< yl 10))
(integer* x y)]
[else
(let* ([k (fx* (fxquotient (fxmax xl yl) 2) (constant bigit-bits))]
[x-hi (ash x (fx- k))]
[y-hi (ash y (fx- k))]
[x-lo (- x (ash x-hi k))]
[y-lo (- y (ash y-hi k))]
[c0 (karatsuba x-lo y-lo)]
[c1 (karatsuba x-hi y-hi)]
[c1-c2 (cond
[(< x-lo x-hi)
(cond
[(< y-lo y-hi)
(- c1 (karatsuba (- x-hi x-lo) (- y-hi y-lo)))]
[else
(+ c1 (karatsuba (- x-hi x-lo) (- y-lo y-hi)))])]
[else
(cond
[(< y-lo y-hi)
(+ c1 (karatsuba (- x-lo x-hi) (- y-hi y-lo)))]
[else
(- c1 (karatsuba (- x-lo x-hi) (- y-lo y-hi)))])])])
(+ c0 (integer-ash (+ c0 c1-c2) k) (integer-ash c1 (fx* 2 k))))]))
(karatsuba x y)))]
[(ratnum?) (/ (* x ($ratio-numerator y)) ($ratio-denominator y))]
[($exactnum? $inexactnum?)
(make-rectangular (* x (real-part y)) (* x (imag-part y)))]