Changeset 233
- Timestamp:
- 2015-06-05T15:58:42-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/mx-grobner.lisp
r231 r233 136 136 ((member expr vars :test #'equal-test-p) 137 137 (let ((pos (position expr vars :test #'equal-test-p))) 138 (make-variable * coefficient-ring* (length vars) pos)))138 (make-variable *expression-ring* (length vars) pos))) 139 139 ((free-of-vars expr vars) 140 140 ;;This means that variable-free CRE and Poisson forms will be converted 141 141 ;;to coefficients intact 142 (coerce-coeff * coefficient-ring* expr vars))142 (coerce-coeff *expression-ring* expr vars)) 143 143 (t 144 144 (case (caar expr) 145 (mplus (reduce #'(lambda (x y) (poly-add * coefficient-ring* x y)) (parse-list (cdr expr))))146 (mminus (poly-uminus * coefficient-ring* (parse (cadr expr))))145 (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr)))) 146 (mminus (poly-uminus *expression-ring* (parse (cadr expr)))) 147 147 (mtimes 148 148 (if (endp (cddr expr)) ;unary 149 149 (parse (cdr expr)) 150 (reduce #'(lambda (p q) (poly-mul * coefficient-ring* p q)) (parse-list (cdr expr)))))150 (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr))))) 151 151 (mexpt 152 152 (cond … … 154 154 ;;Special handling of (expt var pow) 155 155 (let ((pos (position (cadr expr) vars :test #'equal-test-p))) 156 (make-variable * coefficient-ring* (length vars) pos (caddr expr))))156 (make-variable *expression-ring* (length vars) pos (caddr expr)))) 157 157 ((not (and (integerp (caddr expr)) (plusp (caddr expr)))) 158 158 ;; Negative power means division in coefficient ring … … 160 160 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%" 161 161 expr) 162 (coerce-coeff * coefficient-ring* expr vars))163 (t (poly-expt * coefficient-ring* (parse (cadr expr)) (caddr expr)))))162 (coerce-coeff *expression-ring* expr vars)) 163 (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr))))) 164 164 (mrat (parse ($ratdisrep expr))) 165 165 (mpois (parse ($outofpois expr))) 166 166 (otherwise 167 (coerce-coeff * coefficient-ring* expr vars)))))))167 (coerce-coeff *expression-ring* expr vars))))))) 168 168 169 169 (defun parse-poly-list (expr vars) … … 190 190 (p (parse-poly p vars))) 191 191 ,@(when documentation-supplied-p (list documentation)) 192 (coerce-to-maxima :polynomial (,fun-name * coefficient-ring* p) vars)))192 (coerce-to-maxima :polynomial (,fun-name *expression-ring* p) vars))) 193 193 194 194 (defmacro define-binop (maxima-name fun-name … … 201 201 (q (parse-poly q vars))) 202 202 ,@(when documentation-supplied-p (list documentation)) 203 (coerce-to-maxima :polynomial (,fun-name * coefficient-ring* p q) vars)))203 (coerce-to-maxima :polynomial (,fun-name *expression-ring* p q) vars))) 204 204 205 205 … … 218 218 (defmacro with-coefficient-ring ((ring) &body body) 219 219 "Evaluate BODY with coefficient ring set to RING." 220 `(let ((* coefficient-ring* (or (find-ring ,ring) *coefficient-ring*)))220 `(let ((*expression-ring* (or (find-ring ,ring) *expression-ring*))) 221 221 . ,body)) 222 222 … … 309 309 (defmfun $poly_expt (p n vars) 310 310 (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial) 311 (poly-expt * coefficient-ring* p n)))311 (poly-expt *expression-ring* p n))) 312 312 313 313 (defmfun $poly_content (p vars) 314 314 (with-parsed-polynomials ((vars) :polynomials (p)) 315 (poly-content * coefficient-ring* p)))315 (poly-content *expression-ring* p))) 316 316 317 317 (defmfun $poly_pseudo_divide (f fl vars … … 320 320 (fl (parse-poly-list fl vars))) 321 321 (multiple-value-bind (quot rem c division-count) 322 (poly-pseudo-divide * coefficient-ring* f fl)322 (poly-pseudo-divide *expression-ring* f fl) 323 323 `((mlist) 324 324 ,(coerce-to-maxima :poly-list quot vars) … … 329 329 (defmfun $poly_exact_divide (f g vars) 330 330 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial) 331 (poly-exact-divide * coefficient-ring* f g)))331 (poly-exact-divide *expression-ring* f g))) 332 332 333 333 (defmfun $poly_normal_form (f fl vars) … … 335 335 :poly-lists (fl) 336 336 :value-type :polynomial) 337 (normal-form * coefficient-ring* f (remzero fl) nil)))337 (normal-form *expression-ring* f (remzero fl) nil))) 338 338 339 339 (defmfun $poly_buchberger_criterion (g vars) 340 340 (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical) 341 (buchberger-criterion * coefficient-ring* g)))341 (buchberger-criterion *expression-ring* g))) 342 342 343 343 (defmfun $poly_buchberger (fl vars) 344 344 (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list) 345 (buchberger * coefficient-ring* (remzero fl) 0 nil)))345 (buchberger *expression-ring* (remzero fl) 0 nil))) 346 346 347 347 (defmfun $poly_reduction (plist vars) 348 348 (with-parsed-polynomials ((vars) :poly-lists (plist) 349 349 :value-type :poly-list) 350 (reduction * coefficient-ring* plist)))350 (reduction *expression-ring* plist))) 351 351 352 352 (defmfun $poly_minimization (plist vars) … … 358 358 (with-parsed-polynomials ((vars) :poly-lists (plist) 359 359 :value-type :poly-list) 360 (poly-normalize-list * coefficient-ring* plist)))360 (poly-normalize-list *expression-ring* plist))) 361 361 362 362 (defmfun $poly_grobner (f vars) 363 363 (with-parsed-polynomials ((vars) :poly-lists (f) 364 364 :value-type :poly-list) 365 (grobner * coefficient-ring* (remzero f))))365 (grobner *expression-ring* (remzero f)))) 366 366 367 367 (defmfun $poly_reduced_grobner (f vars) 368 368 (with-parsed-polynomials ((vars) :poly-lists (f) 369 369 :value-type :poly-list) 370 (reduced-grobner * coefficient-ring* (remzero f))))370 (reduced-grobner *expression-ring* (remzero f)))) 371 371 372 372 (defmfun $poly_depends_p (p var mvars … … 380 380 (with-parsed-polynomials ((vars) :poly-lists (flist) 381 381 :value-type :poly-list) 382 (elimination-ideal * coefficient-ring* flist k nil 0)))382 (elimination-ideal *expression-ring* flist k nil 0))) 383 383 384 384 (defmfun $poly_colon_ideal (f g vars) 385 385 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 386 (colon-ideal * coefficient-ring* f g nil)))386 (colon-ideal *expression-ring* f g nil))) 387 387 388 388 (defmfun $poly_ideal_intersection (f g vars) 389 389 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 390 (ideal-intersection * coefficient-ring* f g nil)))390 (ideal-intersection *expression-ring* f g nil))) 391 391 392 392 (defmfun $poly_lcm (f g vars) 393 393 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial) 394 (poly-lcm * coefficient-ring* f g)))394 (poly-lcm *expression-ring* f g))) 395 395 396 396 (defmfun $poly_gcd (f g vars) … … 399 399 (defmfun $poly_grobner_equal (g1 g2 vars) 400 400 (with-parsed-polynomials ((vars) :poly-lists (g1 g2)) 401 (grobner-equal * coefficient-ring* g1 g2)))401 (grobner-equal *expression-ring* g1 g2))) 402 402 403 403 (defmfun $poly_grobner_subsetp (g1 g2 vars) 404 404 (with-parsed-polynomials ((vars) :poly-lists (g1 g2)) 405 (grobner-subsetp * coefficient-ring* g1 g2)))405 (grobner-subsetp *expression-ring* g1 g2))) 406 406 407 407 (defmfun $poly_grobner_member (p g vars) 408 408 (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g)) 409 (grobner-member * coefficient-ring* p g)))409 (grobner-member *expression-ring* p g))) 410 410 411 411 (defmfun $poly_ideal_saturation1 (f p vars) 412 412 (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p) 413 413 :value-type :poly-list) 414 (ideal-saturation-1 * coefficient-ring* f p 0)))414 (ideal-saturation-1 *expression-ring* f p 0))) 415 415 416 416 (defmfun $poly_saturation_extension (f plist vars new-vars) … … 418 418 :poly-lists (f plist) 419 419 :value-type :poly-list) 420 (saturation-extension * coefficient-ring* f plist)))420 (saturation-extension *expression-ring* f plist))) 421 421 422 422 (defmfun $poly_polysaturation_extension (f plist vars new-vars) … … 424 424 :poly-lists (f plist) 425 425 :value-type :poly-list) 426 (polysaturation-extension * coefficient-ring* f plist)))426 (polysaturation-extension *expression-ring* f plist))) 427 427 428 428 (defmfun $poly_ideal_polysaturation1 (f plist vars) 429 429 (with-parsed-polynomials ((vars) :poly-lists (f plist) 430 430 :value-type :poly-list) 431 (ideal-polysaturation-1 * coefficient-ring* f plist 0 nil)))431 (ideal-polysaturation-1 *expression-ring* f plist 0 nil))) 432 432 433 433 (defmfun $poly_ideal_saturation (f g vars) 434 434 (with-parsed-polynomials ((vars) :poly-lists (f g) 435 435 :value-type :poly-list) 436 (ideal-saturation * coefficient-ring* f g 0 nil)))436 (ideal-saturation *expression-ring* f g 0 nil))) 437 437 438 438 (defmfun $poly_ideal_polysaturation (f ideal-list vars) … … 440 440 :poly-list-lists (ideal-list) 441 441 :value-type :poly-list) 442 (ideal-polysaturation * coefficient-ring* f ideal-list 0 nil)))442 (ideal-polysaturation *expression-ring* f ideal-list 0 nil))) 443 443 444 444 (defmfun $poly_lt (f vars) … … 448 448 (defmfun $poly_lm (f vars) 449 449 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial) 450 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit * coefficient-ring*)))))))451 450 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *expression-ring*))))))) 451
Note:
See TracChangeset
for help on using the changeset viewer.