Changeset 2604
- Timestamp:
- 2015-06-20T01:16:29-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/polynomial.lisp
r2603 r2604 91 91 self) 92 92 93 (defun fast-add-to (p q order-fn) 94 "Fast destructive addition of termlists P and Q, ordered by 95 predicate ORDER-FN. Note that this assumes the presence of a dummy 96 header." 97 (macrolet ((lt (x) `(cadr ,x)) 98 (lc (x) `(r-coeff (cadr ,x)))) 99 (do ((p p) 100 (q q)) 101 ((or (endp (cdr p)) (endp (cdr q))) 102 p) 103 (multiple-value-bind 104 (greater-p equal-p) 105 (funcall order-fn (lt q) (lt p)) 106 (cond 107 (greater-p 108 (rotatef (cdr p) (cdr q))) 109 (equal-p 110 (let ((s (add-to (lc p) (lc q)))) 111 (if (r-zerop s) 112 (setf (cdr p) (cddr p)) 113 (setf (lc p) s 114 q (cdr q))))))) 115 (setf p (cdr p))))) 93 116 94 117 (defmethod add-to ((self poly) (other poly)) … … 97 120 The result is stored in SELF. This implementation does 98 121 no consing, entirely reusing the sells of SELF and OTHER." 99 (flet ((fast-add-to (p q order-fn)100 ;; Fast destructive addition of termlists Note that this101 ;; assumes the presence of a dummy header."102 (macrolet ((lt (x) `(cadr ,x))103 (lc (x) `(r-coeff (cadr ,x))))104 (do ((p p)105 (q q))106 ((or (endp (cdr p)) (endp (cdr q)))107 p)108 (multiple-value-bind109 (greater-p equal-p)110 (funcall order-fn (lt q) (lt p))111 (cond112 (greater-p113 (rotatef (cdr p) (cdr q)))114 (equal-p115 (let ((s (add-to (lc p) (lc q))))116 (if (r-zerop s)117 (setf (cdr p) (cddr p))118 (setf (lc p) s119 q (cdr q)))))))120 (setf p (cdr p))))))121 122 (with-slots ((termlist1 termlist) (order1 order)) 122 123 self … … 134 135 (pop termlist1)))) 135 136 self) 136 137 (defmethod subtract-from ((self poly) (other poly)))138 137 139 138 (defmethod unary-uminus ((self poly)))
Note:
See TracChangeset
for help on using the changeset viewer.