source: branches/f4grobner/ring.lisp@ 2507

;;; -*-  mode: lisp; package: maxima; syntax: common-lisp; base: 10 -*- 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                              
;;;  copyright (c) 1999, 2002, 2009, 2015 marek rychlik <rychlik@u.arizona.edu>          
;;;                                                                              
;;;  this program is free software; you can redistribute it and/or modify        
;;;  it under the terms of the gnu general public license as published by        
;;;  the free software foundation; either version 2 of the license, or           
;;;  (at your option) any later version.                                         
;;;                                                                              
;;;  this program is distributed in the hope that it will be useful,             
;;;  but without any warranty; without even the implied warranty of              
;;;  merchantability or fitness for a particular purpose.  see the               
;;;  gnu general public license for more details.                                
;;;                                                                              
;;;  you should have received a copy of the gnu general public license           
;;;  along with this program; if not, write to the free software                 
;;;  foundation, inc., 59 temple place - suite 330, boston, ma 02111-1307, usa.  
;;;                                                                              
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; coefficient ring operations
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; these are all operations that are performed on the coefficients by
;; the package, and thus the coefficient ring can be changed by merely
;; redefining these operations.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defpackage "RING"
  (:use :cl)
  (:export "R-PARSE"
           "UNIT-ELEMENT"
           "R-ZEROP"
           "R+"
           "R-"
           "R*"
           "R+"
           "R/"
           "R-EXPT"
           "R-LCM"
           "R-EZGCD"
           "R-GCD"
           "R-TOTAL-DEGREE"
           "R-DIMENSION"
           "R-EXPONENTS"
           "R-COEFF"
           "R-SUGAR"
           "R-DIVIDES-P"   
           "R-DIVIDES-LCM-P"
           "R-LCM-DIVIDES-LCM-P"
           "R-LCM-EQUAL-LCM-P"
           "R-REL-PRIME-P"    
           "R-EQUALP"          
           "R-ELT"
           "R->LIST"
           "R-DIVISIBLE-BY-P"   
           "R-REL-PRIME-P"      
           "R-DEPENDS-P"        
           "R-TENSOR-PRODUCT"
           "R-CONTRACT"      
           "R-LENGTH"
           "MULTIPLY-BY"
           "ADD-TO"
           "SUBTRACT-FROM"
           "UNARY-UMINUS"
           "SCALAR"
))

(in-package :ring)

(defclass scalar () 
  ((value :initarg :value :accessor value))
  (:documentation "Wraps objects suitable as scalars/polynomial coefficients"))

(defgeneric unit-element (class)
  (:method (class built-in-class) 1))

(defgeneric r-zerop (object)
  (:method ((self number)) (zerop self)))

(defgeneric r+ (x y)
  (:method ((x number) (y number)) (+ x y))) 

(defgeneric r- (x y)
  (:method ((x number) (y number)) (- x y))) 

(defgeneric r* (x y)
  (:method ((x number) (y number)) (* x y))) 

(defgeneric r-tensor-product (x y))

(defgeneric r/ (x y)
  (:method ((x number) (y number)) (/ x y))) 

(defgeneric r-lcm (x y)
  (:method ((x integer) (y integer)) (lcm x y))) 

(defgeneric r-expt (x y)
  (:method ((x integer) (y integer)) (expt x y))) 

(defgeneric r-ezgcd (x y)
  (:method ((x integer) (y integer)
            &aux (c (gcd x y)))
    (values c (/ x c) (/ y c))))

(defgeneric r-gcd (x y)
  (:method ((x integer) (y integer))
    (gcd x y)))

(defgeneric r-dimension (object))
(defgeneric r-exponents (object))
(defgeneric r-coeff (object))

(defgeneric r-total-degree (object &optional start end))

(defgeneric r-divides-p (object1 object2)
  (:method ((object1 integer) (object2 integer))
    (zerop (rem object2 object1)))
  (:documentation "Returns T if OBJECT1 divides OBJECT2"))

(defgeneric r-divides-lcm-p (object1 object2 object3)
  (:documentation "Returns T if OBJECT divides LCM(OBJECT2, OBJECT3), NIL otherwise."))

(defgeneric r-lcm-divides-lcm-p (object1 object2 object3 object4)
  (:documentation "Returns T if LCM(OBJECT1,OBJECT2) divides LCM(OBJECT3,OBJECT4), NIL otherwise."))

(defgeneric r-lcm-equal-lcm-p (object1 object2 object3 object4)
  (:documentation "Returns T if object LCM(OBJECT1,OBJECT2) equals LCM(OBJECT3,OBJECT4), NIL otherwise."))

(defgeneric r-equalp (object1 object2)
  (:method ((object1 t) (object2 t)) (equalp object1 object2))
  (:documentation "Equality using deep comparison of object slots."))

(defgeneric r-elt (object index))

(defgeneric (setf r-elt) (new-value object index))

(defgeneric r-length (object))

(defgeneric r->list (object))
(defgeneric r-sugar (object))
(defgeneric r-rel-prime-p (object1 object2))
(defgeneric r-contract (object k))
(defgeneric r-divisible-by-p (object1 object2))
(defgeneric r-depends-p (object k))

(defgeneric multiply-by (self other)
  (:method (self other) (r* self other)))

(defgeneric add-to (self other)
  (:method (self other) (r+ self other)))

(defgeneric subtract-from (self other)
  (:method (self other) (r- self other)))

(defmethod unary-uminus (self))