close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

source: branches/f4grobner/ngrobner.lisp@ 1065

Last change on this file since 1065 was 997, checked in by Marek Rychlik, 9 years ago

* empty log message *

File size: 4.6 KB
Line 
1;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*-
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;;
4;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>
5;;;
6;;; This program is free software; you can redistribute it and/or modify
7;;; it under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 2 of the License, or
9;;; (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19;;;
20;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21
22(in-package :ngrobner)
23
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25;;
26;; Global switches
27;;
28;; Can be used in Maxima just fine, as they observe the
29;; Maxima naming convention, i.e. all names visible at the
30;; Maxima toplevel begin with a '$'.
31;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33
34(defvar $poly_monomial_order '$lex
35 "This switch controls which monomial order is used in polynomial
36and Grobner basis calculations. If not set, LEX will be used")
37
38(defvar $poly_coefficient_ring '$expression_ring
39 "This switch indicates the coefficient ring of the polynomials
40that will be used in grobner calculations. If not set, Maxima's
41general expression ring will be used. This variable may be set
42to RING_OF_INTEGERS if desired.")
43
44(defvar $poly_primary_elimination_order nil
45 "Name of the default order for eliminated variables in elimination-based functions.
46If not set, LEX will be used.")
47
48(defvar $poly_secondary_elimination_order nil
49 "Name of the default order for kept variables in elimination-based functions.
50If not set, LEX will be used.")
51
52(defvar $poly_elimination_order nil
53 "Name of the default elimination order used in elimination calculations.
54If set, it overrides the settings in variables POLY_PRIMARY_ELIMINATION_ORDER
55and SECONDARY_ELIMINATION_ORDER. The user must ensure that this is a true
56elimination order valid for the number of eliminated variables.")
57
58(defvar $poly_return_term_list nil
59 "If set to T, all functions in this package will return each polynomial as a
60list of terms in the current monomial order rather than a Maxima general expression.")
61
62;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63;;
64;; These are provided mostly for debugging purposes To enable
65;; verification of grobner bases with BUCHBERGER-CRITERION, do
66;; (pushnew :grobner-check *features*) and compile/load this file.
67;; With this feature, the calculations will slow down CONSIDERABLY.
68;;
69;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70
71(defun grobner-test (ring g f)
72 "Test whether G is a Grobner basis and F is contained in G. Return T
73upon success and NIL otherwise."
74 (debug-cgb "~&GROBNER CHECK: ")
75 (let (($poly_grobner_debug nil)
76 (stat1 (buchberger-criterion ring g))
77 (stat2
78 (every #'poly-zerop
79 (makelist (normal-form ring (copy-tree (elt f i)) g nil)
80 (i 0 (1- (length f)))))))
81 (unless stat1 (error "~&Buchberger criterion failed."))
82 (unless stat2
83 (error "~&Original polys not in ideal spanned by Grobner.")))
84 (debug-cgb "~&GROBNER CHECK END")
85 t)
86
87
88
89;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90;;
91;; Conversion from internal to infix form
92;;
93;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94
95(defun coerce-to-infix (poly-type object vars)
96 "Write a polynomial, polynomial list, termlist term
97in infix form, using variables VARS. Can be used to display
98an internal form polynomial more readably."
99 (case poly-type
100 (:termlist
101 `(+ ,@(mapcar #'(lambda (term) (coerce-to-infix :term term vars)) object)))
102 (:polynomial
103 (coerce-to-infix :termlist (poly-termlist object) vars))
104 (:poly-list
105 `([ ,@(mapcar #'(lambda (p) (coerce-to-infix :polynomial p vars)) object)))
106 (:term
107 `(* ,(term-coeff object)
108 ,@(mapcar #'(lambda (var power) `(expt ,var ,power))
109 vars (coerce (term-monom object) 'list))))
110 (otherwise
111 object)))
Note: See TracBrowser for help on using the repository browser.