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


Ignore:
Timestamp:
2015-06-12T15:30:53-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/gb-postprocessing.lisp

    r1542 r1543  
    4242  (declare (type ring-and-order ring-and-order))
    4343  (do ((q plist)
    44        (found t))
     44       (found t)
     45       p)
    4546      ((not found)
    4647       (mapcar #'(lambda (x) (poly-primitive-part ring x)) q))
    47     ;;Find p in Q such that p is reducible mod Q\{p}
     48    ;; 1) Find p in Q such that p is reducible mod Q\{p}
     49    ;; 2) Replace p with remainder from division by Q\{p}, if
     50    ;;    non-zero, else set Q to Q\{p}
    4851    (setf found nil)
    49     (let ((x (find-if
    50               #'(lambda (y)
    51                   (multiple-value-bind (h c div-count)
    52                       (normal-form ring-and-order
    53                                    y
    54                                    (remove y q)
    55                                    nil #| not a top reduction! |#
    56                                    )
    57                     (declare (ignore h c))
    58                     (plusp div-count))))))
    59       (when x
    60         (setf found t
    61               q (delete x q))))))
     52    (dolist (x q)
     53      (multiple-value-bind (h c div-count)
     54          (normal-form ring-and-order x (remove x q) nil #| not a top reduction! |#)
     55        (declare (ignore c))
     56        (when (plusp div-count)
     57          (setf found t
     58                p h)
     59          (return))))
     60    (when found
     61      (if (poly-zerop p)
     62          (setf q q1)
     63          (setf q (cons p q1))))))
     64
    6265
    6366(defun minimization (plist)
Note: See TracChangeset for help on using the changeset viewer.