;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Implementations of various admissible monomial orders
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; pure lexicographic
(defun lex> (p q &optional (start 0) (end (monom-dimension  p)))
  "Return T if P>Q with respect to lexicographic order, otherwise NIL.
The second returned value is T if P=Q, otherwise it is NIL."
  (declare (type monom p q) (type fixnum start end))
  (do ((i start (1+ i)))
      ((>= i end) (values nil t))
    (declare (type fixnum i))
    (cond
     ((> (monom-elt p i) (monom-elt q i))
      (return-from lex> (values t nil)))
     ((< (monom-elt p i) (monom-elt q i))
      (return-from lex> (values nil nil))))))

;; total degree order , ties broken by lexicographic
(defun grlex> (p q &optional (start 0) (end (monom-dimension  p)))
  "Return T if P>Q with respect to graded lexicographic order, otherwise NIL.
The second returned value is T if P=Q, otherwise it is NIL."
  (declare (type monom p q) (type fixnum start end))
  (let ((d1 (monom-total-degree p start end))
	(d2 (monom-total-degree q start end)))
    (cond
      ((> d1 d2) (values t nil))
      ((< d1 d2) (values nil nil))
      (t
	(lex> p q start end)))))


;; total degree, ties broken by reverse lexicographic
(defun grevlex> (p q &optional (start 0) (end (monom-dimension  p)))
  "Return T if P>Q with respect to graded reverse lexicographic order,
NIL otherwise. The second returned value is T if P=Q, otherwise it is NIL."
  (declare (type monom p q) (type fixnum start end))
  (let ((d1 (monom-total-degree p start end))
	(d2 (monom-total-degree q start end)))
    (cond
     ((> d1 d2) (values t nil))
     ((< d1 d2) (values nil nil))
     (t
      (revlex> p q start end)))))


;; reverse lexicographic
(defun revlex> (p q &optional (start 0) (end (monom-dimension  p)))
  "Return T if P>Q with respect to reverse lexicographic order, NIL
otherwise.  The second returned value is T if P=Q, otherwise it is
NIL. This is not and admissible monomial order because some sets do
not have a minimal element. This order is useful in constructing other
orders."
  (declare (type monom p q) (type fixnum start end))
  (do ((i (1- end) (1- i)))
      ((< i start) (values nil t))
    (declare (type fixnum i))
    (cond
     ((< (monom-elt p i) (monom-elt q i))
      (return-from revlex> (values t nil)))
     ((> (monom-elt p i) (monom-elt q i))
      (return-from revlex> (values nil nil))))))


(defun invlex> (p q &optional (start 0) (end (monom-dimension  p)))
  "Return T if P>Q with respect to inverse lexicographic order, NIL otherwise
The second returned value is T if P=Q, otherwise it is NIL."
  (declare (type monom p q) (type fixnum start end))
  (do ((i (1- end) (1- i)))
      ((< i start) (values nil t))
    (declare (type fixnum i))
      (cond
	 ((> (monom-elt p i) (monom-elt q i))
	  (return-from invlex> (values t nil)))
	 ((< (monom-elt p i) (monom-elt q i))
	  (return-from invlex> (values nil nil))))))