;;; -*- 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" "ENQUEUE" "DEQUEUE" "QUEUE-SIZE" "QUEUE-EMPTY-P" ) (: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 #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q))) :initarg :pair-key-fn :accessor pair-key-fn) (pair-order-fn :initform #'lex> :initarg :pair-order-fn :accessor pair-order-fn)) (:documentation "Represents the normal critical pair selection strategy. 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)))) (defclass min-total-degree-strategy (selection-strategy) ((pair-key-fn :initform #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q))))) (pair-order-fn :initform #'<)) (:documentation "Make a selection strategy where a pair with a minimum total degree of LCM of leading monomials is selected.")) (defclass minimal-length-strategy (selection-strategy) ((pair-key-fn :initform #'(lambda (p q) (+ (poly-length p) (poly-length q)))) (pair-order-fn :initform #'<)) (:documentation "Make a selection strategy where a pair with the minimum combined length of both polynomials is selected.")) (defclass critical-pair-queue (selection-strategy) ((pq :initform nil :initarg :pq :accessor pq :type priority-queue))) (defmethod initialize-instance :after ((self critical-pair-queue) &key (poly-list nil) (start 1)) "Initializes the priority queue SELF of critical pairs, where 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." (with-accessors ((pair-key-fn pair-key-fn) (pair-order-fn pair-order-fn) (pq pq)) self (setf pq (make-priority-queue :element-type 'critical-pair :element-key #'(lambda (pair) (funcall pair-key-fn (critical-pair-first pair) (critical-pair-second pair))) :test pair-order-fn)) ;; Add critical pairs for polynomials in POLY-LIST (let* ((s (1- (length poly-list))) (b (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))))) (dolist (pair b) (priority-queue-insert pq pair))))) (defmethod print-object ((self critical-pair-queue) stream) (print-unreadable-object (self stream :type t :identity t) (with-accessors ((pair-key-fn pair-key-fn) (pair-order-fn pair-order-fn) (pq pq)) self (format stream "PAIR-KEY-FN=~A PAIR-ORDER-FN=~A PQ=~A" pair-key-fn pair-order-fn pq)))) (defgeneric enqueue (self object) (:documentation "Insert an object OBJECT into a queue SELF.") (:method ((self critical-pair-queue) (pair critical-pair)) (with-slots (pq) self (priority-queue-insert pq pair)))) (defgeneric dequeue (self) (:documentation "Remove an object from a queue SELF. Returns the removed object.") (:method ((self critical-pair-queue)) (with-slots (pq) self (priority-queue-remove pq)))) (defgeneric queue-size (self) (:documentation "Returns the number of elements in the queue SELF.") (:method ((self critical-pair-queue)) (with-slots (pq) self (priority-queue-size pq)))) (defgeneric queue-empty-p (self) (:documentation "Returns T if the queue SELF is empty, NIL otherwise.") (:method (self) (with-slots (pq) self (priority-queue-empty-p pq))))