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 4495 for branches


Ignore:
Timestamp:
2016-06-16T20:49:54-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/slow-add.lisp

    r4493 r4495  
    1 (defun slow-add (p q order-fn add-fn)
    2   (cond
    3     ((endp p) q)
    4     ((endp q) p)
    5     (t
    6      (multiple-value-bind
    7            (greater-p equal-p)
    8          (funcall order-fn (car p) (car q))
    9        (cond
    10          (greater-p                     ; (> (car p) (car q))
    11           (cons (car p) (slow-add (cdr p) q order-fn add-fn))
    12           )
    13          (equal-p                       ; (= (car p)) (car q))
    14           (let ((s (funcall add-fn (lc p) (lc q))))
    15             (cond
    16               ((universal-zerop s)
    17                (slow-add (cdr p) (cdr q) order-fn add-fn))
    18               (t
    19                ;; Adjust the lc of p
    20                (setf (lc p) s)
    21                (cons (car p) (slow-add (cdr p) (cdr q) order-fn add-fn))
    22                ))))
    23          (t                    ;(< (car p) (car q))                     
    24           (cons (car q) (slow-add p (cdr q) order-fn add-fn))
    25           ))))))
     1(in-package :polynomial)
     2
     3(defun f-add (p q order-fn add-fn)
     4  "Add two polynomials, P and Q, represented as lists of terms.
     5The operation is destructive to both polynomials, as the terms
     6of both lists are combined into the result. The operation does not
     7create any new instance of TERM."
     8  (do (r)
     9      ((or (endp p) (endp q))
     10       ;; NOTE: R contains the result in reverse order. Can it
     11       ;; be more efficient to produce the terms in correct order?
     12       (unless (endp q)
     13         (setf r (nreconc r q)))
     14       (unless (endp p)
     15         (setf r (nreconc r p)))
     16       r)
     17    (multiple-value-bind
     18          (greater-p equal-p)
     19        (funcall order-fn (car p) (car q))
     20      (cond
     21        (greater-p
     22         (rotatef (cdr p) r p)
     23         )
     24        (equal-p
     25         (let ((s (funcall add-fn (lc p) (lc q))))
     26           (cond
     27             ((universal-zerop s)
     28              (setf p (cdr p))
     29              )
     30             (t
     31              (setf (lc p) s)
     32              (rotatef (cdr p) r p))))
     33         (setf q (cdr q))
     34         )
     35        (t
     36         (rotatef (cdr q) r q))))))
Note: See TracChangeset for help on using the changeset viewer.