Changeset 4431
- Timestamp:
- 2016-06-09T22:48:11-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/fast-add.lisp
r4430 r4431 1 (load "boot") 2 3 (use-package :polynomial) 4 (use-package :monom) 5 6 ;;(shadow '(fast-add) "POLYNOMIAL") 1 7 2 8 ;; Getter/setter of leading coefficient … … 4 10 (defun (setf lc) (new-value x) (setf (term-coeff (car x)) new-value)) 5 11 12 (defvar order-fn #'lex>) 13 (defvar add-fn #'add-to) 14 6 15 (defun fast-add-helper (p q) 7 "It assumes that p and q are non-zero polynomials, i.e. non-empty lists of terms." 8 (multiple-value-bind 9 (greater-p equal-p) 10 (funcall order-fn (car p) (car q)) 11 (cond 12 (greater-p 13 (fast-add-helper (cdr p) q)) 14 (equal-p 15 (let ((s (funcall add-fn (lc p) (lc q)))) 16 (cond 17 ((universal-zerop s) 18 (setf p (cdr p)) 19 ) 20 (t 21 (setf (lc p) s) 22 (fast-add-helper (cdr p) (cdr q))))) 23 (setf q (cdr q)) 24 ) 25 (t 26 (fast-add-helper (cdr q) p))))) 16 (do ((h p)) 17 ((endp q) p) 18 (multiple-value-bind 19 (greater-p equal-p) 20 (funcall order-fn (car h) (car q)) 21 (cond 22 (greater-p ; (> (lm h) (lm q)) 23 (setf h (cdr h)) 24 ) 25 (equal-p ; (= (lm h) (lm q)) 26 (let ((s (funcall add-fn (lc h) (lc q)))) 27 (cond 28 ((universal-zerop s) 29 (cond 30 (setf h (cdr h) 31 q (cdr q)))) 32 (t 33 ;; Adjust the lc of p 34 (setf (lc h) s) 35 (setf h (cdr h) 36 q (cdr q)))))) 27 37 28 (defun fast-add (p q order-fn add-fn &aux r) 29 "Add two polynomials, P and Q, represented as lists of terms. 30 The operation is destructive to both polynomials, as the terms 31 of both lists are combined into the result. The operation does not 32 create any new instance of TERM." 33 (cond ((endp p) q) 34 ((endp q) p) 35 (t (fast-add-helper p q)))) 38 (t ;(< (lm h) (lm q)) 39 36 40 41 42 43 44
Note:
See TracChangeset
for help on using the changeset viewer.