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 914 for branches


Ignore:
Timestamp:
2015-06-09T14:40:40-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/order.lisp

    r913 r914  
    119119;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    120120
     121(defun make-elimination-order-1 (secondary-elimination-order q &optional (start 0) (end (monom-dimension  p)))
     122  "Equivalent to the function returned by the call to (ELIMINATION-ORDER PRIMARY-ELIMINATION-ORDER SECONDARY-ELIMINATION-ORDER 1).
     123It is an optimization used for the 1-st elimination ideal. We note that PRIMARY-ELIMINATION-ORDER could be LEX> or any
     124other order, as all orders coincide in 1 variabl."
     125  #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
     126      (cond
     127        ((> (monom-elt p start) (monom-elt q start)) (values t nil))
     128        ((< (monom-elt p start) (monom-elt q start)) (values nil nil))
     129        (t (funcall secondary-elimination-order p q (1+ start) end)))))
     130
    121131(defun make-elimination-order-maker (primary-elimination-order secondary-elimination-order)
    122132  "Return a function with a single integer argument K. This should be
     
    133143X[K],X[K+1],..."
    134144  #'(lambda (k)
    135       #'(lambda (p q &optional (start 0) (end (monom-dimension  p)))
    136           (multiple-value-bind (primary equal)
    137               (funcall primary-elimination-order p q start k)
    138             (if equal
    139                 (funcall secondary-elimination-order p q k end)
    140                 (values primary nil))))))
     145      (cond
     146        ((<= k 0) (error "K must be at least 1"))
     147        ((= k 1)
     148         (elimination-order-1 secondary-elimination-order))
     149        (t
     150         #'(lambda (p q &optional (start 0) (end (monom-dimension  p)))
     151             (multiple-value-bind (primary equal)
     152                 (funcall primary-elimination-order p q start k)
     153               (if equal
     154                   (funcall secondary-elimination-order p q k end)
     155                   (values primary nil))))))))
    141156
    142 (defun make-elimination-order-1 (secondary-elimination-order q &optional (start 0) (end (monom-dimension  p)))
    143   "Equivalent to the function returned by the call to (ELIMINATION-ORDER PRIMARY-ELIMINATION-ORDER SECONDARY-ELIMINATION-ORDER 1).
    144 It is an optimization used for the 1-st elimination ideal. We note that PRIMARY-ELIMINATION-ORDER could be LEX> or any
    145 other order, as all orders coincide in 1 variabl."
    146   #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
    147       (cond
    148         ((> (monom-elt p start) (monom-elt q start)) (values t nil))
    149         ((< (monom-elt p start) (monom-elt q start)) (values nil nil))
    150         (t (funcall secondary-elimination-order p q (1+ start) end)))))
Note: See TracChangeset for help on using the changeset viewer.