Changeset 914 for branches

Timestamp:

2015-06-09T14:40:40-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/order.lisp (modified) (2 diffs)

branches/f4grobner/order.lisp

@@ -119 +119 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun make-elimination-order-1 (secondary-elimination-order q &optional (start 0) (end (monom-dimension  p)))
+  "Equivalent to the function returned by the call to (ELIMINATION-ORDER PRIMARY-ELIMINATION-ORDER SECONDARY-ELIMINATION-ORDER 1).
+It is an optimization used for the 1-st elimination ideal. We note that PRIMARY-ELIMINATION-ORDER could be LEX> or any
+other order, as all orders coincide in 1 variabl."
+  #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
+      (cond
+        ((> (monom-elt p start) (monom-elt q start)) (values t nil))
+        ((< (monom-elt p start) (monom-elt q start)) (values nil nil))
+        (t (funcall secondary-elimination-order p q (1+ start) end)))))
+
 (defun make-elimination-order-maker (primary-elimination-order secondary-elimination-order)
   "Return a function with a single integer argument K. This should be
@@ -133 +143 @@
 X[K],X[K+1],..."
   #'(lambda (k) 
-      #'(lambda (p q &optional (start 0) (end (monom-dimension  p)))
-          (multiple-value-bind (primary equal)
-              (funcall primary-elimination-order p q start k)
-            (if equal
-                (funcall secondary-elimination-order p q k end)
-                (values primary nil))))))
+      (cond 
+        ((<= k 0) (error "K must be at least 1"))
+        ((= k 1)
+         (elimination-order-1 secondary-elimination-order))
+        (t
+         #'(lambda (p q &optional (start 0) (end (monom-dimension  p)))
+             (multiple-value-bind (primary equal)
+                 (funcall primary-elimination-order p q start k)
+               (if equal
+                   (funcall secondary-elimination-order p q k end)
+                   (values primary nil))))))))
 
-(defun make-elimination-order-1 (secondary-elimination-order q &optional (start 0) (end (monom-dimension  p)))
-  "Equivalent to the function returned by the call to (ELIMINATION-ORDER PRIMARY-ELIMINATION-ORDER SECONDARY-ELIMINATION-ORDER 1).
-It is an optimization used for the 1-st elimination ideal. We note that PRIMARY-ELIMINATION-ORDER could be LEX> or any
-other order, as all orders coincide in 1 variabl."
-  #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
-      (cond
-        ((> (monom-elt p start) (monom-elt q start)) (values t nil))
-        ((< (monom-elt p start) (monom-elt q start)) (values nil nil))
-        (t (funcall secondary-elimination-order p q (1+ start) end)))))