Changeset 1670
- Timestamp:
- 2015-06-14T20:51:10-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/mx-grobner-0.lisp
r1658 r1670 69 69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 70 70 71 (defparameter *maxima-ring*71 (defparameter +maxima-ring+ 72 72 (make-ring 73 73 ;;(defun coeff-zerop (expr) (meval1 `(($is) (($equal) ,expr 0)))) … … 127 127 ((member expr vars :test #'equal-test-p) 128 128 (let ((pos (position expr vars :test #'equal-test-p))) 129 (make-poly-variable *maxima-ring*(length vars) pos)))129 (make-poly-variable +maxima-ring+ (length vars) pos))) 130 130 ((free-of-vars expr vars) 131 131 ;;This means that variable-free CRE and Poisson forms will be converted 132 132 ;;to coefficients intact 133 (coerce-coeff *maxima-ring*expr vars))133 (coerce-coeff +maxima-ring+ expr vars)) 134 134 (t 135 135 (case (caar expr) 136 (mplus (reduce #'(lambda (x y) (poly-add *maxima-ring*x y)) (parse-list (cdr expr))))137 (mminus (poly-uminus *maxima-ring*(parse (cadr expr))))136 (mplus (reduce #'(lambda (x y) (poly-add +maxima-ring+ x y)) (parse-list (cdr expr)))) 137 (mminus (poly-uminus +maxima-ring+ (parse (cadr expr)))) 138 138 (mtimes 139 139 (if (endp (cddr expr)) ;unary 140 140 (parse (cdr expr)) 141 (reduce #'(lambda (p q) (poly-mul *maxima-ring*p q)) (parse-list (cdr expr)))))141 (reduce #'(lambda (p q) (poly-mul +maxima-ring+ p q)) (parse-list (cdr expr))))) 142 142 (mexpt 143 143 (cond … … 145 145 ;;Special handling of (expt var pow) 146 146 (let ((pos (position (cadr expr) vars :test #'equal-test-p))) 147 (make-poly-variable *maxima-ring*(length vars) pos (caddr expr))))147 (make-poly-variable +maxima-ring+ (length vars) pos (caddr expr)))) 148 148 ((not (and (integerp (caddr expr)) (plusp (caddr expr)))) 149 149 ;; Negative power means division in coefficient ring … … 151 151 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%" 152 152 expr) 153 (coerce-coeff *maxima-ring*expr vars))154 (t (poly-expt *maxima-ring*(parse (cadr expr)) (caddr expr)))))153 (coerce-coeff +maxima-ring+ expr vars)) 154 (t (poly-expt +maxima-ring+ (parse (cadr expr)) (caddr expr))))) 155 155 (mrat (parse ($ratdisrep expr))) 156 156 (mpois (parse ($outofpois expr))) 157 157 (otherwise 158 (coerce-coeff *maxima-ring*expr vars)))))))158 (coerce-coeff +maxima-ring+ expr vars))))))) 159 159 160 160 (defun parse-poly-list (expr vars) … … 211 211 (p (parse-poly p vars))) 212 212 ,@(when documentation-supplied-p (list documentation)) 213 (coerce-to-maxima :polynomial (,fun-name *maxima-ring*p) vars)))213 (coerce-to-maxima :polynomial (,fun-name +maxima-ring+ p) vars))) 214 214 215 215 (defmacro define-binop (maxima-name fun-name … … 222 222 (q (parse-poly q vars))) 223 223 ,@(when documentation-supplied-p (list documentation)) 224 (coerce-to-maxima :polynomial (,fun-name *maxima-ring*p q) vars)))224 (coerce-to-maxima :polynomial (,fun-name +maxima-ring+ p q) vars))) 225 225 226 226 … … 260 260 ((symbolp ring) 261 261 (case ring 262 ((maxima-ring :maxima-ring $expression_ring) *maxima-ring*)263 ((ring-of-integers :ring-of-integers $ring_of_integers) *ring-of-integers*)262 ((maxima-ring :maxima-ring $expression_ring) +maxima-ring+) 263 ((ring-of-integers :ring-of-integers $ring_of_integers) +ring-of-integers+) 264 264 (otherwise 265 265 (mtell "~%Warning: Ring ~M not found. Using default.~%" ring)))) … … 283 283 (defmacro with-coefficient-ring ((ring) &body body) 284 284 "Evaluate BODY with coefficient ring set to RING." 285 `(let (( *maxima-ring* (or (find-ring ,ring) *maxima-ring*)))285 `(let ((+maxima-ring+ (or (find-ring ,ring) +maxima-ring+))) 286 286 . ,body)) 287 287 … … 289 289 "Evaluate BODY with monomial order set to ORDER and coefficient ring set to RING." 290 290 `(let ((*monomial-order* (or (find-order ,order) *monomial-order*)) 291 ( *maxima-ring* (or (find-ring ,ring) *maxima-ring*)))291 (+maxima-ring+ (or (find-ring ,ring) +maxima-ring+))) 292 292 . ,body)) 293 293 … … 380 380 (defmfun $poly_expt (p n vars) 381 381 (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial) 382 (poly-expt *maxima-ring*p n)))382 (poly-expt +maxima-ring+ p n))) 383 383 384 384 (defmfun $poly_content (p vars) 385 385 (with-parsed-polynomials ((vars) :polynomials (p)) 386 (poly-content *maxima-ring*p)))386 (poly-content +maxima-ring+ p))) 387 387 388 388 (defmfun $poly_pseudo_divide (f fl vars … … 391 391 (fl (parse-poly-list fl vars))) 392 392 (multiple-value-bind (quot rem c division-count) 393 (poly-pseudo-divide *maxima-ring*f fl)393 (poly-pseudo-divide +maxima-ring+ f fl) 394 394 `((mlist) 395 395 ,(coerce-to-maxima :poly-list quot vars) … … 400 400 (defmfun $poly_exact_divide (f g vars) 401 401 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial) 402 (poly-exact-divide *maxima-ring*f g)))402 (poly-exact-divide +maxima-ring+ f g))) 403 403 404 404 (defmfun $poly_normal_form (f fl vars) … … 406 406 :poly-lists (fl) 407 407 :value-type :polynomial) 408 (normal-form *maxima-ring*f (remzero fl) nil)))408 (normal-form +maxima-ring+ f (remzero fl) nil))) 409 409 410 410 (defmfun $poly_buchberger_criterion (g vars) 411 411 (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical) 412 (buchberger-criterion *maxima-ring*g)))412 (buchberger-criterion +maxima-ring+ g))) 413 413 414 414 (defmfun $poly_buchberger (fl vars) 415 415 (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list) 416 (buchberger *maxima-ring*(remzero fl) 0 nil)))416 (buchberger +maxima-ring+ (remzero fl) 0 nil))) 417 417 418 418 (defmfun $poly_reduction (plist vars) 419 419 (with-parsed-polynomials ((vars) :poly-lists (plist) 420 420 :value-type :poly-list) 421 (reduction *maxima-ring*plist)))421 (reduction +maxima-ring+ plist))) 422 422 423 423 (defmfun $poly_minimization (plist vars) … … 429 429 (with-parsed-polynomials ((vars) :poly-lists (plist) 430 430 :value-type :poly-list) 431 (poly-normalize-list *maxima-ring*plist)))431 (poly-normalize-list +maxima-ring+ plist))) 432 432 433 433 (defmfun $poly_grobner (f vars) 434 434 (with-parsed-polynomials ((vars) :poly-lists (f) 435 435 :value-type :poly-list) 436 (grobner *maxima-ring*(remzero f))))436 (grobner +maxima-ring+ (remzero f)))) 437 437 438 438 (defmfun $poly_reduced_grobner (f vars) 439 439 (with-parsed-polynomials ((vars) :poly-lists (f) 440 440 :value-type :poly-list) 441 (reduced-grobner *maxima-ring*(remzero f))))441 (reduced-grobner +maxima-ring+ (remzero f)))) 442 442 443 443 (defmfun $poly_depends_p (p var mvars … … 451 451 (with-parsed-polynomials ((vars) :poly-lists (flist) 452 452 :value-type :poly-list) 453 (elimination-ideal *maxima-ring*flist k nil 0)))453 (elimination-ideal +maxima-ring+ flist k nil 0))) 454 454 455 455 (defmfun $poly_colon_ideal (f g vars) 456 456 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 457 (colon-ideal *maxima-ring*f g nil)))457 (colon-ideal +maxima-ring+ f g nil))) 458 458 459 459 (defmfun $poly_ideal_intersection (f g vars) 460 460 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 461 (ideal-intersection *maxima-ring*f g nil)))461 (ideal-intersection +maxima-ring+ f g nil))) 462 462 463 463 (defmfun $poly_lcm (f g vars) 464 464 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial) 465 (poly-lcm *maxima-ring*f g)))465 (poly-lcm +maxima-ring+ f g))) 466 466 467 467 (defmfun $poly_gcd (f g vars) … … 470 470 (defmfun $poly_grobner_equal (g1 g2 vars) 471 471 (with-parsed-polynomials ((vars) :poly-lists (g1 g2)) 472 (grobner-equal *maxima-ring*g1 g2)))472 (grobner-equal +maxima-ring+ g1 g2))) 473 473 474 474 (defmfun $poly_grobner_subsetp (g1 g2 vars) 475 475 (with-parsed-polynomials ((vars) :poly-lists (g1 g2)) 476 (grobner-subsetp *maxima-ring*g1 g2)))476 (grobner-subsetp +maxima-ring+ g1 g2))) 477 477 478 478 (defmfun $poly_grobner_member (p g vars) 479 479 (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g)) 480 (grobner-member *maxima-ring*p g)))480 (grobner-member +maxima-ring+ p g))) 481 481 482 482 (defmfun $poly_ideal_saturation1 (f p vars) 483 483 (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p) 484 484 :value-type :poly-list) 485 (ideal-saturation-1 *maxima-ring*f p 0)))485 (ideal-saturation-1 +maxima-ring+ f p 0))) 486 486 487 487 (defmfun $poly_saturation_extension (f plist vars new-vars) … … 489 489 :poly-lists (f plist) 490 490 :value-type :poly-list) 491 (saturation-extension *maxima-ring*f plist)))491 (saturation-extension +maxima-ring+ f plist))) 492 492 493 493 (defmfun $poly_polysaturation_extension (f plist vars new-vars) … … 495 495 :poly-lists (f plist) 496 496 :value-type :poly-list) 497 (polysaturation-extension *maxima-ring*f plist)))497 (polysaturation-extension +maxima-ring+ f plist))) 498 498 499 499 (defmfun $poly_ideal_polysaturation1 (f plist vars) 500 500 (with-parsed-polynomials ((vars) :poly-lists (f plist) 501 501 :value-type :poly-list) 502 (ideal-polysaturation-1 *maxima-ring*f plist 0 nil)))502 (ideal-polysaturation-1 +maxima-ring+ f plist 0 nil))) 503 503 504 504 (defmfun $poly_ideal_saturation (f g vars) 505 505 (with-parsed-polynomials ((vars) :poly-lists (f g) 506 506 :value-type :poly-list) 507 (ideal-saturation *maxima-ring*f g 0 nil)))507 (ideal-saturation +maxima-ring+ f g 0 nil))) 508 508 509 509 (defmfun $poly_ideal_polysaturation (f ideal-list vars) … … 511 511 :poly-list-lists (ideal-list) 512 512 :value-type :poly-list) 513 (ideal-polysaturation *maxima-ring*f ideal-list 0 nil)))513 (ideal-polysaturation +maxima-ring+ f ideal-list 0 nil))) 514 514 515 515 (defmfun $poly_lt (f vars) … … 519 519 (defmfun $poly_lm (f vars) 520 520 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial) 521 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))522 521 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit +maxima-ring+))))))) 522
Note:
See TracChangeset
for help on using the changeset viewer.