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