(uiop:define-package :st-buchberger/src/monomial-orderings
(:mix :cl)
(:mix-reexport :st-buchberger/src/term)
(:export #:degree #:lex> #:grlex> #:grevlex>
 #:*monomial-ordering* #:with-monomial-ordering))

(in-package #:st-buchberger/src/monomial-orderings)

(defun degree (m)
 "Returns the total degree of a monomial"
 (reduce #'+ m))

(defun lex> (m1 m2)
 "Lexicographic Order"
 (let ((v (vector- m1 m2)))
   (unless (vector-zero-p v)
     (>= (find-if-not #'zerop v) 0))))

(defun grlex> (m1 m2)
 "Graded Lex Order"
 (let ((d1 (degree m1))
       (d2 (degree m2)))
   (or (> d1 d2)
       (and (= d1 d2)
            (lex> m1 m2)))))

(defun grevlex> (m1 m2)
 "Graded Reverse Lex Order"
 (let ((d1 (degree m1))
       (d2 (degree m2))
       (v (vector- m1 m2)))
   (or (> d1 d2)
       (and (= d1 d2)
            (unless (vector-zero-p v)
              (minusp (find-if-not #'zerop v :from-end t)))))))

(defvar *monomial-ordering* #'lex>
 "Specifies the ordering of monomials in a polynomial")

(defmacro with-monomial-ordering (ordering &body body)
 `(let ((*monomial-ordering* ,ordering))
    ,@body))