Changeset 4070 for branches/f4grobner
- Timestamp:
- 2016-05-31T19:22:21-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/division.lisp
r4065 r4070 61 61 ;; terms are dropped. 62 62 (subtract 63 (multiply c2 f)64 (multiply c1 (multiply m g))))63 (multiply f c2) 64 (multiply (multiply m g) c1))) 65 65 66 66 (defun check-loop-invariant (c f a fl r p … … 83 83 |# 84 84 (let* ((prod (inner-product a fl add multiply p-zero)) 85 (succeeded-p (universal-zerop (subtract (multiply c f) (add prod r p)))))85 (succeeded-p (universal-zerop (subtract (multiply f c) (add prod r p))))) 86 86 (unless succeeded-p 87 87 (error "#### Polynomial division Loop invariant failed ####:~%C=~A~%F=~A~%A=~A~%FL=~A~%R=~A~%P=~A~%" … … 111 111 (when (universal-zerop r) (debug-cgb " ---> 0")) 112 112 ;; We obtained the terms in reverse order, so must fix that 113 (setf a (mapcar #'poly- nreverse a)114 r (poly- nreverse r))113 (setf a (mapcar #'poly-reverse a) 114 r (poly-reverse r)) 115 115 ;; Initialize the sugar of the quotients 116 116 ;; (mapc #'poly-reset-sugar a) ;; TODO: Sugar is currently unimplemented … … 135 135 ;; Multiply the equation c*f=sum ai*fi+r+p by c1. 136 136 (mapl #'(lambda (x) 137 (setf (car x) (multiply c1 (car x))))137 (setf (car x) (multiply (car x) c1))) 138 138 a) 139 (setf r (multiply c1 r)139 (setf r (multiply r c1) 140 140 c (multiply c c1) 141 141 p (grobner-op c2 c1 m p (car fl))) 142 (push (change-class m 'term :coeff c2) (poly-termlist (car b)))) 142 (push (change-class m 'term :coeff c2) 143 (poly-termlist (car b)))) 143 144 t)))) 144 145 ))) … … 176 177 (let ((m (divide (leading-monomial p) (leading-monomial g)))) 177 178 ;; Multiply the equation c*f=sum ai*fi+r+p by cg. 178 (setf r (multiply cg r)179 (setf r (multiply r cg) 179 180 c (multiply c cg) 180 181 ;; p := cg*p-cp*m*g … … 227 228 (declare (ignore c)) 228 229 (subtract 229 (multiply cg (multiply mf f))230 (multiply cf (multiply mg g))))))230 (multiply (multiply mf f) cg) 231 (multiply (multiply mg g) cf))))) 231 232 232 233 (defun buchberger-criterion (g)
Note:
See TracChangeset
for help on using the changeset viewer.