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 4135 for branches/f4grobner


Ignore:
Timestamp:
2016-06-01T19:50:56-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/pair-queue.lisp

    r4002 r4135  
    2727           "CRITICAL-PAIR-QUEUE"
    2828           "SELECTION-STRATEGY"
    29            "MIN-TOTAL-DEGREE-STRATEGY"
    30            "MIN-COMBINED-LENGTH-STRATEGY"
     29           "+NORMAL-STRATEGY+"
     30           "+MIN-TOTAL-DEGREE-STRATEGY+"
     31           "+MIN-COMBINED-LENGTH-STRATEGY+"
    3132           "MAKE-CRITICAL-PAIR-QUEUE"
    3233           )
     
    5859                  :initarg :pair-order-fn
    5960                  :accessor pair-order-fn))
    60   (:documentation "Represents the normal critical pair selection
    61 strategy.  The two ingredients of a strategy is a function
     61  (:documentation "The two ingredients of a strategy is a function
    6262PAIR-KEY-FUNCTION which computes a key from the critical pair, which
    6363can be any type of data, and a function PAIR-ORDER-FN used to compaire
     
    7575              pair-key-fn pair-order-fn))))
    7676
    77 (defclass min-total-degree-strategy (selection-strategy)
    78   ((pair-key-fn :initform #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q)))))
    79    (pair-order-fn :initform #'<))
    80   (:documentation "Make a selection strategy where a pair with a
    81 minimum total degree of LCM of leading monomials is selected."))
     77(defparameter +normal-strategy+
     78  (make-instance
     79   'selection-strategy
     80   :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q)))
     81   :pair-order-fn #'lex>)
     82  "The normal selection strategy where a pair with the largest LCM of
     83leading monomials is selected.")
    8284
    83 (defclass min-combined-length-strategy (selection-strategy)
    84   ((pair-key-fn :initform #'(lambda (p q) (+ (poly-length p) (poly-length q))))
    85    (pair-order-fn :initform #'<))
    86   (:documentation "Make a selection strategy where a pair with the minimum combined length of both
    87 polynomials is selected."))
     85(defparameter +min-total-degree-strategy+
     86  (make-instance
     87   'selection-strategy
     88   :pair-key-fn #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q))))
     89   :pair-order-fn #'<)
     90  "A selection strategy where a pair with a minimum total degree of
     91  LCM of leading monomials is selected.")
    8892
    89 (defun make-critical-pair-queue (&key pair-key-fn pair-order-fn (poly-list nil) (start 1)
    90                                  &aux (pq (make-instance 'priority-queue
    91                                                          :element-type 'critical-pair
    92                                                          :element-key #'(lambda (pair) (funcall pair-key-fn
    93                                                                                                 (critical-pair-first pair)
    94                                                                                                 (critical-pair-second pair)))
    95                                                          :test pair-order-fn)))
    96   "Makes a priority queue for critical pairs. The argument POLY-LIST should the initial list of polynomials.
    97 and START is the first position beyond the elements which form a
    98 partial Grobner basis, i.e. satisfy the Buchberger criterion."
    99     ;; Add critical pairs for polynomials in POLY-LIST
    100   (let* ((s (1- (length poly-list)))
    101          (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
    102                              (i 0 (1- start)) (j start s))
    103                    (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
    104                              (i start (1- s)) (j (1+ i) s)))))
    105     (dolist (pair b pq)
    106       (enqueue pq pair))))
     93(defparameter +min-combined-length-strategy+
     94  (make-instance
     95   'selection-strategy
     96   :pair-key-fn #'(lambda (p q) (+ (poly-length p) (poly-length q)))
     97   :pair-order-fn #'<)
     98  "A selection strategy where a pair with the minimum combined length of both
     99polynomials is selected.")
     100
     101(defclass critical-pair-queue (priority-queue)
     102  ()
     103  (:documentation "Implements critical pair priority queue."))
     104
     105(defmethod allocate-instance ((self critical-pair-queue) &key strategy poly-list start)
     106  "Allocates a priority queue SELF for critical pairs from strategy SELF."
     107  (declare (ignore poly-list start))
     108  (with-slots (pair-key-fn pair-order-fn)
     109      strategy
     110    (reinitialize-instance self
     111                           :element-type 'critical-pair
     112                           :element-key #'(lambda (pair) (funcall pair-key-fn
     113                                                                  (critical-pair-first pair)
     114                                                                  (critical-pair-second pair)))
     115                           :test pair-order-fn)))
     116
     117(defgeneric enqueue-critical-pairs (self &optional poly-list start)
     118  (:method ((self critical-pair-queue) &optional (poly-list nil) (start 0))
     119    "The argument POLY-LIST should the initial list of
     120polynomials.  and START is the first position beyond the elements
     121which form a partial Grobner basis, i.e. satisfy the Buchberger
     122criterion."
     123    (let* ((s (1- (length poly-list)))
     124           (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
     125                               (i 0 (1- start)) (j start s))
     126                     (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
     127                               (i start (1- s)) (j (1+ i) s)))))
     128      (dolist (pair b self)
     129        (enqueue self pair)))))
    107130
    108131
Note: See TracChangeset for help on using the changeset viewer.