| [1201] | 1 | ;;; -*-  Mode: Lisp -*- | 
|---|
| [78] | 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 
|---|
|  | 3 | ;;; | 
|---|
|  | 4 | ;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu> | 
|---|
|  | 5 | ;;; | 
|---|
|  | 6 | ;;;  This program is free software; you can redistribute it and/or modify | 
|---|
|  | 7 | ;;;  it under the terms of the GNU General Public License as published by | 
|---|
|  | 8 | ;;;  the Free Software Foundation; either version 2 of the License, or | 
|---|
|  | 9 | ;;;  (at your option) any later version. | 
|---|
|  | 10 | ;;; | 
|---|
|  | 11 | ;;;  This program is distributed in the hope that it will be useful, | 
|---|
|  | 12 | ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of | 
|---|
|  | 13 | ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | 
|---|
|  | 14 | ;;;  GNU General Public License for more details. | 
|---|
|  | 15 | ;;; | 
|---|
|  | 16 | ;;;  You should have received a copy of the GNU General Public License | 
|---|
|  | 17 | ;;;  along with this program; if not, write to the Free Software | 
|---|
|  | 18 | ;;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | 
|---|
|  | 19 | ;;; | 
|---|
|  | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 
|---|
|  | 21 |  | 
|---|
| [397] | 22 | (defpackage "TERM" | 
|---|
| [1605] | 23 | (:use :cl :monom :ring) | 
|---|
| [2845] | 24 | (:export "TERM" | 
|---|
|  | 25 | "MAKE-TERM-VARIABLE" | 
|---|
|  | 26 | ) | 
|---|
| [2702] | 27 | (:documentation "This package implements class TERM. A term is a | 
|---|
|  | 28 | product of a scalar and powers of some variables, such as | 
|---|
|  | 29 | 5*X^2*Y^3. The part of the term without the coefficient is a monomial | 
|---|
|  | 30 | X^2*Y^3, which is represented by class MONOM, provided by the :MONOM | 
|---|
|  | 31 | package. In this implementation, a TERM specializes MONOL. Also, a | 
|---|
|  | 32 | monomial can be considered a TERM whose coefficient is the unit | 
|---|
|  | 33 | element (1) of the underlying ring. The generic method CHANGE-CLASS | 
|---|
|  | 34 | can be used to convert between a MONOM and a TERM, observing this | 
|---|
| [2703] | 35 | convention.")) | 
|---|
| [78] | 36 |  | 
|---|
| [420] | 37 | (in-package :term) | 
|---|
|  | 38 |  | 
|---|
| [1926] | 39 | (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0))) | 
|---|
|  | 40 |  | 
|---|
| [3132] | 41 | (defclass term (monom scalar) | 
|---|
| [3140] | 42 | () | 
|---|
| [3176] | 43 | (:default-initargs :dimension 0 :exponents '() :coeff 1) | 
|---|
| [3142] | 44 | (:documentation "Implements a term, i.e. a product of a scalar | 
|---|
| [2704] | 45 | and powers of some variables, such as 5*X^2*Y^3.")) | 
|---|
| [766] | 46 |  | 
|---|
| [2275] | 47 | (defmethod print-object ((self term) stream) | 
|---|
| [3169] | 48 | (with-accessors ((dimension monom-dimension) | 
|---|
|  | 49 | (exponents monom-exponents) | 
|---|
|  | 50 | (coeff scalar-coeff)) | 
|---|
| [3160] | 51 | self | 
|---|
|  | 52 | (format stream "#<TERM DIMENSION=~A EXPONENTS=~A COEFF=~A>" | 
|---|
|  | 53 | dimension | 
|---|
|  | 54 | exponents | 
|---|
| [3168] | 55 | coeff))) | 
|---|
| [3160] | 56 |  | 
|---|
| [2275] | 57 |  | 
|---|
| [3151] | 58 | (defmethod r-equalp ((term1 term) (term2 term)) | 
|---|
|  | 59 | (and (r-equalp (scalar-coeff term1) (scalar-coeff term2)) | 
|---|
| [3152] | 60 | (= (monom-dimension term1) (monom-dimension term2)) | 
|---|
|  | 61 | (equalp (monom-exponents term1) (monom-exponents term2)))) | 
|---|
| [3151] | 62 |  | 
|---|
|  | 63 |  | 
|---|
| [3141] | 64 | #| | 
|---|
| [2339] | 65 | (defmethod shared-initialize ((self term) slot-names | 
|---|
|  | 66 | &rest | 
|---|
| [2395] | 67 | initargs | 
|---|
| [2339] | 68 | &key | 
|---|
| [2377] | 69 | coeff | 
|---|
|  | 70 | &allow-other-keys) | 
|---|
| [2395] | 71 | (declare (ignore initargs)) | 
|---|
| [2385] | 72 | (if (eq slot-names t) (setf slot-names '(coeff))) | 
|---|
| [2378] | 73 | (dolist (slot-name slot-names) | 
|---|
|  | 74 | (case slot-name | 
|---|
|  | 75 | (coeff | 
|---|
| [2391] | 76 | (setf (slot-value self 'coeff) coeff))))) | 
|---|
| [3141] | 77 | |# | 
|---|
| [2342] | 78 |  | 
|---|
| [3178] | 79 | (defmethod update-instance-for-different-class ((old monom) (new term) | 
|---|
| [3164] | 80 | &rest | 
|---|
|  | 81 | initargs | 
|---|
|  | 82 | &key | 
|---|
| [3175] | 83 | &allow-other-keys) | 
|---|
| [3178] | 84 | (format t "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS MONOM->TERM called.%") | 
|---|
| [3175] | 85 | (format t "Old: ~A~%" old) | 
|---|
|  | 86 | (format t "Initargs: ~A~%" initargs) | 
|---|
| [3178] | 87 | (call-next-method)) | 
|---|
| [2377] | 88 |  | 
|---|
| [3178] | 89 | (defmethod update-instance-for-different-class ((old monom) (new  scalar)) | 
|---|
|  | 90 | &rest | 
|---|
|  | 91 | initargs | 
|---|
|  | 92 | &key | 
|---|
|  | 93 | &allow-other-keys) | 
|---|
|  | 94 | (format t "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS MONOM->SCALAR called.%") | 
|---|
|  | 95 | (format t "Old: ~A~%" old) | 
|---|
|  | 96 | (format t "Initargs: ~A~%" initargs) | 
|---|
|  | 97 | (call-next-method)) | 
|---|
| [3164] | 98 |  | 
|---|
| [3178] | 99 |  | 
|---|
| [2288] | 100 | #| | 
|---|
| [2189] | 101 | (defun make-term-variable (nvars pos | 
|---|
| [2021] | 102 | &optional | 
|---|
|  | 103 | (power 1) | 
|---|
| [2189] | 104 | (coeff 1)) | 
|---|
| [400] | 105 | "Construct a term in the polynomial ring RING[X[0],X[1],X[2],...X[NVARS-1]] | 
|---|
| [399] | 106 | over the ring RING which represents a single variable. It assumes | 
|---|
|  | 107 | number of variables NVARS and the variable is at position | 
|---|
|  | 108 | POS. Optionally, the variable may appear raised to power POWER. | 
|---|
|  | 109 | Optionally, the term may appear with an arbitrary coefficient, which | 
|---|
|  | 110 | defaults to the unit of the RING." | 
|---|
| [2189] | 111 | (declare (type fixnum nvars pos)) | 
|---|
| [1959] | 112 | (make-term :monom (make-monom-variable nvars pos power) | 
|---|
|  | 113 | :coeff coeff)) | 
|---|
| [51] | 114 |  | 
|---|
| [2352] | 115 | |# | 
|---|
|  | 116 |  | 
|---|
| [2946] | 117 | (defmethod multiply-by :before ((self term) (other term)) | 
|---|
| [2833] | 118 | "Destructively multiply terms SELF and OTHER and store the result into SELF. | 
|---|
| [2805] | 119 | It returns SELF." | 
|---|
| [3143] | 120 | (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other)))) | 
|---|
| [2477] | 121 |  | 
|---|
| [3031] | 122 | (defmethod left-tensor-product-by ((self term) (other term)) | 
|---|
| [3143] | 123 | (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other))) | 
|---|
| [3031] | 124 | (call-next-method)) | 
|---|
| [3027] | 125 |  | 
|---|
| [3038] | 126 | (defmethod right-tensor-product-by ((self term) (other term)) | 
|---|
| [3143] | 127 | (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other))) | 
|---|
| [3038] | 128 | (call-next-method)) | 
|---|
|  | 129 |  | 
|---|
| [3059] | 130 | (defmethod left-tensor-product-by ((self term) (other monom)) | 
|---|
|  | 131 | (call-next-method)) | 
|---|
|  | 132 |  | 
|---|
|  | 133 | (defmethod right-tensor-product-by ((self term) (other monom)) | 
|---|
|  | 134 | (call-next-method)) | 
|---|
|  | 135 |  | 
|---|
| [2832] | 136 | (defmethod divide-by ((self term) (other term)) | 
|---|
| [2833] | 137 | "Destructively divide term SELF by OTHER and store the result into SELF. | 
|---|
| [2832] | 138 | It returns SELF." | 
|---|
| [3143] | 139 | (setf (scalar-coeff self) (divide-by (scalar-coeff self) (scalar-coeff other))) | 
|---|
| [2832] | 140 | (call-next-method)) | 
|---|
|  | 141 |  | 
|---|
| [2685] | 142 | (defmethod unary-minus ((self term)) | 
|---|
| [3135] | 143 | (setf (scalar-coeff self) (unary-minus (scalar-coeff self))) | 
|---|
| [2685] | 144 | self) | 
|---|
|  | 145 |  | 
|---|
| [2938] | 146 | (defmethod r* ((term1 term) (term2 term)) | 
|---|
|  | 147 | "Non-destructively multiply TERM1 by TERM2." | 
|---|
| [2967] | 148 | (multiply-by (copy-instance term1) (copy-instance term2))) | 
|---|
| [2938] | 149 |  | 
|---|
| [2942] | 150 | (defmethod r-zerop ((self term)) | 
|---|
| [3135] | 151 | (r-zerop (scalar-coeff self))) | 
|---|
| [2938] | 152 |  | 
|---|
| [2352] | 153 | #| | 
|---|
| [1147] | 154 |  | 
|---|
|  | 155 | (defun term->cons (term) | 
|---|
| [1154] | 156 | "A human-readable representation of a term as a cons (MONOM . COEFF)." | 
|---|
| [1902] | 157 | (declare (type term term)) | 
|---|
| [3135] | 158 | (cons (monom->list (term-monom term)) (scalar-coeff term))) | 
|---|
| [1147] | 159 |  | 
|---|
| [2288] | 160 | |# | 
|---|