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 | @
|
---|