;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage "PAIR-QUEUE" (:use :cl :priority-queue :monom :polynomial :symbolic-polynomial :utils) (:export "CRITICAL-PAIR" "CRITICAL-PAIR-FIRST" "CRITICAL-PAIR-SECOND" "CRITICAL-PAIR-QUEUE" "SELECTION-STRATEGY" "+NORMAL-STRATEGY+" "+MIN-TOTAL-DEGREE-STRATEGY+" "+MIN-COMBINED-LENGTH-STRATEGY+" "MAKE-CRITICAL-PAIR-QUEUE" "MAKE-CRITICAL-PAIRS" ) (:documentation "Critical pair queue implementation. The pair queue is a list of critical pairs, ordered by some partial order. Pair queue is a kind of priority queue.") ) (in-package :pair-queue) (defclass critical-pair () ((first :initform nil :initarg :first :accessor critical-pair-first :type poly) (second :initform nil :initarg :second :accessor critical-pair-second :type poly)) (:documentation "Represents a critical pair, i.e. a pair of two polynomials. The derived classes may add extra data used in computing the order of critical pairs.")) (defmethod print-object ((self critical-pair) stream) (print-unreadable-object (self stream :type t :identity t) (with-accessors ((first critical-pair-first) (second critical-pair-second)) self (format stream "FIRST=~A SECOND=~A" first second)))) (defclass selection-strategy () ((pair-key-fn :initform (error "Initarg :pair-key-fn must be specified.") :initarg :pair-key-fn :accessor pair-key-fn) (pair-order-fn :initform (error "Initarg :pair-order-fn must be specified.") :initarg :pair-order-fn :accessor pair-order-fn)) (:documentation "The two ingredients of a strategy is a function PAIR-KEY-FUNCTION which computes a key from the critical pair, which can be any type of data, and a function PAIR-ORDER-FN used to compaire the calculated keys to determine which pair is more promising and should be considered first. The normal selection strategy for a given monomial order PAIR-ORDER-FN consists in selecting the pair with the minimal LCM of leading monomials first.")) (defmethod print-object ((self selection-strategy) stream) (print-unreadable-object (self stream :type t :identity t) (with-accessors ((pair-key-fn pair-key-fn) (pair-order-fn pair-order-fn)) self (format stream "PAIR-KEY-FN=~A PAIR-ORDER-FN=~A" pair-key-fn pair-order-fn)))) (defparameter *normal-strategy* (make-instance 'selection-strategy :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q))) :pair-order-fn #'lex>) "The normal selection strategy where a pair with the largest LCM of leading monomials is selected.") (defparameter *min-total-degree-strategy* (make-instance 'selection-strategy :pair-key-fn #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q)))) :pair-order-fn #'<) "A selection strategy where a pair with a minimum total degree of LCM of leading monomials is selected.") (defparameter *min-combined-length-strategy* (make-instance 'selection-strategy :pair-key-fn #'(lambda (p q) (+ (poly-length p) (poly-length q))) :pair-order-fn #'<) "A selection strategy where a pair with the minimum combined length of both polynomials is selected.") (defclass critical-pair-queue (priority-queue) () (:documentation "Specializes class PRIORITY-QUEUE to ELEMENT-TYPE set to CRITICAL-PAIR.")) (defmethod initialize-instance :before ((self critical-pair-queue) &key) "Initializes the slot ELEMENT-TYPE to symbol CRITICAL-PAIR-QUEUE. This overrides the default ELEMENT-TYPE in the superclass." (with-slots ((element-type-x priority-queue::element-type)) self (setf element-type-x 'critical-pair)) self) (defun make-critical-pairs (poly-list &optional (start 0) &aux (s (1- (length poly-list)))) "Create a list of critical pairs. The argument POLY-LIST is the initial list of polynomials and START is the first position beyond the elements which form a partial Grobner basis, i.e. satisfy the Buchberger criterion." (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) (i 0 (1- start)) (j start s)) (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) (i start (1- s)) (j (1+ i) s)))) (defgeneric enqueue-critical-pairs (self pair-lst) (:documentation "Place pairs in PAIR-LST on the queue SELF.") (:method ((self critical-pair-queue) pair-lst) "Enqueue into queue QUEUE the elements of the list PAIR-LST." (dolist (pair pair-lst self) (enqueue self pair)))) (defgeneric make-critical-pair-queue (object &optional poly-lst start) (:documentation "Creates a CRITICAL-PAIR-QUEUE from an object OBJECT.") (:method ((object selection-strategy) &optional (poly-lst nil) (start 0)) "Creates a CRITICAL-PAIR-QUEUE from a selection strategy OBJECT." (with-slots (pair-key-fn pair-order-fn) object (let ((queue (make-instance 'critical-pair-queue :element-key #'(lambda (pair) (funcall pair-key-fn (critical-pair-first pair) (critical-pair-second pair))) :test pair-order-fn))) (enqueue-critical-pairs queue (make-critical-pairs poly-lst start))))))