;;; -*- 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" "MONOM-DIMENSION" "MONOM-EXPONENTS" "MAKE-MONOM-VARIABLE")) (in-package :monom) (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0))) (deftype exponent () "Type of exponent in a monomial." 'fixnum) (defclass monom () ((dimension :initarg :dimension :accessor monom-dimension) (exponents :initarg :exponents :accessor monom-exponents)) (:default-initargs :dimension 0 :exponents nil)) (defmethod print-object ((m monom) stream) (princ (slot-value m 'exponents) stream)) (defmethod initialize-instance :after ((self monom) &rest args &key) (format t "INITIALIZE-INSTANCE-INSTANCE called with SELF ~A, args ~A.~%" self args) (call-next-method)) (defmethod make-instance :around ((self monom) &key (dimension nil dimension-suppied-p) (exponents nil exponents-supplied-p) (exponent nil exponent-supplied-p)) "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 EXPONENT, which defaults to 0. Alternatively, all elements may be specified as a list EXPONENTS." (format t "MAKE-INSTANCE called with DIMENSION ~A(~A), EXPONENTS ~A(~A), EXPONENT ~A(~A).~%" dimension dimension-suppied-p exponents exponents-supplied-p exponent exponent-supplied-p) #| (let ((new-dimension (cond (dimension-suppied-p dimension) (exponents-supplied-p (length exponents)) (t (error "You must provide DIMENSION or EXPONENTS")))) (new-exponents (cond ;; when exponents are supplied (exponents-supplied-p (make-array (list dimension) :initial-contents exponents :element-type 'exponent)) ;; when all exponents are to be identical (exponent-supplied-p (make-array (list dimension) :initial-element exponent :element-type 'exponent)) ;; otherwise, all exponents are zero (t (make-array (list dimension) :element-type 'exponent :initial-element 0))))) |# (call-next-method :dimension dimension :exponents exponents)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Operations on monomials ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod r-dimension ((m monom)) (monom-dimension m)) (defmethod r-elt ((m monom) index) "Return the power in the monomial M of variable number INDEX." (with-slots (exponents) m (elt exponents index))) (defmethod (setf r-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 r-total-degree ((m monom) &optional (start 0) (end (r-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 #'+ exponents :start start :end end))) (defmethod r-sugar ((m monom) &aux (start 0) (end (r-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)) (r-total-degree m start end)) (defmethod r* ((m1 monom) (m2 monom)) "Multiply monomial M1 by monomial M2." (with-slots ((exponents1 exponents) dimension) m1 (with-slots ((exponents2 exponents)) m2 (let* ((exponents (copy-seq exponents1))) (map-into exponents #'+ exponents1 exponents2) (make-instance 'monom :dimension dimension :exponents exponents))))) (defmethod r/ ((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)) (dimension (reduce #'+ exponents))) (map-into exponents #'- exponents1 exponents2) (make-instance 'monom :dimension dimension :exponents exponents))))) (defmethod r-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 r-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 r-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 r-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 r-divisible-by-p ((m1 monom) (m2 monom)) "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise." (with-slots ((exponents1 exponents)) m1 (with-slots ((exponents2 exponents)) m2 (every #'>= exponents1 exponents2)))) (defmethod r-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) (zerop (min x y))) exponents1 exponents2)))) (defmethod r-equalp ((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 r-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)) (dimension (reduce #'+ exponents))) (map-into exponents #'max exponents1 exponents2) (make-instance 'monom :dimension dimension :exponents exponents))))) (defmethod r-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)) (dimension (reduce #'+ exponents))) (map-into exponents #'min exponents1 exponents2) (make-instance 'monom :dimension dimension :exponents exponents))))) (defmethod r-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 r-tensor-product ((m1 monom) (m2 monom) &aux (dimension (+ (r-dimension m1) (r-dimension m2)))) (declare (fixnum dimension)) (with-slots ((exponents1 exponents)) m1 (with-slots ((exponents2 exponents)) m2 (make-instance 'monom :dimension dimension :exponents (concatenate 'vector exponents1 exponents2))))) (defmethod r-contract ((m monom) k) "Drop the first K variables in monomial M." (declare (fixnum k)) (with-slots (dimension exponents) m (setf dimension (- dimension k) exponents (subseq exponents k)))) (defun make-monom-variable (nvars pos &optional (power 1) &aux (m (make-instance '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 r->list ((m monom)) "A human-readable representation of a monomial M as a list of exponents." (coerce (monom-exponents m) 'list))