Changeset 4102
- Timestamp:
- 2016-06-01T12:33:31-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/division.lisp
r4089 r4102 118 118 ((cond 119 119 ((endp fl) ;no division occurred 120 (setf r (add-to r (leading-term p)) ;move lt(p) to remainder 121 p (subtract-from p (leading-term p))) ;remove lt(p) from p 120 122 t) 121 123 ((divides-p (leading-monomial (car fl)) (leading-monomial p)) ;division occurred … … 127 129 ;; Multiply the equation c*f=sum ai*fi+r+p by c1. 128 130 (mapl #'(lambda (x) 129 (setf (car x) (multiply (car x) c1)))131 (setf (car x) (multiply-by (car x) c1))) 130 132 a) 131 133 (setf r (multiply r c1) … … 175 177 (debug-cgb "/")) 176 178 (t ;no division possible 177 (push (leading-term p) (poly-termlist r)) ;move lt(p) to remainder 178 ;;(setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p)))) 179 (pop (poly-termlist p)) ;remove lt(p) from p 179 (setf r (add-to r (leading-term p))) ;move lt(p) to remainder 180 (setf p (subtract-from p (leading-term p))) ;move lt(p) to remainder 180 181 (debug-cgb "+"))) 181 182 (values p r c division-count)) … … 209 210 (normal-form-step fl f r c division-count)))) 210 211 211 (defun spoly (f g)212 "It yields the S-polynomial of polynomials F and G."213 (declare (type poly f g))214 (let* ((lcm (universal-lcm (leading-monomial f) (leading-monomial g)))215 (mf (divide lcm (leading-monomial f)))216 (mg (divide lcm (leading-monomial g))))217 (declare (type monom mf mg))218 (multiple-value-bind (c cf cg)219 (universal-ezgcd (leading-coefficient f) (leading-coefficient g))220 (declare (ignore c))221 (subtract222 (multiply (multiply mf f) cg)223 (multiply (multiply mg g) cf)))))224 225 212 (defun buchberger-criterion (g) 226 213 "Returns T if G is a Grobner basis, by using the Buchberger … … 228 215 S(h1,h2) reduces to 0 modulo G." 229 216 (every #'universal-zerop 230 (makelist (normal-form (s poly(elt g i) (elt g j)) g nil)217 (makelist (normal-form (s-polynomial (elt g i) (elt g j)) g nil) 231 218 (i 0 (- (length g) 2)) 232 219 (j (1+ i) (1- (length g))))))
Note:
See TracChangeset
for help on using the changeset viewer.