source: branches/f4grobner/pair-queue.lisp@ 4273

;;; -*-  Mode: Lisp -*- 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;                                                                              

;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>          

;;;                                                                              

;;;  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)

   (data :initform nil :accessor critical-pair-division-data))

  (: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))))))