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 2604 for branches/f4grobner


Ignore:
Timestamp:
2015-06-20T01:16:29-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r2603 r2604  
    9191  self)
    9292
     93(defun fast-add-to (p q order-fn)
     94  "Fast destructive addition of termlists P and Q, ordered by
     95predicate ORDER-FN. Note that this assumes the presence of a dummy
     96header."
     97  (macrolet ((lt (x) `(cadr ,x))
     98             (lc (x) `(r-coeff (cadr ,x))))
     99    (do ((p p)
     100         (q q))
     101        ((or (endp (cdr p)) (endp (cdr q)))
     102         p)
     103      (multiple-value-bind
     104            (greater-p equal-p)
     105          (funcall order-fn (lt q) (lt p))
     106        (cond
     107          (greater-p
     108           (rotatef (cdr p) (cdr q)))
     109          (equal-p
     110           (let ((s (add-to (lc p) (lc q))))
     111             (if (r-zerop s)
     112                 (setf (cdr p) (cddr p))
     113                 (setf (lc p) s
     114                       q (cdr q)))))))
     115      (setf p (cdr p)))))
    93116
    94117(defmethod add-to ((self poly) (other poly))
     
    97120The result is stored in SELF. This implementation does
    98121no consing, entirely reusing the sells of SELF and OTHER."
    99   (flet ((fast-add-to (p q order-fn)
    100            ;; Fast destructive addition of termlists Note that this
    101            ;; assumes the presence of a dummy header."
    102            (macrolet ((lt (x) `(cadr ,x))
    103                       (lc (x) `(r-coeff (cadr ,x))))
    104              (do ((p p)
    105                   (q q))
    106                  ((or (endp (cdr p)) (endp (cdr q)))
    107                   p)
    108                (multiple-value-bind
    109                      (greater-p equal-p)
    110                    (funcall order-fn (lt q) (lt p))
    111                  (cond
    112                    (greater-p
    113                     (rotatef (cdr p) (cdr q)))
    114                    (equal-p
    115                     (let ((s (add-to (lc p) (lc q))))
    116                       (if (r-zerop s)
    117                           (setf (cdr p) (cddr p))
    118                           (setf (lc p) s
    119                                 q (cdr q)))))))
    120                (setf p (cdr p))))))
    121122    (with-slots ((termlist1 termlist) (order1 order))
    122123        self
     
    134135        (pop termlist1))))
    135136  self)
    136 
    137 (defmethod subtract-from ((self poly) (other poly)))
    138137
    139138(defmethod unary-uminus ((self poly)))
Note: See TracChangeset for help on using the changeset viewer.