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 4102 for branches


Ignore:
Timestamp:
2016-06-01T12:33:31-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/division.lisp

    r4089 r4102  
    118118        ((cond
    119119           ((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
    120122            t)
    121123           ((divides-p (leading-monomial (car fl)) (leading-monomial p)) ;division occurred
     
    127129                ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
    128130                (mapl #'(lambda (x)
    129                           (setf (car x) (multiply (car x) c1)))
     131                          (setf (car x) (multiply-by (car x) c1)))
    130132                      a)
    131133                (setf r (multiply r c1)
     
    175177    (debug-cgb "/"))
    176178   (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
    180181    (debug-cgb "+")))
    181182  (values p r c division-count))
     
    209210      (normal-form-step fl f r c division-count))))
    210211
    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       (subtract
    222        (multiply (multiply mf f) cg)
    223        (multiply (multiply mg g) cf)))))
    224 
    225212(defun buchberger-criterion (g)
    226213  "Returns T if G is a Grobner basis, by using the Buchberger
     
    228215S(h1,h2) reduces to 0 modulo G."
    229216  (every #'universal-zerop
    230          (makelist (normal-form (spoly (elt g i) (elt g j)) g nil)
     217         (makelist (normal-form (s-polynomial (elt g i) (elt g j)) g nil)
    231218                   (i 0 (- (length g) 2))
    232219                   (j (1+ i) (1- (length g))))))
Note: See TracChangeset for help on using the changeset viewer.