Changeset 4432
- Timestamp:
- 2016-06-09T23:12:29-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/polynomial.lisp
r4429 r4432 301 301 |# 302 302 303 #| 303 304 (defun fast-add (p q order-fn add-fn) 304 305 "Add two polynomials, P and Q, represented as lists of terms. … … 336 337 (t 337 338 (rotatef (cdr q) r q))))))) 338 339 |# 340 341 342 ;; Getter/setter of leading coefficient 343 (defun lc (x) (term-coeff (car x))) 344 (defun (setf lc) (new-value x) (setf (term-coeff (car x)) new-value)) 345 346 (defun fast-add (p q order-fn add-fn) 347 ;; Requirement: (car p) > (car q) 348 ;; (consp (cdr p)) 349 (do ((h p)) 350 ((endp q) p) 351 (multiple-value-bind 352 (greater-p equal-p) 353 (funcall order-fn (cadr h) (car q)) 354 (cond 355 (greater-p ; (> (cadr h) (car q)) 356 (setf h (cdr h)) 357 ) 358 (equal-p ; (= (cadr h)) (car q)) 359 (let ((s (funcall add-fn (lc h) (lc q)))) 360 (cond 361 ((universal-zerop s) 362 (setf h (cdr h) 363 q (cdr q))) 364 (t 365 ;; Adjust the lc of p 366 (setf (lc h) s 367 h (cdr h) 368 q (cdr q)))))) 369 (t ;(< (cadr h) (car q)) 370 (let ((tmp (cdr q))) 371 (setf (cdr q) (cdr p) 372 (cdr h) q 373 q tmp))))))) 374 375 376 339 377 #| 340 378 ;; NOTE: The stuff below works, but may not be worth the trouble.
Note:
See TracChangeset
for help on using the changeset viewer.