Changeset 1043 for branches/f4grobner
- Timestamp:
- 2015-06-10T08:40:57-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/parse.lisp
r1042 r1043 251 251 (t (sort-poly-1 poly-or-poly-list order)))) 252 252 253 ;; Return the standard basis of the monomials in n variables 254 (defun variable-basis (ring n &aux (basis (make-list n))) 255 "Generate a list of polynomials X[i], i=0,1,...,N-1." 256 (dotimes (i n basis) 257 (setf (elt basis i) (make-variable ring n i)))) 258 259 (defun poly-eval-1 (expr vars &optional (ring *ring-of-integers*) (order #'lex>) 260 &aux 261 (ring-and-order (make-ring-and-order :ring ring :order order)) 262 (n (length vars)) 263 (basis (variable-basis ring (length vars)))) 264 "Evaluate an expression EXPR as polynomial by substituting operators 265 + - * expt with corresponding polynomial operators and variables VARS 266 with the corresponding polynomials in internal form. We use special 267 versions of binary operators $poly+, $poly-, $minus-poly, $poly* and 268 $poly-expt which work like the corresponding functions in the POLY 269 package, but accept scalars as arguments as well. The result is a 270 polynomial in internal form. This operation is somewhat similar to 271 the function EXPAND in CAS." 272 (cond 273 ((numberp expr) 274 (cond 275 ((zerop expr) NIL) 276 (t (make-poly-from-termlist (list (make-term (make-monom :dimension n) expr)))))) 277 ((symbolp expr) 278 (nth (position expr vars) basis)) 279 ((consp expr) 280 (case (car expr) 281 (expt 282 (if (= (length expr) 3) 283 ($poly-expt ring-and-order 284 (poly-eval-1 (cadr expr) vars ring order) 285 (caddr expr) 286 n) 287 (error "Too many arguments to EXPT"))) 288 (/ 289 (if (and (= (length expr) 3) 290 (numberp (caddr expr))) 291 ($poly/ ring (cadr expr) (caddr expr)) 292 (error "The second argument to / must be a number"))) 293 (otherwise 294 (let ((r (mapcar 295 #'(lambda (e) (poly-eval-1 e vars ring order)) 296 (cdr expr)))) 297 (ecase (car expr) 298 (+ (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) r)) 299 (- 300 (if (endp (cdr r)) 301 ($minus-poly ring (car r) n) 302 ($poly- ring-and-order 303 (car r) 304 (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) (cdr r)) 305 n))) 306 (* 307 (reduce #'(lambda (p q) ($poly* ring-and-order p q n)) r)) 308 ))))))) 309 310 311 (defun poly-eval (expr vars &optional (order #'lex>) (ring *ring-of-integers*)) 312 "Evaluate an expression EXPR, which should be a polynomial 313 expression or a list of polynomial expressions (a list of expressions 314 marked by prepending keyword :[ to it) given in Lisp prefix notation, 315 in variables VARS, which should be a list of symbols. The result of 316 the evaluation is a polynomial or a list of polynomials (marked by 317 prepending symbol '[) in the internal alist form. This evaluator is 318 used by the PARSE package to convert input from strings directly to 319 internal form." 320 (cond 321 ((numberp expr) 322 (unless (zerop expr) 323 (make-poly-from-termlist 324 (list (make-term (make-monom :dimension (length vars)) expr))))) 325 ((or (symbolp expr) (not (eq (car expr) :[))) 326 (poly-eval-1 expr vars ring order)) 327 (t (cons '[ (mapcar #'(lambda (p) (poly-eval-1 p vars ring order)) (rest expr)))))) 328 329 253 254
Note:
See TracChangeset
for help on using the changeset viewer.