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 2603


Ignore:
Timestamp:
2015-06-20T01:10:34-07:00 (10 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r2602 r2603  
    9191  self)
    9292
    93 (defun fast-add-to (p q order-fn)
    94   "Fast destructive addition of termlists
    95 Note that this assumes the presence of a
    96 dummy header."
    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)))))
    11693
    11794(defmethod add-to ((self poly) (other poly))
     
    12097The result is stored in SELF. This implementation does
    12198no consing, entirely reusing the sells of SELF and OTHER."
    122   (with-slots ((termlist1 termlist) (order1 order))
    123       self
    124     (with-slots ((termlist2 termlist) (order2 order))
    125         other
    126       ;; Ensure orders are compatible
    127       (unless (eq order1 order2)
    128         (setf termlist2 (sort termlist2 order1)
    129               order2 order1))
    130       ;; Create dummy head
    131       (push nil termlist1)
    132       (push nil termlist2)
    133       (fast-add-to termlist1 termlist2 order1)
    134       ;; Remove dummy head
    135       (pop termlist1)))
     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))))))
     121    (with-slots ((termlist1 termlist) (order1 order))
     122        self
     123      (with-slots ((termlist2 termlist) (order2 order))
     124          other
     125        ;; Ensure orders are compatible
     126        (unless (eq order1 order2)
     127          (setf termlist2 (sort termlist2 order1)
     128                order2 order1))
     129        ;; Create dummy head
     130        (push nil termlist1)
     131        (push nil termlist2)
     132        (fast-add-to termlist1 termlist2 order1)
     133        ;; Remove dummy head
     134        (pop termlist1))))
    136135  self)
    137136
Note: See TracChangeset for help on using the changeset viewer.