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.

Changeset 439 for branches/f4grobner


Ignore:
Timestamp:
2015-06-06T19:57:37-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/order.lisp

    r426 r439  
    107107         ((< (monom-elt p i) (monom-elt q i))
    108108          (return-from invlex> (values nil nil))))))
     109
     110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     111;;
     112;; Some globally-defined variables holding monomial orders
     113;; and related macros/functions.
     114;;
     115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     116
     117(defvar *monomial-order* #'lex>
     118  "Default order for monomial comparisons. This global variable holds
     119the order which is in effect when performing polynomial
     120arithmetic. The global order is called by the macro MONOMIAL-ORDER,
     121which is somewhat more elegant than FUNCALL.")
     122
     123(defmacro monomial-order (x y)
     124  "Calls the global monomial order function, held by *MONOMIAL-ORDER*."
     125  `(funcall *monomial-order* ,x ,y))
     126
     127(defmacro reverse-monomial-order (x y)
     128  "Calls the inverse monomial order to the global monomial order function,
     129held by *MONOMIAL-ORDER*."
     130  `(monomial-order ,y ,x))
     131
     132(defvar *primary-elimination-order* #'lex>)
     133
     134(defvar *secondary-elimination-order* #'lex>)
     135
     136(defvar *elimination-order* nil
     137  "Default elimination order used in elimination-based functions.
     138If not NIL, it is assumed to be a proper elimination order. If NIL,
     139we will construct an elimination order using the values of
     140*PRIMARY-ELIMINATION-ORDER* and *SECONDARY-ELIMINATION-ORDER*.")
     141
     142;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     143;;
     144;; Order making functions
     145;;
     146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     147
     148(defun elimination-order (k)
     149  "Return a predicate which compares monomials according to the
     150K-th elimination order. Two variables *PRIMARY-ELIMINATION-ORDER*
     151and *SECONDARY-ELIMINATION-ORDER* control the behavior on the first K
     152and the remaining variables, respectively."
     153  (declare (type fixnum k))
     154  #'(lambda (p q &optional (start 0) (end (monom-dimension  p)))
     155      (declare (type monom p q) (type fixnum start end))
     156      (multiple-value-bind (primary equal)
     157           (funcall *primary-elimination-order* p q start k)
     158         (if equal
     159             (funcall *secondary-elimination-order* p q k end)
     160           (values primary nil)))))
     161
     162(defun elimination-order-1 (p q &optional (start 0) (end (monom-dimension  p)))
     163  "Equivalent to the function returned by the call to (ELIMINATION-ORDER 1)."
     164  (declare (type monom p q) (type fixnum start end))
     165  (cond
     166   ((> (monom-elt p start) (monom-elt q start)) (values t nil))
     167   ((< (monom-elt p start) (monom-elt q start)) (values nil nil))
     168   (t (funcall *secondary-elimination-order* p q (1+ start) end))))
Note: See TracChangeset for help on using the changeset viewer.