Changeset 2002 for branches/f4grobner
- Timestamp:
- 2015-06-16T15:26:56-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/pol.lisp
r2001 r2002 136 136 (defmethod poly-uminus ((self poly))) 137 137 138 (defmethod poly-mul ((p poly) ( poly q)))138 (defmethod poly-mul ((p poly) (q poly))) 139 139 140 140 (defmethod poly-expt ((self poly) n)) … … 148 148 of polynomials in internal form. A similar operation in another computer 149 149 algebra system could be called 'expand' or so." 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 (scalar->poly ring expr vars)))))))150 (cond 151 ((null expr) (error "Empty expression")) 152 ((eql expr 0) (make-poly-zero)) 153 ((member expr vars :test #'equalp) 154 (let ((pos (position expr vars :test #'equalp))) 155 (make-poly-variable ring (length vars) pos))) 156 ((atom expr) 157 (scalar->poly ring expr vars)) 158 ((eq (car expr) list-marker) 159 (cons list-marker (p-eval-list (cdr expr)))) 160 (t 161 (case (car expr) 162 (+ (reduce #'p-add (p-eval-list (cdr expr)))) 163 (- (case (length expr) 164 (1 (make-poly-zero)) 165 (2 (poly-uminus ring (p-eval (cadr expr)))) 166 (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr)))) 167 (otherwise (poly-sub ring-and-order (p-eval (cadr expr)) 168 (reduce #'p-add (p-eval-list (cddr expr))))))) 169 (* 170 (if (endp (cddr expr)) ;unary 171 (p-eval (cdr expr)) 172 (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (p-eval-list (cdr expr))))) 173 (/ 174 ;; A polynomial can be divided by a scalar 175 (cond 176 ((endp (cddr expr)) 177 ;; A special case (/ ?), the inverse 178 (scalar->poly ring (apply (ring-div ring) (cdr expr)) vars)) 179 (t 180 (let ((num (p-eval (cadr expr))) 181 (denom-inverse (apply (ring-div ring) 182 (cons (funcall (ring-unit ring)) 183 (mapcar #'p-eval-scalar (cddr expr)))))) 184 (scalar-times-poly ring denom-inverse num))))) 185 (expt 186 (cond 187 ((member (cadr expr) vars :test #'equalp) 188 ;;Special handling of (expt var pow) 189 (let ((pos (position (cadr expr) vars :test #'equalp))) 190 (make-poly-variable ring (length vars) pos (caddr expr)))) 191 ((not (and (integerp (caddr expr)) (plusp (caddr expr)))) 192 ;; Negative power means division in coefficient ring 193 ;; Non-integer power means non-polynomial coefficient 194 (scalar->poly ring expr vars)) 195 (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr))))) 196 (otherwise 197 (scalar->poly ring expr vars)))))) 198 198 199 199 (defun poly-eval-scalar (expr
Note:
See TracChangeset
for help on using the changeset viewer.