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


Ignore:
Timestamp:
2016-06-03T09:57:35-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/criterion.lisp

    r4125 r4173  
    3232(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
    3333
    34 (defun criterion-1 (pair)
    35   "Returns T if the leading monomials of the two polynomials
    36 in G pointed to by the integers in PAIR have disjoint (relatively prime)
    37 monomials. This test is known as the first Buchberger criterion."
    38   (declare (type critical-pair pair))
    39   (let ((f (critical-pair-first pair))
    40         (g (critical-pair-second pair)))
    41     (when (rel-prime-p (leading-monomial f) (leading-monomial g))
    42       (debug-cgb ":1")
    43       (return-from criterion-1 t))))
     34(defgeneric criterion-1 (pair)
     35  (:documentation "Returns T if the leading monomials of the two
     36polynomials in G pointed to by the integers in PAIR have
     37disjoint (relatively prime) monomials. This test is known as the first
     38Buchberger criterion.")
     39  (:method ((pair critical-pair))
     40    (let ((f (critical-pair-first pair))
     41          (g (critical-pair-second pair)))
     42      (when (rel-prime-p (leading-monomial f) (leading-monomial g))
     43        (debug-cgb ":1")
     44        (return-from criterion-1 t)))))
    4445
    45 (defun criterion-2 (pair b-done partial-basis
    46                     &aux (f (critical-pair-first pair)) (g (critical-pair-second pair))
    47                          (place :before))
    48   "Returns T if the leading monomial of some element P of
    49 PARTIAL-BASIS divides the LCM of the leading monomials of the two
     46(defgeneric criterion-2 (pair b-done partial-basis)
     47  (:documentation "Returns T if the leading monomial of some element P
     48of PARTIAL-BASIS divides the LCM of the leading monomials of the two
    5049polynomials in the polynomial list PARTIAL-BASIS, and P paired with
    5150each of the polynomials pointed to by the the PAIR has already been
    52 treated, as indicated by the absence in the hash table B-done."
    53   (declare (type critical-pair pair) (type hash-table b-done)
    54            (type poly f g))
    55   ;; In the code below we assume that pairs are ordered as follows:
    56   ;; if PAIR is (I J) then I appears before J in the PARTIAL-BASIS.
    57   ;; We traverse the list PARTIAL-BASIS and keep track of where we
    58   ;; are, so that we can produce the pairs in the correct order
    59   ;; when we check whether they have been processed, i.e they
    60   ;; appear in the hash table B-done
    61   (dolist (h partial-basis nil)
    62     (cond
    63      ((eq h f)
    64       #+grobner-check(assert (eq place :before))
    65       (setf place :in-the-middle))
    66      ((eq h g)
    67       #+grobner-check(assert (eq place :in-the-middle))
    68       (setf place :after))
    69      ((and (divides-lcm-p (leading-monomial h) (leading-monomial f) (leading-monomial g))
    70            (gethash (case place
    71                       (:before (list h f))
    72                       ((:in-the-middle :after) (list f h)))
    73                     b-done)
    74            (gethash (case place
    75                       ((:before :in-the-middle) (list h g))
    76                       (:after (list g h)))
    77                     b-done))
    78       (debug-cgb ":2")
    79       (return-from criterion-2 t)))))
     51treated, as indicated by the absence in the hash table B-done.")
     52  (:method ((pair critical-pair) (b-done hash-table) partial-basis
     53            &aux (f (critical-pair-first pair)) (g (critical-pair-second pair))
     54              (place :before))
     55    (declare (type poly f g))
     56    ;; In the code below we assume that pairs are ordered as follows:
     57    ;; if PAIR is (I J) then I appears before J in the PARTIAL-BASIS.
     58    ;; We traverse the list PARTIAL-BASIS and keep track of where we
     59    ;; are, so that we can produce the pairs in the correct order
     60    ;; when we check whether they have been processed, i.e they
     61    ;; appear in the hash table B-done
     62    (dolist (h partial-basis nil)
     63      (cond
     64        ((eq h f)
     65         #+grobner-check(assert (eq place :before))
     66         (setf place :in-the-middle))
     67        ((eq h g)
     68         #+grobner-check(assert (eq place :in-the-middle))
     69         (setf place :after))
     70        ((and (divides-lcm-p (leading-monomial h)
     71                             (leading-monomial f)
     72                             (leading-monomial g))
     73              (gethash (case place
     74                         (:before (list h f))
     75                         ((:in-the-middle :after) (list f h)))
     76                       b-done)
     77              (gethash (case place
     78                         ((:before :in-the-middle) (list h g))
     79                         (:after (list g h)))
     80                       b-done))
     81         (debug-cgb ":2")
     82         (return-from criterion-2 t))))))
    8083
Note: See TracChangeset for help on using the changeset viewer.