source: CGBLisp/src/RCS/division.lisp,v@ 1

head    1.4;
access;
symbols;
locks; strict;
comment @;;; @;


1.4
date    2009.01.22.04.00.56;    author marek;   state Exp;
branches;
next    1.3;

1.3
date    2009.01.19.09.24.56;    author marek;   state Exp;
branches;
next    1.2;

1.2
date    2009.01.19.07.40.35;    author marek;   state Exp;
branches;
next    1.1;

1.1
date    2009.01.19.06.48.09;    author marek;   state Exp;
branches;
next    ;


desc
@@


1.4
log
@*** empty log message ***
@
text
@#|
        $Id$    
  *--------------------------------------------------------------------------*
  |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@@math.arizona.edu)    |
  |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    |
  |                                                                          |
  | Everyone is permitted to copy, distribute and modify the code in this    |
  | directory, as long as this copyright note is preserved verbatim.         |
  *--------------------------------------------------------------------------*
|#
(defpackage "DIVISION"
  (:use "MONOM" "ORDER" "TERM" "POLY" "COEFFICIENT-RING" "COMMON-LISP")
  (:export divide poly-exact-divide))

(in-package  "DIVISION")

#+debug(proclaim '(optimize (speed 0) (debug 3)))
#-debug(proclaim '(optimize (speed 3) (debug 0)))

(defun divide (f fl &optional
                    (pred #'lex>)
                    (ring *coefficient-ring*)
                 &aux (s (length fl)))
  "Divide polynomial F by a list of polynomials FL; use predicate PRED
to sort monomials; assumes that the polynomials have initially been
sorted according to PRED. It returnes multiple values. The first value
is a list of quotients A.  The second value is the remainder R. These
object satisfy the quation F = SUM A[J]*FL[I] + R."
  (do ((a (make-list s))
       r 
       (p f)
       (division-occurred nil nil))
      ((endp p) (values (mapcar #'reverse a) (reverse r)))
    (declare (list a r p))
    (do ((fl fl (rest fl))
         (a a (rest a)))
        ((or (endp fl) division-occurred))
      (when (term-divides-p (car (first fl)) (first p))
        (let ((quot (term/ (first p) (car (first fl)) ring)))
          (push quot (car a))
          (setf p (poly-op (rest p) quot (rest (first fl)) pred ring)
                division-occurred t))))
    (when (not division-occurred)
      (setf r (cons (first p) r)
            p (rest p))))) 
        
(defun poly-exact-divide (f g  &optional (order #'lex>) (ring *coefficient-ring*))
  "Divide a polynomial F by another polynomial G. Assume that exact division
with no remainder is possible. Returns the quotient."
  (multiple-value-bind (q r)
      (divide f (list g) order ring)
    (unless (endp r) (error "Exact division failed."))
    (car q)))
@


1.3
log
@*** empty log message ***
@
text
@d17 2
a18 2
;;(proclaim '(optimize (speed 0) (debug 3)))
(proclaim '(optimize (speed 3) (debug 0)))
@


1.2
log
@*** empty log message ***
@
text
@d17 2
a18 1
(proclaim '(optimize (speed 0) (debug 3)))
@


1.1
log
@Initial revision
@
text
@d2 1
a2 1
        $Id: division.lisp,v 1.16 1997/12/04 03:44:32 marek Exp $       
d17 1
a17 2
(eval-when (compile)
  (proclaim '(optimize (safety 0) (speed 3))))
@