Changeset 1207
- Timestamp:
- 2015-06-11T11:24:11-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/division.lisp
r1206 r1207 85 85 (values (mapcar #'poly-nreverse a) (poly-nreverse r) c division-count)) 86 86 (declare (fixnum division-count)) 87 (do ((fl fl (rest fl)) 87 (do ((fl fl (rest fl)) ;scan list of divisors 88 88 (b a (rest b))) 89 89 ((cond 90 ((endp fl);no division occurred91 (push (poly-lt p) (poly-termlist r));move lt(p) to remainder92 (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))93 (pop (poly-termlist p));remove lt(p) from p94 t)95 ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred96 (incf division-count)97 (multiple-value-bind (gcd c1 c2)98 99 (declare (ignore gcd))100 (let ((m (monom-div (poly-lm p) (poly-lm (car fl)))))101 102 103 (setf (car x) (scalar-times-poly ring c1 (car x))))104 a)105 106 c (funcall (ring-mul ring) c c1)107 p (grobner-op ring-and-order c2 c1 m p (car fl)))108 109 t)))))))90 ((endp fl) ;no division occurred 91 (push (poly-lt p) (poly-termlist r)) ;move lt(p) to remainder 92 (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p)))) 93 (pop (poly-termlist p)) ;remove lt(p) from p 94 t) 95 ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred 96 (incf division-count) 97 (multiple-value-bind (gcd c1 c2) 98 (funcall (ring-ezgcd ring) (poly-lc (car fl)) (poly-lc p)) 99 (declare (ignore gcd)) 100 (let ((m (monom-div (poly-lm p) (poly-lm (car fl))))) 101 ;; Multiply the equation c*f=sum ai*fi+r+p by c1. 102 (mapl #'(lambda (x) 103 (setf (car x) (scalar-times-poly ring c1 (car x)))) 104 a) 105 (setf r (scalar-times-poly ring c1 r) 106 c (funcall (ring-mul ring) c c1) 107 p (grobner-op ring-and-order c2 c1 m p (car fl))) 108 (push (make-term m c2) (poly-termlist (car b)))) 109 t))))))) 110 110 111 111 (defun poly-exact-divide (ring f g)
Note:
See TracChangeset
for help on using the changeset viewer.