;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik ;;; ;;; 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. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;---------------------------------------------------------------- ;; This package implements BASIC OPERATIONS ON MONOMIALS ;;---------------------------------------------------------------- ;; DATA STRUCTURES: Conceptually, monomials can be represented as lists: ;; ;; monom: (n1 n2 ... nk) where ni are non-negative integers ;; ;; However, lists may be implemented as other sequence types, ;; so the flexibility to change the representation should be ;; maintained in the code to use general operations on sequences ;; whenever possible. The optimization for the actual representation ;; should be left to declarations and the compiler. ;;---------------------------------------------------------------- ;; EXAMPLES: Suppose that variables are x and y. Then ;; ;; Monom x*y^2 ---> (1 2) ;; ;;---------------------------------------------------------------- (defpackage "MONOM" (:use :cl :ring) (:export "MONOM" "EXPONENT" "MAKE-MONOM" "MAKE-MONOM-VARIABLE" "MONOM-ELT" "MONOM-DIMENSION" "MONOM-TOTAL-DEGREE" "MONOM-SUGAR" "MONOM-DIV" "MONOM-MUL" "MONOM-DIVIDES-P" "MONOM-DIVIDES-MONOM-LCM-P" "MONOM-LCM-DIVIDES-MONOM-LCM-P" "MONOM-LCM-EQUAL-MONOM-LCM-P" "MONOM-DIVISIBLE-BY-P" "MONOM-REL-PRIME-P" "MONOM-EQUAL-P" "MONOM-LCM" "MONOM-GCD" "MONOM-DEPENDS-P" "MONOM-MAP" "MONOM-APPEND" "MONOM-CONTRACT" "MONOM->LIST")) (in-package :monom) (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0))) (deftype exponent () "Type of exponent in a monomial." 'fixnum) (defclass monom () ((dim :initarg :dim ) (exponents :initarg :exponents)) (:default-initargs :dim 0 :exponents nil)) (defmethod print-object ((m monom) stream) (princ (slot-value m 'exponents) stream)) ;; If a monomial is redefined as structure with slot EXPONENTS, the function ;; below can be the BOA constructor. (defun make-monom (&key (dimension nil dimension-suppied-p) (initial-exponents nil initial-exponents-supplied-p) (initial-exponent nil initial-exponent-supplied-p) &aux (dim (cond (dimension-suppied-p dimension) (initial-exponents-supplied-p (length initial-exponents)) (t (error "You must provide DIMENSION or INITIAL-EXPONENTS")))) (exponents (cond ;; when exponents are supplied (initial-exponents-supplied-p (make-array (list dim) :initial-contents initial-exponents :element-type 'exponent)) ;; when all exponents are to be identical (initial-exponent-supplied-p (make-array (list dim) :initial-element initial-exponent :element-type 'exponent)) ;; otherwise, all exponents are zero (t (make-array (list dim) :element-type 'exponent :initial-element 0))))) "A constructor (factory) of monomials. If DIMENSION is given, a sequence of DIMENSION elements of type EXPONENT is constructed, where individual elements are the value of INITIAL-EXPONENT, which defaults to 0. Alternatively, all elements may be specified as a list INITIAL-EXPONENTS." (make-instance 'monom :dim dim :exponents exponents)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Operations on monomials ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod dimension ((m monom)) (slot-value m 'dim)) (defmethod ring-elt ((m monom) index) "Return the power in the monomial M of variable number INDEX." (with-slots (exponents) m (elt exponents index))) (defmethod (setf ring-elt) (new-value (m monom) index) "Return the power in the monomial M of variable number INDEX." (with-slots (exponents) m (setf (elt exponents index) new-value))) (defmethod total-degree ((m monom) &optional (start 0) (end (dimension m))) "Return the todal degree of a monomoal M. Optinally, a range of variables may be specified with arguments START and END." (declare (type fixnum start end)) (with-slots (exponents) m (reduce #'cl:+ exponents :start start :end end))) (defmethod sugar ((m monom) &aux (start 0) (end (dimension m))) "Return the sugar of a monomial M. Optinally, a range of variables may be specified with arguments START and END." (declare (type fixnum start end)) (with-slots (exponents) m (total-degree exponents start end))) (defmethod + ((m1 monom) (m2 monom)) "Multiply monomial M1 by monomial M2." (with-slots ((exponents1 exponents)) m1 (with-slots ((exponents2 exponents)) m2 (let* ((exponents (copy-seq exponents1)) (dim (reduce #'cl:+ exponents))) (map-into exponents #'cl:+ exponents1 exponents2) (make-instance 'monom :dim dim :exponents exponents))))) (defmethod / ((m1 monom) (m2 monom)) "Divide monomial M1 by monomial M2." (with-slots ((exponents1 exponents)) m1 (with-slots ((exponents2 exponents)) m2 (let* ((exponents (copy-seq exponents1)) (dim (reduce #'cl:+ exponents))) (map-into exponents #'cl:- exponents1 exponents2) (make-instance 'monom :dim dim :exponents exponents))))) (defmethod divides-p ((m1 monom) (m2 monom)) "Returns T if monomial M1 divides monomial M2, NIL otherwise." (with-slots ((exponents1 exponents)) m1 (with-slots ((exponents2 exponents)) m2 (every #'<= exponents1 exponents2)))) (defmethod divides-lcm-p ((m1 monom) (m2 monom) (m3 monom)) "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise." (every #'(lambda (x y z) (<= x (max y z))) m1 m2 m3)) (defmethod lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom)) "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise." (declare (type monom m1 m2 m3 m4)) (every #'(lambda (x y z w) (<= (max x y) (max z w))) m1 m2 m3 m4)) (defmethod lcm-equal-lcm-p (m1 m2 m3 m4) "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise." (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (with-slots (exponents3 exponents) m3 (with-slots (exponents4 exponents) m4 (every #'(lambda (x y z w) (= (max x y) (max z w))) exponents1 exponents2 exponents3 exponents4)))))) (defmethod divisible-by-p ((m1 monom) (m2 monom)) "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise." (every #'>= m1 m2)) (defmethod rel-prime-p ((m1 monom) (m2 monom)) "Returns T if two monomials M1 and M2 are relatively prime (disjoint)." (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (every #'(lambda (x y) (cl:zerop (min x y))) exponents1 exponents2)))) (defmethod equal-p ((m1 monom) (m2 monom)) "Returns T if two monomials M1 and M2 are equal." (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (every #'= exponents1 exponents2)))) (defmethod lcm ((m1 monom) (m2 monom)) "Returns least common multiple of monomials M1 and M2." (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (let* ((exponents (copy-seq exponents1)) (dim (reduce #'cl:+ exponents))) (map-into exponents #'max exponents1 exponents2) (make-instance 'monom :dim dim :exponents exponents))))) (defmethod gcd ((m1 monom) (m2 monom)) "Returns greatest common divisor of monomials M1 and M2." (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (let* ((exponents (copy-seq exponents1)) (dim (reduce #'cl:+ exponents))) (map-into exponents #'min exponents1 exponents2) (make-instance 'monom :dim dim :exponents exponents))))) (defmethod depends-p ((m monom) k) "Return T if the monomial M depends on variable number K." (declare (type fixnum k)) (with-slots (exponents) m (plusp (elt exponents k)))) (defmethod ring-tensor-mul ((m1 monom) (m2 monom) &aux (dim (cl:+ (dimension m1) (dimension m2)))) (declare (fixnum dim)) (with-slots (exponents1 exponents) m1 (with-slots (exponents2 exponents) m2 (make-instance 'monom :dim dim :exponents (concatenate 'vector exponents1 exponents2))))) (defmethod contract ((m monom) k) "Drop the first K variables in monomial M." (declare (fixnum k)) (with-slots (dim exponents) m (setf dim (- dim k) exponents (subseq exponents k)))) (defun make-monom-variable (nvars pos &optional (power 1) &aux (m (make-monom :dimension nvars))) "Construct a monomial in the polynomial ring RING[X[0],X[1],X[2],...X[NVARS-1]] over the (unspecified) ring RING which represents a single variable. It assumes number of variables NVARS and the variable is at position POS. Optionally, the variable may appear raised to power POWER. " (declare (type fixnum nvars pos power) (type monom m)) (with-slots (exponents) m (setf (elt exponents pos) power) m)) (defmethod monom->list ((m monom)) "A human-readable representation of a monomial M as a list of exponents." (with-slots (exponents) m (coerce exponents 'list)))