Changeset 1811
- Timestamp:
- 2015-06-15T12:57:10-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/mx-grobner.lisp
r1810 r1811 368 368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 369 369 ;; 370 ;; Unary and binary operation definition facility 371 ;; 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 373 374 (defmacro define-unop ((maxima-name fun-name (&rest args) &key (env :ring-and-order)) 375 &optional 376 (documentation nil documentation-supplied-p) 377 &aux 378 ;; The argument passed as first arg 379 (env-arg (ecase env 380 (:ring-and-order 'ring-and-order) 381 (:ring 'ring)))) 370 ;; N-ary (unary and binary) operation definition facility 371 ;; 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 373 374 (defmacro define-op (maxima-name (fun-name &rest args) 375 &key (env :ring-and-order) 376 &optional 377 (documentation nil documentation-supplied-p) 378 &aux 379 ;; The argument passed as first arg 380 (env-arg (ecase env 381 (:ring-and-order 'ring-and-order) 382 (:ring 'ring)))) 382 383 "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME." 383 384 `(defmfun ,maxima-name (,@args vars) … … 386 387 (,fun-name ,env-arg ,@args p)))) 387 388 388 (defmacro define-binop ((maxima-name fun-name)389 &optional (documentation nil documentation-supplied-p))390 "Define a MAXIMA-level binary operator MAXIMA-NAME corresponding to binary function FUN-NAME."391 `(defmfun ,maxima-name (p q vars)392 ,@(when documentation-supplied-p (list documentation))393 (with-ring-and-order ((vars) :polynomials (p q) :value-type :polynomial)394 (,fun-name ring-and-order p q))))395 396 397 389 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 398 390 ;; … … 405 397 406 398 ;;Simple operators 407 (define- binop ($poly_add poly-add (p q))399 (define-op $poly_add (poly-add p q) 408 400 "Adds two polynomials P and Q") 409 401 410 (define-binop ($poly_subtract poly-sub (p q)) 402 #| 403 (define-op ($poly_subtract poly-sub (p q)) 411 404 "Subtracts a polynomial Q from P.") 412 405 413 (define- binop ($poly_multiply poly-mul (p q))406 (define-op ($poly_multiply poly-mul (p q)) 414 407 "Returns the product of polynomials P and Q.") 415 408 416 (define- binop ($poly_s_polynomial spoly (p q))409 (define-op ($poly_s_polynomial spoly (p q)) 417 410 "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.") 418 411 419 (define- unop ($poly_primitive_part poly-primitive-part (p) :env :ring)412 (define-op ($poly_primitive_part poly-primitive-part (p) :env :ring) 420 413 "Returns the polynomial P divided by GCD of its coefficients.") 421 414 422 (define- unop ($poly_normalize poly-normalize (p) :env :ring)415 (define-op ($poly_normalize poly-normalize (p) :env :ring) 423 416 "Returns the polynomial P divided by the leading coefficient.") 424 417 425 418 |# 426 419 427 420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Note:
See TracChangeset
for help on using the changeset viewer.