(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))