| 1 | head    1.4; | 
|---|
| 2 | access; | 
|---|
| 3 | symbols; | 
|---|
| 4 | locks; strict; | 
|---|
| 5 | comment @;;; @; | 
|---|
| 6 |  | 
|---|
| 7 |  | 
|---|
| 8 | 1.4 | 
|---|
| 9 | date    2009.01.22.03.59.21;    author marek;   state Exp; | 
|---|
| 10 | branches; | 
|---|
| 11 | next    1.3; | 
|---|
| 12 |  | 
|---|
| 13 | 1.3 | 
|---|
| 14 | date    2009.01.19.09.24.20;    author marek;   state Exp; | 
|---|
| 15 | branches; | 
|---|
| 16 | next    1.2; | 
|---|
| 17 |  | 
|---|
| 18 | 1.2 | 
|---|
| 19 | date    2009.01.19.07.40.03;    author marek;   state Exp; | 
|---|
| 20 | branches; | 
|---|
| 21 | next    1.1; | 
|---|
| 22 |  | 
|---|
| 23 | 1.1 | 
|---|
| 24 | date    2009.01.19.06.48.00;    author marek;   state Exp; | 
|---|
| 25 | branches; | 
|---|
| 26 | next    ; | 
|---|
| 27 |  | 
|---|
| 28 |  | 
|---|
| 29 | desc | 
|---|
| 30 | @@ | 
|---|
| 31 |  | 
|---|
| 32 |  | 
|---|
| 33 | 1.4 | 
|---|
| 34 | log | 
|---|
| 35 | @*** empty log message *** | 
|---|
| 36 | @ | 
|---|
| 37 | text | 
|---|
| 38 | @;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: Grobner; Base: 10 -*- | 
|---|
| 39 | #| | 
|---|
| 40 | $Id$ | 
|---|
| 41 | *--------------------------------------------------------------------------* | 
|---|
| 42 | |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@@math.arizona.edu)    | | 
|---|
| 43 | |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    | | 
|---|
| 44 | |                                                                          | | 
|---|
| 45 | | Everyone is permitted to copy, distribute and modify the code in this    | | 
|---|
| 46 | | directory, as long as this copyright note is preserved verbatim.         | | 
|---|
| 47 | *--------------------------------------------------------------------------* | 
|---|
| 48 | |# | 
|---|
| 49 |  | 
|---|
| 50 | (defpackage "COEFFICIENT-RING" | 
|---|
| 51 | (:export ring | 
|---|
| 52 | ring-+ | 
|---|
| 53 | ring-- | 
|---|
| 54 | ring-* | 
|---|
| 55 | ring-/ | 
|---|
| 56 | ring-gcd | 
|---|
| 57 | ring-lcm | 
|---|
| 58 | ring-signum | 
|---|
| 59 | ring-zerop | 
|---|
| 60 | ring-unit | 
|---|
| 61 | ring-length | 
|---|
| 62 | ring-numerator | 
|---|
| 63 | ring-denominator | 
|---|
| 64 | make-ring | 
|---|
| 65 | *coefficient-ring* | 
|---|
| 66 | *ring-of-integers* | 
|---|
| 67 | *field-of-rationals* | 
|---|
| 68 | field-modulo-prime | 
|---|
| 69 | ) | 
|---|
| 70 | (:use "MODULAR" "COMMON-LISP")) | 
|---|
| 71 |  | 
|---|
| 72 | (in-package "COEFFICIENT-RING") | 
|---|
| 73 |  | 
|---|
| 74 | #+debug(proclaim '(optimize (speed 0) (debug 3))) | 
|---|
| 75 | #-debug(proclaim '(optimize (speed 3) (debug 0))) | 
|---|
| 76 |  | 
|---|
| 77 | (defstruct ring | 
|---|
| 78 | "The structure whose slots are bound to functions | 
|---|
| 79 | performing usual ring operations. In addition to usual arithmetical | 
|---|
| 80 | operations, bindings for other common operations | 
|---|
| 81 | which increase efficiency of Grobner basis calculations are also | 
|---|
| 82 | included. They are as follows: | 
|---|
| 83 | GCD     - greatest common divisor; | 
|---|
| 84 | LCM     - least common multiple; | 
|---|
| 85 | ZEROP   - test whether an element is zero; | 
|---|
| 86 | SIGNUM  - the sign of a ring element (+1, -1 or zero); | 
|---|
| 87 | UNIT    - the unit of the ring; | 
|---|
| 88 | NUMERATOR - the numerator, if a ring of fractions | 
|---|
| 89 | DENOMINATOR - the denominator, if a ring of fractions | 
|---|
| 90 | LENGTH  - an integer giving the approximate length | 
|---|
| 91 | of the representation; for example, for integers | 
|---|
| 92 | its default binding is #'integer-length; | 
|---|
| 93 | " | 
|---|
| 94 | + - * / gcd lcm zerop unit length signum numerator denominator) | 
|---|
| 95 |  | 
|---|
| 96 | (defvar *ring-of-integers* | 
|---|
| 97 | (make-ring :+ #'+ | 
|---|
| 98 | :- #'- | 
|---|
| 99 | :* #'* | 
|---|
| 100 | :/ #'floor | 
|---|
| 101 | :gcd #'gcd | 
|---|
| 102 | :lcm #'lcm | 
|---|
| 103 | :zerop #'zerop | 
|---|
| 104 | :signum #'signum | 
|---|
| 105 | :unit 1 | 
|---|
| 106 | :length #'integer-length | 
|---|
| 107 | :numerator #'numerator | 
|---|
| 108 | :denominator #'denominator) | 
|---|
| 109 | "Operations in the ring of integers.") | 
|---|
| 110 |  | 
|---|
| 111 | (defvar *field-of-rationals* | 
|---|
| 112 | (make-ring | 
|---|
| 113 | :+ #'+ | 
|---|
| 114 | :- #'- | 
|---|
| 115 | :* #'* | 
|---|
| 116 | :/ #'/ | 
|---|
| 117 | :gcd #'(lambda (&rest r) (declare (ignore r)) 1) | 
|---|
| 118 | :lcm #'(lambda (&rest r) (apply #'* r)) | 
|---|
| 119 | :zerop #'zerop | 
|---|
| 120 | :signum #'signum | 
|---|
| 121 | :unit 1 | 
|---|
| 122 | :length #'(lambda (x) (+ (integer-length (numerator x)) | 
|---|
| 123 | (integer-length (denominator x)))) | 
|---|
| 124 | :numerator #'numerator | 
|---|
| 125 | :denominator #'denominator) | 
|---|
| 126 | "Operations on the field of rational numbers.") | 
|---|
| 127 |  | 
|---|
| 128 | (defun field-modulo-prime (modulus) | 
|---|
| 129 | "Return a RING structure with operations bound | 
|---|
| 130 | to the arithmetical operations modulo MODULUS, which | 
|---|
| 131 | should be a prime." | 
|---|
| 132 | (make-ring | 
|---|
| 133 | :+ #'(lambda (&rest r) (mod (apply #'+ r) modulus)) | 
|---|
| 134 | :- #'(lambda (&rest r) (mod (apply #'- r) modulus)) | 
|---|
| 135 | :* #'(lambda (&rest r) (mod (apply #'* r) modulus)) | 
|---|
| 136 | :/ (make-modular-division modulus) | 
|---|
| 137 | :gcd #'(lambda (&rest r) (declare (ignore r)) 1) | 
|---|
| 138 | :lcm #'(lambda (&rest r) (mod (apply #'* r) modulus)) | 
|---|
| 139 | :zerop #'zerop | 
|---|
| 140 | :signum #'(lambda (x) (if (zerop x) 0 1)) | 
|---|
| 141 | :unit 1 | 
|---|
| 142 | :length #'(lambda (x) (declare (ignore x)) 1) | 
|---|
| 143 | :numerator #'identity | 
|---|
| 144 | :denominator #'(lambda (x) (declare (ignore x)) 1))) | 
|---|
| 145 |  | 
|---|
| 146 |  | 
|---|
| 147 | (defvar *coefficient-ring* *ring-of-integers* | 
|---|
| 148 | "The default RING structure, used in most operations | 
|---|
| 149 | on the coefficients of polynomials. It should be carefully | 
|---|
| 150 | set if rings other than the default ring is used.") | 
|---|
| 151 |  | 
|---|
| 152 | @ | 
|---|
| 153 |  | 
|---|
| 154 |  | 
|---|
| 155 | 1.3 | 
|---|
| 156 | log | 
|---|
| 157 | @*** empty log message *** | 
|---|
| 158 | @ | 
|---|
| 159 | text | 
|---|
| 160 | @d37 2 | 
|---|
| 161 | a38 2 | 
|---|
| 162 | ;;(proclaim '(optimize (speed 0) (debug 3))) | 
|---|
| 163 | (proclaim '(optimize (speed 3) (debug 0))) | 
|---|
| 164 | @ | 
|---|
| 165 |  | 
|---|
| 166 |  | 
|---|
| 167 | 1.2 | 
|---|
| 168 | log | 
|---|
| 169 | @*** empty log message *** | 
|---|
| 170 | @ | 
|---|
| 171 | text | 
|---|
| 172 | @d37 2 | 
|---|
| 173 | a38 1 | 
|---|
| 174 | (proclaim '(optimize (speed 0) (debug 3))) | 
|---|
| 175 | @ | 
|---|
| 176 |  | 
|---|
| 177 |  | 
|---|
| 178 | 1.1 | 
|---|
| 179 | log | 
|---|
| 180 | @Initial revision | 
|---|
| 181 | @ | 
|---|
| 182 | text | 
|---|
| 183 | @d3 1 | 
|---|
| 184 | a3 1 | 
|---|
| 185 | $Id: coefficient-ring.lisp,v 1.24 1997/12/13 15:56:19 marek Exp $ | 
|---|
| 186 | d37 2 | 
|---|
| 187 | @ | 
|---|