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 109 for branches/f4grobner


Ignore:
Timestamp:
2015-06-05T12:05:40-07:00 (10 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/grobner.lisp

    r108 r109  
    373373     (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
    374374
    375 
    376 
    377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    378 ;;
    379 ;; Maxima-level interface functions
    380 ;;
    381 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    382 
    383 ;; Auxillary function for removing zero polynomial
    384 (defun remzero (plist) (remove #'poly-zerop plist))
    385 
    386 ;;Simple operators
    387 
    388 (define-binop $poly_add poly-add
    389   "Adds two polynomials P and Q")
    390 
    391 (define-binop $poly_subtract poly-sub
    392   "Subtracts a polynomial Q from P.")
    393 
    394 (define-binop $poly_multiply poly-mul
    395   "Returns the product of polynomials P and Q.")
    396 
    397 (define-binop $poly_s_polynomial spoly
    398   "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
    399 
    400 (define-unop $poly_primitive_part poly-primitive-part
    401   "Returns the polynomial P divided by GCD of its coefficients.")
    402 
    403 (define-unop $poly_normalize poly-normalize
    404   "Returns the polynomial P divided by the leading coefficient.")
    405 
    406 ;;Functions
    407 
    408 (defmfun $poly_expand (p vars)
    409   "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
    410 If the representation is not compatible with a polynomial in variables VARS,
    411 the result is an error."
    412   (with-parsed-polynomials ((vars) :polynomials (p)
    413                             :value-type :polynomial)
    414                            p))
    415 
    416 (defmfun $poly_expt (p n vars)
    417   (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
    418     (poly-expt *maxima-ring* p n)))
    419 
    420 (defmfun $poly_content (p vars)
    421   (with-parsed-polynomials ((vars) :polynomials (p))
    422     (poly-content *maxima-ring* p)))
    423 
    424 (defmfun $poly_pseudo_divide (f fl vars
    425                             &aux (vars (coerce-maxima-list vars))
    426                                  (f (parse-poly f vars))
    427                                  (fl (parse-poly-list fl vars)))
    428   (multiple-value-bind (quot rem c division-count)
    429       (poly-pseudo-divide *maxima-ring* f fl)
    430     `((mlist)
    431       ,(coerce-to-maxima :poly-list quot vars)
    432       ,(coerce-to-maxima :polynomial rem vars)
    433       ,c
    434       ,division-count)))
    435 
    436 (defmfun $poly_exact_divide (f g vars)
    437   (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    438     (poly-exact-divide *maxima-ring* f g)))
    439 
    440 (defmfun $poly_normal_form (f fl vars)
    441   (with-parsed-polynomials ((vars) :polynomials (f)
    442                                    :poly-lists (fl)
    443                                    :value-type :polynomial)
    444     (normal-form *maxima-ring* f (remzero fl) nil)))
    445 
    446 (defmfun $poly_buchberger_criterion (g vars)
    447   (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
    448     (buchberger-criterion *maxima-ring* g)))
    449 
    450 (defmfun $poly_buchberger (fl vars)
    451   (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
    452     (buchberger *maxima-ring*  (remzero fl) 0 nil)))
    453 
    454 (defmfun $poly_reduction (plist vars)
    455   (with-parsed-polynomials ((vars) :poly-lists (plist)
    456                                    :value-type :poly-list)
    457     (reduction *maxima-ring* plist)))
    458 
    459 (defmfun $poly_minimization (plist vars)
    460   (with-parsed-polynomials ((vars) :poly-lists (plist)
    461                                    :value-type :poly-list)
    462     (minimization plist)))
    463 
    464 (defmfun $poly_normalize_list (plist vars)
    465   (with-parsed-polynomials ((vars) :poly-lists (plist)
    466                                    :value-type :poly-list)
    467     (poly-normalize-list *maxima-ring* plist)))
    468 
    469 (defmfun $poly_grobner (f vars)
    470   (with-parsed-polynomials ((vars) :poly-lists (f)
    471                                    :value-type :poly-list)
    472     (grobner *maxima-ring* (remzero f))))
    473 
    474 (defmfun $poly_reduced_grobner (f vars)
    475   (with-parsed-polynomials ((vars) :poly-lists (f)
    476                                    :value-type :poly-list)
    477     (reduced-grobner *maxima-ring* (remzero f))))
    478 
    479 (defmfun $poly_depends_p (p var mvars
    480                         &aux (vars (coerce-maxima-list mvars))
    481                              (pos (position var vars)))
    482   (if (null pos)
    483       (merror "~%Variable ~M not in the list of variables ~M." var mvars)
    484     (poly-depends-p (parse-poly p vars) pos)))
    485 
    486 (defmfun $poly_elimination_ideal (flist k vars)
    487   (with-parsed-polynomials ((vars) :poly-lists (flist)
    488                                    :value-type :poly-list)
    489     (elimination-ideal *maxima-ring* flist k nil 0)))
    490 
    491 (defmfun $poly_colon_ideal (f g vars)
    492   (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
    493     (colon-ideal *maxima-ring* f g nil)))
    494 
    495 (defmfun $poly_ideal_intersection (f g vars)
    496   (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 
    497     (ideal-intersection *maxima-ring* f g nil)))
    498 
    499 (defmfun $poly_lcm (f g vars)
    500   (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    501     (poly-lcm *maxima-ring* f g)))
    502 
    503 (defmfun $poly_gcd (f g vars)
    504   ($first ($divide (m* f g) ($poly_lcm f g vars))))
    505 
    506 (defmfun $poly_grobner_equal (g1 g2 vars)
    507   (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    508     (grobner-equal *maxima-ring* g1 g2)))
    509 
    510 (defmfun $poly_grobner_subsetp (g1 g2 vars)
    511   (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    512     (grobner-subsetp *maxima-ring* g1 g2)))
    513 
    514 (defmfun $poly_grobner_member (p g vars)
    515   (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
    516     (grobner-member *maxima-ring* p g)))
    517 
    518 (defmfun $poly_ideal_saturation1 (f p vars)
    519   (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
    520                                    :value-type :poly-list)
    521     (ideal-saturation-1 *maxima-ring* f p 0)))
    522 
    523 (defmfun $poly_saturation_extension (f plist vars new-vars)
    524   (with-parsed-polynomials ((vars new-vars)
    525                             :poly-lists (f plist)
    526                             :value-type :poly-list)
    527     (saturation-extension *maxima-ring* f plist)))
    528 
    529 (defmfun $poly_polysaturation_extension (f plist vars new-vars)
    530   (with-parsed-polynomials ((vars new-vars)
    531                             :poly-lists (f plist)
    532                             :value-type :poly-list)
    533     (polysaturation-extension *maxima-ring* f plist)))
    534 
    535 (defmfun $poly_ideal_polysaturation1 (f plist vars)
    536   (with-parsed-polynomials ((vars) :poly-lists (f plist)
    537                                    :value-type :poly-list)
    538     (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
    539 
    540 (defmfun $poly_ideal_saturation (f g vars)
    541   (with-parsed-polynomials ((vars) :poly-lists (f g)
    542                                    :value-type  :poly-list)
    543     (ideal-saturation *maxima-ring* f g 0 nil)))
    544 
    545 (defmfun $poly_ideal_polysaturation (f ideal-list vars)
    546   (with-parsed-polynomials ((vars) :poly-lists (f)
    547                                    :poly-list-lists (ideal-list)
    548                                    :value-type :poly-list)
    549     (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
    550 
    551 (defmfun $poly_lt (f vars)
    552   (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
    553     (make-poly-from-termlist (list (poly-lt f)))))
    554 
    555 (defmfun $poly_lm (f vars)
    556   (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
    557     (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
    558 
Note: See TracChangeset for help on using the changeset viewer.