close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 4432 for branches


Ignore:
Timestamp:
2016-06-09T23:12:29-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r4429 r4432  
    301301|#
    302302
     303#|
    303304(defun fast-add (p q order-fn add-fn)
    304305  "Add two polynomials, P and Q, represented as lists of terms.
     
    336337          (t
    337338           (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
    339377#|
    340378;; NOTE: The stuff below works, but may not be worth the trouble.
Note: See TracChangeset for help on using the changeset viewer.