Changeset 2738
- Timestamp:
- 2015-06-20T18:20:49-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/polynomial.lisp
r2735 r2738 102 102 103 103 104 (def un fast-addition (p q order-fn add-fun)104 (defmacro def-fast-add/subtract (order-fn add/subtract-fun &optional (uminus-fun nil uminus-fun-supplied-p)) 105 105 "Returns the sum of two polynomials. Implements an efficient 106 106 algorithm to add two polynomials represented as sorted lists of 107 107 terms. This function destroys both arguments, reusing the terms to 108 108 build the result." 109 (macrolet ((lc (x) `(r-coeff (car ,x)))) 110 (do ((p p) 111 (q q) 112 r) 113 ((or (endp p) (endp q)) 114 ;; NOTE: R contains the result in reverse order. Can it 115 ;; be more efficient to produce the terms in correct order? 116 (unless (endp q) (setf r (nreconc r q))) 117 r) 118 (multiple-value-bind 119 (greater-p equal-p) 120 (funcall order-fn (car p) (car q)) 121 (cond 122 (greater-p 123 (rotatef (cdr p) r p) 124 ) 125 (equal-p 126 (let ((s (funcall add-fun (lc p) (lc q)))) 127 (cond 128 ((r-zerop s) 129 (setf p (cdr p)) 130 ) 131 (t 132 (setf (lc p) s) 133 (rotatef (cdr p) r p)))) 134 (setf q (cdr q)) 135 ) 136 (t 137 (rotatef (cdr q) r q))))))) 109 `(lambda (p q) 110 (macrolet ((lc (x) `(r-coeff (car ,x)))) 111 (do ((p p) 112 (q q) 113 r) 114 ((or (endp p) (endp q)) 115 ;; NOTE: R contains the result in reverse order. Can it 116 ;; be more efficient to produce the terms in correct order? 117 (unless (endp q) (setf r (nreconc r q))) 118 r) 119 (multiple-value-bind 120 (greater-p equal-p) 121 (funcall ,order-fn (car p) (car q)) 122 (cond 123 (greater-p 124 (rotatef (cdr p) r p) 125 ) 126 (equal-p 127 (let ((s (funcall ,add/subtract-fun (lc p) (lc q)))) 128 (cond 129 ((r-zerop s) 130 (setf p (cdr p)) 131 ) 132 (t 133 (setf (lc p) s) 134 (rotatef (cdr p) r p)))) 135 (setf q (cdr q)) 136 ) 137 (t 138 ;;Negate the term of Q if UMINUS provided 139 ,@(when uminus-fun-supplied-p 140 `((setf (lc q) (funcall ,uminus-fun (lc q))))) 141 (rotatef (cdr q) r q)))))))) 138 142 139 143
Note:
See TracChangeset
for help on using the changeset viewer.