Commit d652bd09 by Raymond Toy

### Rename functions to use the new version by default.

`Update tests to reflect the change in names.`
parent 3af22f92
Pipeline #302 failed with stage
in 27 minutes and 42 seconds
 ... ... @@ -884,7 +884,12 @@ down to individual words.") (negate-bignum-in-place result)) (%normalize-bignum result (1+ (* 2 n)))))))) (defun classical-multiply-bignums (a b) ;; Bignum multiply using Knuth's algorithm. We keep this around for ;; now so we can compare the new algorithm against this to make sure ;; this are working. ;; ;; TODO: Remove this eventually? (defun classical-multiply-bignums-knuth (a b) (declare (type bignum-type a b)) (let* ((a-plusp (%bignum-0-or-plusp a (%bignum-length a))) (b-plusp (%bignum-0-or-plusp b (%bignum-length b))) ... ... @@ -916,16 +921,29 @@ down to individual words.") (when negate-res (negate-bignum-in-place res)) (%normalize-bignum res len-res))) ;; Pretend the bignums are actually unsigned, do an unsigned multiply ;; and then correct the result. This is based on the algorithm in ;; Hacker's Delight. (defun classical-multiply-bignum-hd (a b) ;; Classical multiplication of bignums using Knuth's algorithm ;; modified to handle signed bignums. Pretend the bignums are ;; actually unsigned, do an unsigned multiply and then correct the ;; result. This is based on the algorithm in Hacker's Delight. ;; ;; Let a[n] and b[n] represent the individual bits of each bignum with ;; M being the number of bits in a and N being the number of bits in ;; b. If these are interpreted as an unsigned number, then we are ;; multiplying numbers ;; ;; (a + 2^M*a[M-1})*(b + 2^N*b[N-1]) ;; = a*b + 2^M*u[M-1]*b + 2^N*b[N-1]*a + 2^(M+N)*a[M-1]*b[M-1] ;; ;; To get the desired result, we need to subtract out the term ;; 2^M*u[M-1]*b + 2^N*b[N-1]*a from the product. The last term ;; doesn't need to subtracted because we know the product fits in M+N ;; bits and this term is beyond that. (defun classical-multiply-bignums (a b) (declare (type bignum-type a b)) (let* ((len-a (%bignum-length a)) (len-b (%bignum-length b)) (len-res (+ len-a len-b)) (res (%allocate-bignum len-res))) (negate-res (not (eq a-plusp b-plusp)))) (declare (type bignum-index len-a len-b len-res)) ;; Unsigned multiply (dotimes (i len-a) ... ... @@ -937,36 +955,39 @@ down to individual words.") (type bignum-element-type carry-digit x)) (dotimes (j len-b) (multiple-value-bind (big-carry res-digit) (%multiply-and-add x (%bignum-ref b j) (%bignum-ref res k) carry-digit) (%multiply-and-add x (%bignum-ref b j) (%bignum-ref res k) carry-digit) (declare (type bignum-element-type big-carry res-digit)) (setf (%bignum-ref res k) res-digit) (setf carry-digit big-carry) (incf k))) (setf (%bignum-ref res k) carry-digit))) ;; Apply corrections if either of the arguments is negative. ;; If a < 0, subtract b*2^M from the result (unless(%bignum-0-or-plusp a) (unless (%bignum-0-or-plusp a len-a) (let ((borrow 1)) (dotimes (j len-b) (declare (type bignum-index j)) (let ((index (+ j len-a))) (declare (type bignum-index index)) (multiple-value-bind (d borrow-out) (%subtract-with-borrow (bignum-ref res index) (bignum-ref b j) (%subtract-with-borrow (%bignum-ref res index) (%bignum-ref b j) borrow) (setf (bignum-ref res index) d) (setf (%bignum-ref res index) d) (setf borrow borrow-out)))))) (unless (%bignum-0-or-plusp b) (unless (%bignum-0-or-plusp b len-b) (let ((borrow 1)) (dotimes (j len-a) (declare (type bignum-index j)) (let ((index (+ j len-b))) (multiple-value-bind (d borrow-out) (%subtract-with-borrow (bignum-ref res index) (bignum-ref a j) borrow) (setf (bignum-ref res index) d) (setf borrow borrow-out))))) (declare (type bignum-index index)) (multiple-value-bind (d borrow-out) (%subtract-with-borrow (%bignum-ref res index) (%bignum-ref a j) borrow) (setf (%bignum-ref res index) d) (setf borrow borrow-out)))))) (%normalize-bignum res len-res))) (defparameter *min-karatsuba-bits* 512 ... ...
 ... ... @@ -21,8 +21,8 @@ (dotimes (k 100) (let* ((r1 (gen-bignum range (random 2 rng))) (r2 (gen-bignum range (random 2 rng))) (prod-knuth (bignum::classical-multiply-bignums r1 r2)) (prod-hd (bignum::classical-multiply-bignum-hd r1 r2))) (prod-knuth (bignum::classical-multiply-bignums-knuth r1 r2)) (prod-hd (bignum::classical-multiply-bignums r1 r2))) (assert-equal prod-knuth prod-hd r1 r2)))))) ... ... @@ -45,12 +45,12 @@ (r2 (gen-bignum range 1)) res) (time (dotimes (k reps) (declare (fixnum k)) (setf res (bignum::classical-multiply-bignums r1 r2)))) (declare (fixnum k)) (setf res (bignum::classical-multiply-bignums-knuth r1 r2)))) (print res) (time (dotimes (k reps) (declare (fixnum k)) (setf res (bignum::classical-multiply-bignum-hd r1 r2)))) (declare (fixnum k)) (setf res (bignum::classical-multiply-bignums r1 r2)))) (print res)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment