;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 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. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Pair selection criteria ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage "CRITERION" (:use :monomial :pair-queue) (:export "CRITERION-1" "CRITERION-2" )) (defun criterion-1 (pair) "Returns T if the leading monomials of the two polynomials in G pointed to by the integers in PAIR have disjoint (relatively prime) monomials. This test is known as the first Buchberger criterion." (declare (type pair pair)) (let ((f (pair-first pair)) (g (pair-second pair))) (when (monom-rel-prime-p (poly-lm f) (poly-lm g)) (debug-cgb ":1") (return-from criterion-1 t)))) (defun criterion-2 (pair b-done partial-basis &aux (f (pair-first pair)) (g (pair-second pair)) (place :before)) "Returns T if the leading monomial of some element P of PARTIAL-BASIS divides the LCM of the leading monomials of the two polynomials in the polynomial list PARTIAL-BASIS, and P paired with each of the polynomials pointed to by the the PAIR has already been treated, as indicated by the absence in the hash table B-done." (declare (type pair pair) (type hash-table b-done) (type poly f g)) ;; In the code below we assume that pairs are ordered as follows: ;; if PAIR is (I J) then I appears before J in the PARTIAL-BASIS. ;; We traverse the list PARTIAL-BASIS and keep track of where we ;; are, so that we can produce the pairs in the correct order ;; when we check whether they have been processed, i.e they ;; appear in the hash table B-done (dolist (h partial-basis nil) (cond ((eq h f) #+grobner-check(assert (eq place :before)) (setf place :in-the-middle)) ((eq h g) #+grobner-check(assert (eq place :in-the-middle)) (setf place :after)) ((and (monom-divides-monom-lcm-p (poly-lm h) (poly-lm f) (poly-lm g)) (gethash (case place (:before (list h f)) ((:in-the-middle :after) (list f h))) b-done) (gethash (case place ((:before :in-the-middle) (list h g)) (:after (list g h))) b-done)) (debug-cgb ":2") (return-from criterion-2 t)))))