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@ 73

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

* empty log message *

File size: 3.0 KB
RevLine 
[49]1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;
3;; Implementations of various admissible monomial orders
4;;
5;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6
7;; pure lexicographic
8(defun lex> (p q &optional (start 0) (end (monom-dimension p)))
9 "Return T if P>Q with respect to lexicographic order, otherwise NIL.
10The second returned value is T if P=Q, otherwise it is NIL."
11 (declare (type monom p q) (type fixnum start end))
12 (do ((i start (1+ i)))
13 ((>= i end) (values nil t))
14 (declare (type fixnum i))
15 (cond
16 ((> (monom-elt p i) (monom-elt q i))
17 (return-from lex> (values t nil)))
18 ((< (monom-elt p i) (monom-elt q i))
19 (return-from lex> (values nil nil))))))
20
21;; total degree order , ties broken by lexicographic
22(defun grlex> (p q &optional (start 0) (end (monom-dimension p)))
23 "Return T if P>Q with respect to graded lexicographic order, otherwise NIL.
24The second returned value is T if P=Q, otherwise it is NIL."
25 (declare (type monom p q) (type fixnum start end))
26 (let ((d1 (monom-total-degree p start end))
27 (d2 (monom-total-degree q start end)))
28 (cond
29 ((> d1 d2) (values t nil))
30 ((< d1 d2) (values nil nil))
31 (t
32 (lex> p q start end)))))
33
34
35;; total degree, ties broken by reverse lexicographic
36(defun grevlex> (p q &optional (start 0) (end (monom-dimension p)))
37 "Return T if P>Q with respect to graded reverse lexicographic order,
38NIL otherwise. The second returned value is T if P=Q, otherwise it is NIL."
39 (declare (type monom p q) (type fixnum start end))
40 (let ((d1 (monom-total-degree p start end))
41 (d2 (monom-total-degree q start end)))
42 (cond
43 ((> d1 d2) (values t nil))
44 ((< d1 d2) (values nil nil))
45 (t
46 (revlex> p q start end)))))
47
48
49;; reverse lexicographic
50(defun revlex> (p q &optional (start 0) (end (monom-dimension p)))
51 "Return T if P>Q with respect to reverse lexicographic order, NIL
52otherwise. The second returned value is T if P=Q, otherwise it is
53NIL. This is not and admissible monomial order because some sets do
54not have a minimal element. This order is useful in constructing other
55orders."
56 (declare (type monom p q) (type fixnum start end))
57 (do ((i (1- end) (1- i)))
58 ((< i start) (values nil t))
59 (declare (type fixnum i))
60 (cond
61 ((< (monom-elt p i) (monom-elt q i))
62 (return-from revlex> (values t nil)))
63 ((> (monom-elt p i) (monom-elt q i))
64 (return-from revlex> (values nil nil))))))
65
66
67(defun invlex> (p q &optional (start 0) (end (monom-dimension p)))
68 "Return T if P>Q with respect to inverse lexicographic order, NIL otherwise
69The second returned value is T if P=Q, otherwise it is NIL."
70 (declare (type monom p q) (type fixnum start end))
71 (do ((i (1- end) (1- i)))
72 ((< i start) (values nil t))
73 (declare (type fixnum i))
74 (cond
75 ((> (monom-elt p i) (monom-elt q i))
76 (return-from invlex> (values t nil)))
77 ((< (monom-elt p i) (monom-elt q i))
78 (return-from invlex> (values nil nil))))))
Note: See TracBrowser for help on using the repository browser.