source: branches/f4grobner/ring.lisp

;;; -*-  Mode: Lisp -*- 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                              
;;;  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.  
;;;                                                                              
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defpackage "RING"
  (:use :cl :copy)
  (:export "RING"
           "FIELD"
           "ADD-TO"
           "SUBTRACT-FROM"
           "MULTIPLY-BY"
           "DIVIDE-BY"
           "ADD"
           "SUBTRACT"
           "MULTIPLY"
           "DIVIDE"
           "UNARY-MINUS"
           "UNARY-INVERSE"
           "UNIVERSAL-GCD"
           "UNIVERSAL-EZGCD"
           "UNIVERSAL-EQUALP"
           "UNIVERSAL-ZEROP"
           "MAKE-ZERO-FOR"
           "MAKE-UNIT-FOR"
           "->SEXP"
           "RATIONAL-FIELD"
           "RATIONAL-FIELD-VALUE"
           "MAKE-ZERO-FOR"
           "MAKE-UNIT-FOR"
           "INTEGER-RING"
           "INTEGER-RING-VALUE"
           )
  (:documentation "Defines an abstract ring class and ring operations.")
  )

(in-package "RING")

(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))

(defclass ring () () (:documentation "An abstract ring."))
(defclass field (ring) () (:documentation "An abstract ring."))
           
(defgeneric multiply-by (self other)
  (:documentation "Multiply SELF by OTHER."))

(defgeneric divide-by (self other)
  (:documentation "Divide SELF by OTHER."))

(defgeneric add-to (self other)
  (:documentation "Add OTHER to SELF."))

(defgeneric subtract-from (self other)
  (:documentation "Subtract OTHER from SELF."))

(defgeneric unary-minus (self)
  (:documentation "Changes SELF to its negative."))

(defgeneric unary-inverse (self)
  (:documentation "Changes SELF to the unary inverse of SELF."))

(defgeneric universal-gcd (object other)
  (:documentation "Returns GCD(OBJECT, OTHER)"))

(defgeneric universal-ezgcd (x y)
  (:documentation "Solves the diophantine system: X=C*X1, Y=C*X2,
C=GCD(X,Y).  It returns three values: C, X1 and Y1. The result may be obtained by
the Euclidean algorithm.")
  (:method ((x t) (y t) &aux (c (universal-gcd x y)))
    (values c (divide x c) (divide y c))))

(defgeneric universal-equalp (self other)
  (:documentation "Return T if objects SELF and OTHER are equal, NIL otherwise.")
  (:method ((object1 null) (object2 null)) t)
  (:method ((object1 cons) (object2 cons)) (every #'universal-equalp object1 object2))
  (:method ((self number) (other number)) (= self other)))

(defgeneric universal-zerop (self)
  (:documentation "Return T if SELF is a zero in the ring it belongs to."))

(defgeneric ->sexp (self &optional vars)
  (:documentation "Convert SELF to an S-expression."))

(defgeneric make-zero-for (self)
  (:documentation "Create a zero in the ring of SELF. A fresh instance
should be returned upon every call."))

(defgeneric make-unit-for (self)
  (:documentation "Create a unit in the ring of SELF. A fresh instance
should be returned upon every call."))

(defgeneric add (summand &rest more-summands)
  (:documentation "Successively adds to SUMMAND the elements of
MORE-SUMMANDS, using ADD-TO. The first SUMMAND must not be
destructively modified.  Instead, a copy of factor should be made and
returned as the value of this function.")
  (:method ((summand t) &rest more-summands)
    "The default implementation of ADD."
    (reduce #'add-to more-summands :initial-value (copy-instance summand))))

(defgeneric subtract (minuend  &rest subtrahends)
  (:documentation "Successively subtracts SUBTRAHENDS from MINUEND,
using SUBTRACT-FROM. MINUEND. must not be destructively modified.
Instead, a copy of factor should be made and returned as the value of
this function.")
  (:method ((minuend t) &rest subtrahends)
    "The default implementation of SUBTRACT."
    (cond ((endp subtrahends) (unary-minus (copy-instance minuend)))
          (t (reduce #'subtract-from subtrahends :initial-value (copy-instance minuend))))))

(defgeneric multiply (factor &rest more-factors)
  (:documentation "Successively multiplies factor FACTOR by the remaining arguments
MORE-FACTORS, using MULTIPLY-BY to multiply two factors. FACTOR must not be destructively modified.
Instead, a copy of factor should be made and returned as the value of this function.")
  (:method ((factor t) &rest more-factors)
    "The default implementation of MULTIPLY."
    (reduce #'multiply-by more-factors :initial-value (copy-instance factor))))

(defgeneric divide (numerator &rest denominators)
  (:documentation "Successively divides NUMERATOR by elements of DENOMINATORS. The operation
should not modify the NUMERATOR. Instead, a copy of factor should be made and returned as the value of this function.")
  (:method ((numerator t) &rest denominators)
    "The default implementation of DIVIDE."
    (cond ((endp denominators)
           (unary-inverse (copy-instance numerator)))
          (t (reduce #'divide-by denominators :initial-value (copy-instance numerator))))))