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/order.lisp@ 432

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

* empty log message *

File size: 4.3 KB
RevLine 
[80]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
[412]22(defpackage "ORDER"
23 (:use :cl :monomial)
24 (:export "LEX>"
25 "GRLEX>"
26 "REVLEX>"
27 "GREVLEX>"
28 "INVLEX>"))
[80]29
[417]30(in-package :order)
31
[49]32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33;;
34;; Implementations of various admissible monomial orders
35;;
36;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37
38;; pure lexicographic
39(defun lex> (p q &optional (start 0) (end (monom-dimension p)))
40 "Return T if P>Q with respect to lexicographic order, otherwise NIL.
41The second returned value is T if P=Q, otherwise it is NIL."
42 (declare (type monom p q) (type fixnum start end))
43 (do ((i start (1+ i)))
44 ((>= i end) (values nil t))
45 (declare (type fixnum i))
46 (cond
47 ((> (monom-elt p i) (monom-elt q i))
48 (return-from lex> (values t nil)))
49 ((< (monom-elt p i) (monom-elt q i))
50 (return-from lex> (values nil nil))))))
51
52;; total degree order , ties broken by lexicographic
53(defun grlex> (p q &optional (start 0) (end (monom-dimension p)))
54 "Return T if P>Q with respect to graded lexicographic order, otherwise NIL.
55The second returned value is T if P=Q, otherwise it is NIL."
56 (declare (type monom p q) (type fixnum start end))
57 (let ((d1 (monom-total-degree p start end))
58 (d2 (monom-total-degree q start end)))
59 (cond
60 ((> d1 d2) (values t nil))
61 ((< d1 d2) (values nil nil))
62 (t
63 (lex> p q start end)))))
64
65
66;; reverse lexicographic
67(defun revlex> (p q &optional (start 0) (end (monom-dimension p)))
68 "Return T if P>Q with respect to reverse lexicographic order, NIL
69otherwise. The second returned value is T if P=Q, otherwise it is
70NIL. This is not and admissible monomial order because some sets do
71not have a minimal element. This order is useful in constructing other
72orders."
73 (declare (type monom p q) (type fixnum start end))
74 (do ((i (1- end) (1- i)))
75 ((< i start) (values nil t))
76 (declare (type fixnum i))
77 (cond
78 ((< (monom-elt p i) (monom-elt q i))
79 (return-from revlex> (values t nil)))
80 ((> (monom-elt p i) (monom-elt q i))
81 (return-from revlex> (values nil nil))))))
82
83
[426]84;; total degree, ties broken by reverse lexicographic
85(defun grevlex> (p q &optional (start 0) (end (monom-dimension p)))
86 "Return T if P>Q with respect to graded reverse lexicographic order,
87NIL otherwise. The second returned value is T if P=Q, otherwise it is NIL."
88 (declare (type monom p q) (type fixnum start end))
89 (let ((d1 (monom-total-degree p start end))
90 (d2 (monom-total-degree q start end)))
91 (cond
92 ((> d1 d2) (values t nil))
93 ((< d1 d2) (values nil nil))
94 (t
95 (revlex> p q start end)))))
96
[49]97(defun invlex> (p q &optional (start 0) (end (monom-dimension p)))
98 "Return T if P>Q with respect to inverse lexicographic order, NIL otherwise
99The second returned value is T if P=Q, otherwise it is NIL."
100 (declare (type monom p q) (type fixnum start end))
101 (do ((i (1- end) (1- i)))
102 ((< i start) (values nil t))
103 (declare (type fixnum i))
104 (cond
105 ((> (monom-elt p i) (monom-elt q i))
106 (return-from invlex> (values t nil)))
107 ((< (monom-elt p i) (monom-elt q i))
108 (return-from invlex> (values nil nil))))))
Note: See TracBrowser for help on using the repository browser.