[1] | 1 | ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: Grobner; Base: 10 -*-
|
---|
| 2 | #|
|
---|
| 3 | *--------------------------------------------------------------------------*
|
---|
| 4 | | Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu) |
|
---|
| 5 | | Department of Mathematics, University of Arizona, Tucson, AZ 85721 |
|
---|
| 6 | | |
|
---|
| 7 | | Everyone is permitted to copy, distribute and modify the code in this |
|
---|
| 8 | | directory, as long as this copyright note is preserved verbatim. |
|
---|
| 9 | *--------------------------------------------------------------------------*
|
---|
| 10 | |#
|
---|
| 11 |
|
---|
| 12 | (defpackage "COEFFICIENT-RING"
|
---|
| 13 | (:export ring
|
---|
| 14 | ring-+
|
---|
| 15 | ring--
|
---|
| 16 | ring-*
|
---|
| 17 | ring-/
|
---|
| 18 | ring-gcd
|
---|
| 19 | ring-lcm
|
---|
| 20 | ring-signum
|
---|
| 21 | ring-zerop
|
---|
| 22 | ring-unit
|
---|
| 23 | ring-length
|
---|
| 24 | ring-numerator
|
---|
| 25 | ring-denominator
|
---|
| 26 | make-ring
|
---|
| 27 | *coefficient-ring*
|
---|
| 28 | *ring-of-integers*
|
---|
| 29 | *field-of-rationals*
|
---|
| 30 | field-modulo-prime
|
---|
| 31 | )
|
---|
| 32 | (:use "MODULAR" "COMMON-LISP"))
|
---|
| 33 |
|
---|
| 34 | (in-package "COEFFICIENT-RING")
|
---|
| 35 |
|
---|
[98] | 36 | (proclaim '(optimize (speed 0) (space 0) (safety 3) (debug 3)))
|
---|
[1] | 37 |
|
---|
| 38 | (defstruct ring
|
---|
| 39 | "The structure whose slots are bound to functions
|
---|
| 40 | performing usual ring operations. In addition to usual arithmetical
|
---|
| 41 | operations, bindings for other common operations
|
---|
| 42 | which increase efficiency of Grobner basis calculations are also
|
---|
| 43 | included. They are as follows:
|
---|
| 44 | GCD - greatest common divisor;
|
---|
| 45 | LCM - least common multiple;
|
---|
| 46 | ZEROP - test whether an element is zero;
|
---|
| 47 | SIGNUM - the sign of a ring element (+1, -1 or zero);
|
---|
| 48 | UNIT - the unit of the ring;
|
---|
| 49 | NUMERATOR - the numerator, if a ring of fractions
|
---|
| 50 | DENOMINATOR - the denominator, if a ring of fractions
|
---|
| 51 | LENGTH - an integer giving the approximate length
|
---|
| 52 | of the representation; for example, for integers
|
---|
| 53 | its default binding is #'integer-length;
|
---|
| 54 | "
|
---|
| 55 | + - * / gcd lcm zerop unit length signum numerator denominator)
|
---|
| 56 |
|
---|
| 57 | (defvar *ring-of-integers*
|
---|
| 58 | (make-ring :+ #'+
|
---|
| 59 | :- #'-
|
---|
| 60 | :* #'*
|
---|
| 61 | :/ #'floor
|
---|
| 62 | :gcd #'gcd
|
---|
| 63 | :lcm #'lcm
|
---|
| 64 | :zerop #'zerop
|
---|
| 65 | :signum #'signum
|
---|
| 66 | :unit 1
|
---|
| 67 | :length #'integer-length
|
---|
| 68 | :numerator #'numerator
|
---|
| 69 | :denominator #'denominator)
|
---|
| 70 | "Operations in the ring of integers.")
|
---|
| 71 |
|
---|
| 72 | (defvar *field-of-rationals*
|
---|
| 73 | (make-ring
|
---|
| 74 | :+ #'+
|
---|
| 75 | :- #'-
|
---|
| 76 | :* #'*
|
---|
| 77 | :/ #'/
|
---|
| 78 | :gcd #'(lambda (&rest r) (declare (ignore r)) 1)
|
---|
| 79 | :lcm #'(lambda (&rest r) (apply #'* r))
|
---|
| 80 | :zerop #'zerop
|
---|
| 81 | :signum #'signum
|
---|
| 82 | :unit 1
|
---|
| 83 | :length #'(lambda (x) (+ (integer-length (numerator x))
|
---|
| 84 | (integer-length (denominator x))))
|
---|
| 85 | :numerator #'numerator
|
---|
| 86 | :denominator #'denominator)
|
---|
| 87 | "Operations on the field of rational numbers.")
|
---|
| 88 |
|
---|
| 89 | (defun field-modulo-prime (modulus)
|
---|
| 90 | "Return a RING structure with operations bound
|
---|
| 91 | to the arithmetical operations modulo MODULUS, which
|
---|
| 92 | should be a prime."
|
---|
| 93 | (make-ring
|
---|
| 94 | :+ #'(lambda (&rest r) (mod (apply #'+ r) modulus))
|
---|
| 95 | :- #'(lambda (&rest r) (mod (apply #'- r) modulus))
|
---|
| 96 | :* #'(lambda (&rest r) (mod (apply #'* r) modulus))
|
---|
| 97 | :/ (make-modular-division modulus)
|
---|
| 98 | :gcd #'(lambda (&rest r) (declare (ignore r)) 1)
|
---|
| 99 | :lcm #'(lambda (&rest r) (mod (apply #'* r) modulus))
|
---|
| 100 | :zerop #'zerop
|
---|
| 101 | :signum #'(lambda (x) (if (zerop x) 0 1))
|
---|
| 102 | :unit 1
|
---|
| 103 | :length #'(lambda (x) (declare (ignore x)) 1)
|
---|
| 104 | :numerator #'identity
|
---|
| 105 | :denominator #'(lambda (x) (declare (ignore x)) 1)))
|
---|
| 106 |
|
---|
| 107 |
|
---|
| 108 | (defvar *coefficient-ring* *ring-of-integers*
|
---|
| 109 | "The default RING structure, used in most operations
|
---|
| 110 | on the coefficients of polynomials. It should be carefully
|
---|
| 111 | set if rings other than the default ring is used.")
|
---|
| 112 |
|
---|