Changeset 109

Timestamp:

2015-06-05T12:05:40-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/grobner.lisp (modified) (1 diff)

branches/f4grobner/grobner.lisp

@@ -373 +373 @@
      (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
 
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Maxima-level interface functions
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Auxillary function for removing zero polynomial
-(defun remzero (plist) (remove #'poly-zerop plist))
-
-;;Simple operators
-
-(define-binop $poly_add poly-add
-  "Adds two polynomials P and Q")
-
-(define-binop $poly_subtract poly-sub
-  "Subtracts a polynomial Q from P.")
-
-(define-binop $poly_multiply poly-mul
-  "Returns the product of polynomials P and Q.")
-
-(define-binop $poly_s_polynomial spoly
-  "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
-
-(define-unop $poly_primitive_part poly-primitive-part
-  "Returns the polynomial P divided by GCD of its coefficients.")
-
-(define-unop $poly_normalize poly-normalize
-  "Returns the polynomial P divided by the leading coefficient.")
-
-;;Functions
-
-(defmfun $poly_expand (p vars)
-  "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
-If the representation is not compatible with a polynomial in variables VARS,
-the result is an error."
-  (with-parsed-polynomials ((vars) :polynomials (p)
-                            :value-type :polynomial)
-                           p))
-
-(defmfun $poly_expt (p n vars)
-  (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
-    (poly-expt *maxima-ring* p n)))
-
-(defmfun $poly_content (p vars)
-  (with-parsed-polynomials ((vars) :polynomials (p))
-    (poly-content *maxima-ring* p)))
-
-(defmfun $poly_pseudo_divide (f fl vars
-                            &aux (vars (coerce-maxima-list vars))
-                                 (f (parse-poly f vars))
-                                 (fl (parse-poly-list fl vars)))
-  (multiple-value-bind (quot rem c division-count)
-      (poly-pseudo-divide *maxima-ring* f fl)
-    `((mlist)
-      ,(coerce-to-maxima :poly-list quot vars)
-      ,(coerce-to-maxima :polynomial rem vars)
-      ,c
-      ,division-count)))
-
-(defmfun $poly_exact_divide (f g vars)
-  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
-    (poly-exact-divide *maxima-ring* f g)))
-
-(defmfun $poly_normal_form (f fl vars)
-  (with-parsed-polynomials ((vars) :polynomials (f)
-                                   :poly-lists (fl)
-                                   :value-type :polynomial)
-    (normal-form *maxima-ring* f (remzero fl) nil)))
-
-(defmfun $poly_buchberger_criterion (g vars)
-  (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
-    (buchberger-criterion *maxima-ring* g)))
-
-(defmfun $poly_buchberger (fl vars)
-  (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
-    (buchberger *maxima-ring*  (remzero fl) 0 nil)))
-
-(defmfun $poly_reduction (plist vars)
-  (with-parsed-polynomials ((vars) :poly-lists (plist)
-                                   :value-type :poly-list)
-    (reduction *maxima-ring* plist)))
-
-(defmfun $poly_minimization (plist vars)
-  (with-parsed-polynomials ((vars) :poly-lists (plist)
-                                   :value-type :poly-list)
-    (minimization plist)))
-
-(defmfun $poly_normalize_list (plist vars)
-  (with-parsed-polynomials ((vars) :poly-lists (plist)
-                                   :value-type :poly-list)
-    (poly-normalize-list *maxima-ring* plist)))
-
-(defmfun $poly_grobner (f vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f)
-                                   :value-type :poly-list)
-    (grobner *maxima-ring* (remzero f))))
-
-(defmfun $poly_reduced_grobner (f vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f)
-                                   :value-type :poly-list)
-    (reduced-grobner *maxima-ring* (remzero f))))
-
-(defmfun $poly_depends_p (p var mvars
-                        &aux (vars (coerce-maxima-list mvars))
-                             (pos (position var vars)))
-  (if (null pos)
-      (merror "~%Variable ~M not in the list of variables ~M." var mvars)
-    (poly-depends-p (parse-poly p vars) pos)))
-
-(defmfun $poly_elimination_ideal (flist k vars)
-  (with-parsed-polynomials ((vars) :poly-lists (flist)
-                                   :value-type :poly-list)
-    (elimination-ideal *maxima-ring* flist k nil 0)))
-
-(defmfun $poly_colon_ideal (f g vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
-    (colon-ideal *maxima-ring* f g nil)))
-
-(defmfun $poly_ideal_intersection (f g vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)  
-    (ideal-intersection *maxima-ring* f g nil)))
-
-(defmfun $poly_lcm (f g vars)
-  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
-    (poly-lcm *maxima-ring* f g)))
-
-(defmfun $poly_gcd (f g vars)
-  ($first ($divide (m* f g) ($poly_lcm f g vars))))
-
-(defmfun $poly_grobner_equal (g1 g2 vars)
-  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
-    (grobner-equal *maxima-ring* g1 g2)))
-
-(defmfun $poly_grobner_subsetp (g1 g2 vars)
-  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
-    (grobner-subsetp *maxima-ring* g1 g2)))
-
-(defmfun $poly_grobner_member (p g vars)
-  (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
-    (grobner-member *maxima-ring* p g)))
-
-(defmfun $poly_ideal_saturation1 (f p vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
-                                   :value-type :poly-list)
-    (ideal-saturation-1 *maxima-ring* f p 0)))
-
-(defmfun $poly_saturation_extension (f plist vars new-vars)
-  (with-parsed-polynomials ((vars new-vars)
-                            :poly-lists (f plist)
-                            :value-type :poly-list)
-    (saturation-extension *maxima-ring* f plist)))
-
-(defmfun $poly_polysaturation_extension (f plist vars new-vars)
-  (with-parsed-polynomials ((vars new-vars)
-                            :poly-lists (f plist)
-                            :value-type :poly-list)
-    (polysaturation-extension *maxima-ring* f plist)))
-
-(defmfun $poly_ideal_polysaturation1 (f plist vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f plist)
-                                   :value-type :poly-list)
-    (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
-
-(defmfun $poly_ideal_saturation (f g vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f g)
-                                   :value-type  :poly-list)
-    (ideal-saturation *maxima-ring* f g 0 nil)))
-
-(defmfun $poly_ideal_polysaturation (f ideal-list vars)
-  (with-parsed-polynomials ((vars) :poly-lists (f)
-                                   :poly-list-lists (ideal-list)
-                                   :value-type :poly-list)
-    (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
-
-(defmfun $poly_lt (f vars)
-  (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
-    (make-poly-from-termlist (list (poly-lt f)))))
-
-(defmfun $poly_lm (f vars)
-  (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
-    (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
-