[1201] | 1 | ;;; -*- Mode: Lisp -*-
|
---|
[76] | 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
| 3 | ;;;
|
---|
| 4 | ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>
|
---|
| 5 | ;;;
|
---|
| 6 | ;;; This program is free software; you can redistribute it and/or modify
|
---|
| 7 | ;;; it under the terms of the GNU General Public License as published by
|
---|
| 8 | ;;; the Free Software Foundation; either version 2 of the License, or
|
---|
| 9 | ;;; (at your option) any later version.
|
---|
| 10 | ;;;
|
---|
| 11 | ;;; This program is distributed in the hope that it will be useful,
|
---|
| 12 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 14 | ;;; GNU General Public License for more details.
|
---|
| 15 | ;;;
|
---|
| 16 | ;;; You should have received a copy of the GNU General Public License
|
---|
| 17 | ;;; along with this program; if not, write to the Free Software
|
---|
| 18 | ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
---|
| 19 | ;;;
|
---|
| 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
| 21 |
|
---|
[449] | 22 | (defpackage "PAIR-QUEUE"
|
---|
[3949] | 23 | (:use :cl :priority-queue :monom :polynomial :symbolic-polynomial :utils)
|
---|
[3920] | 24 | (:export "CRITICAL-PAIR"
|
---|
| 25 | "CRITICAL-PAIR-FIRST"
|
---|
| 26 | "CRITICAL-PAIR-SECOND"
|
---|
[3948] | 27 | "CRITICAL-PAIR-QUEUE"
|
---|
[3964] | 28 | "SELECTION-STRATEGY"
|
---|
[4135] | 29 | "+NORMAL-STRATEGY+"
|
---|
| 30 | "+MIN-TOTAL-DEGREE-STRATEGY+"
|
---|
| 31 | "+MIN-COMBINED-LENGTH-STRATEGY+"
|
---|
[3977] | 32 | "MAKE-CRITICAL-PAIR-QUEUE"
|
---|
[3918] | 33 | )
|
---|
| 34 | (:documentation "Critical pair queue implementation. The pair queue is a list of critical
|
---|
| 35 | pairs, ordered by some partial order. Pair queue is a kind of priority queue.")
|
---|
| 36 | )
|
---|
[449] | 37 |
|
---|
[450] | 38 | (in-package :pair-queue)
|
---|
| 39 |
|
---|
[3919] | 40 | (defclass critical-pair ()
|
---|
[3921] | 41 | ((first :initform nil :initarg :first :accessor critical-pair-first :type poly)
|
---|
| 42 | (second :initform nil :initarg :second :accessor critical-pair-second :type poly))
|
---|
[3930] | 43 | (:documentation "Represents a critical pair, i.e. a pair of two polynomials. The derived
|
---|
| 44 | classes may add extra data used in computing the order of critical pairs."))
|
---|
[3919] | 45 |
|
---|
[3921] | 46 | (defmethod print-object ((self critical-pair) stream)
|
---|
[3920] | 47 | (print-unreadable-object (self stream :type t :identity t)
|
---|
| 48 | (with-accessors ((first critical-pair-first)
|
---|
| 49 | (second critical-pair-second))
|
---|
| 50 | self
|
---|
| 51 | (format stream "FIRST=~A SECOND=~A"
|
---|
| 52 | first second))))
|
---|
| 53 |
|
---|
[3927] | 54 | (defclass selection-strategy ()
|
---|
[4138] | 55 | ((pair-key-fn :initform (error "Initarg :pair-key-fn must be specified.")
|
---|
[3959] | 56 | :initarg :pair-key-fn
|
---|
| 57 | :accessor pair-key-fn)
|
---|
[4138] | 58 | (pair-order-fn :initform (error "Initarg :pair-order-fn must be specified.")
|
---|
[3959] | 59 | :initarg :pair-order-fn
|
---|
| 60 | :accessor pair-order-fn))
|
---|
[4135] | 61 | (:documentation "The two ingredients of a strategy is a function
|
---|
[3940] | 62 | PAIR-KEY-FUNCTION which computes a key from the critical pair, which
|
---|
| 63 | can be any type of data, and a function PAIR-ORDER-FN used to compaire
|
---|
| 64 | the calculated keys to determine which pair is more promising and
|
---|
[3941] | 65 | should be considered first. The normal selection strategy for a given
|
---|
| 66 | monomial order PAIR-ORDER-FN consists in selecting the pair with the
|
---|
| 67 | minimal LCM of leading monomials first."))
|
---|
[60] | 68 |
|
---|
[3932] | 69 | (defmethod print-object ((self selection-strategy) stream)
|
---|
| 70 | (print-unreadable-object (self stream :type t :identity t)
|
---|
| 71 | (with-accessors ((pair-key-fn pair-key-fn)
|
---|
| 72 | (pair-order-fn pair-order-fn))
|
---|
| 73 | self
|
---|
| 74 | (format stream "PAIR-KEY-FN=~A PAIR-ORDER-FN=~A"
|
---|
| 75 | pair-key-fn pair-order-fn))))
|
---|
| 76 |
|
---|
[4135] | 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
|
---|
| 83 | leading monomials is selected.")
|
---|
[3932] | 84 |
|
---|
[4135] | 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.")
|
---|
[3933] | 92 |
|
---|
[4135] | 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
|
---|
| 99 | polynomials is selected.")
|
---|
[3938] | 100 |
|
---|
[4135] | 101 | (defclass critical-pair-queue (priority-queue)
|
---|
| 102 | ()
|
---|
| 103 | (:documentation "Implements critical pair priority queue."))
|
---|
[3944] | 104 |
|
---|
[4139] | 105 | (defmethod initialize-instance :after ((self critical-pair-queue) &key strategy poly-list start)
|
---|
[4135] | 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
|
---|
| 120 | polynomials. and START is the first position beyond the elements
|
---|
| 121 | which form a partial Grobner basis, i.e. satisfy the Buchberger
|
---|
| 122 | criterion."
|
---|
| 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)))))
|
---|
| 130 |
|
---|
| 131 |
|
---|