close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 4070 for branches


Ignore:
Timestamp:
2016-05-31T19:22:21-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/division.lisp

    r4065 r4070  
    6161  ;; terms are dropped.
    6262  (subtract
    63    (multiply c2 f)
    64    (multiply c1 (multiply m g))))
     63   (multiply f c2)
     64   (multiply (multiply m g) c1)))
    6565
    6666(defun check-loop-invariant (c f a fl r p
     
    8383  |#
    8484  (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)))))
    8686    (unless succeeded-p
    8787      (error "#### Polynomial division Loop invariant failed ####:~%C=~A~%F=~A~%A=~A~%FL=~A~%R=~A~%P=~A~%"
     
    111111       (when (universal-zerop r) (debug-cgb " ---> 0"))
    112112       ;; 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))
    115115       ;; Initialize the sugar of the quotients
    116116       ;; (mapc #'poly-reset-sugar a) ;; TODO: Sugar is currently unimplemented
     
    135135                ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
    136136                (mapl #'(lambda (x)
    137                           (setf (car x) (multiply c1 (car x))))
     137                          (setf (car x) (multiply (car x) c1)))
    138138                      a)
    139                 (setf r (multiply c1 r)
     139                (setf r (multiply r c1)
    140140                      c (multiply c c1)
    141141                      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))))
    143144              t))))
    144145      )))
     
    176177      (let ((m (divide (leading-monomial p) (leading-monomial g))))
    177178        ;; Multiply the equation c*f=sum ai*fi+r+p by cg.
    178         (setf r (multiply cg r)
     179        (setf r (multiply r cg)
    179180              c (multiply c cg)
    180181              ;; p := cg*p-cp*m*g
     
    227228      (declare (ignore c))
    228229      (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)))))
    231232
    232233(defun buchberger-criterion (g)
Note: See TracChangeset for help on using the changeset viewer.