;;; -*- 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. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Selection of algorithm and pair heuristic ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage "GROBNER-WRAP" (:use :cl :buchberger :gebauer-moeller :gb-postprocessing :division :ring-and-order) (:export "$POLY_GROBNER_ALGORITHM" "GROBNER" "REDUCED-GROBNER")) (in-package :grobner-wrap) (defun choose-grobner-algorithm (algorithm) "Return a function which calculates Grobner basis, based on its names. Names currently used are either Lisp symbols, Maxima symbols or keywords." (ecase algorithm ((buchberger :buchberger $buchberger) #'buchberger) ((parallel-buchberger :parallel-buchberger $parallel_buchberger) #'parallel-buchberger) ((gebauer-moeller :gebauer-moeller :gebauer_moeller $gebauer_moeller) #'gebauer-moeller))) (defun grobner (ring-and-order f &optional (start 0) (top-reduction-only $poly_top_reduction_only)) "Compute the Groebner basis of an ideal generated by F. Optionally, assume that first START elements are already a grobner basis. If TOP-REDUCTION-ONLY is T then perform top reduction only." (declare (type ring-and-order ring-and-order)) ;;(setf F (sort F #'< :key #'sugar)) (funcall (choose-grobner-function $poly_grobner_algorithm) ring-and-order f start top-reduction-only)) (defun reduced-grobner (ring-and-order f &optional (start 0) (top-reduction-only $poly_top_reduction_only)) (declare (type ring-and-order ring-and-order)) (reduction ring-and-order (grobner ring-and-order f start top-reduction-only)))