Changeset 3441
- Timestamp:
- 2015-09-05T08:59:06-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/monom.lisp
r3417 r3441 102 102 (error "Initarg DIMENSION or EXPONENTS must be supplied.")))) 103 103 104 (defm acromonom-dimension (m)105 `(length (monom-exponents ,m)))106 107 (defmethod r-equalp ((m1 monom) (m2 monom))104 (defmethod monom-dimension (m) 105 (length (monom-exponents ,m))) 106 107 (defmethod monom-equalp (m1 m2) 108 108 "Returns T iff monomials M1 and M2 have identical 109 109 EXPONENTS." 110 (equalp (monom-exponents m1) (monom-exponents m2))) 111 112 (defmethod r-coeff ((m monom)) 113 "A MONOM can be treated as a special case of TERM, 114 where the coefficient is 1." 115 1) 116 117 (defmethod r-elt ((m monom) index) 110 `(equalp (monom-exponents ,m1) (monom-exponents ,m2))) 111 112 (defmethod monom-elt (m index) 118 113 "Return the power in the monomial M of variable number INDEX." 119 114 (with-slots (exponents) … … 121 116 (elt exponents index))) 122 117 123 (defmethod (setf r-elt) (new-value (m monom)index)118 (defmethod (setf monom-elt) (new-value m index) 124 119 "Return the power in the monomial M of variable number INDEX." 125 120 (with-slots (exponents) … … 127 122 (setf (elt exponents index) new-value))) 128 123 129 (defmethod r-total-degree ((m monom)&optional (start 0) (end (monom-dimension m)))124 (defmethod monom-total-degree (m &optional (start 0) (end (monom-dimension m))) 130 125 "Return the todal degree of a monomoal M. Optinally, a range 131 126 of variables may be specified with arguments START and END." … … 136 131 137 132 138 (defmethod r-sugar ((m monom)&aux (start 0) (end (monom-dimension m)))133 (defmethod monom-sugar (m &aux (start 0) (end (monom-dimension m))) 139 134 "Return the sugar of a monomial M. Optinally, a range 140 135 of variables may be specified with arguments START and END." 141 136 (declare (type fixnum start end)) 142 (r-total-degree m start end))137 (monom-total-degree m start end)) 143 138 144 139 (defmethod multiply-by ((self monom) (other monom)) … … 173 168 copy)) 174 169 175 (defmethod r* ((m1 monom) (m2 monom))170 (defmethod monom* ((m1 monom) (m2 monom)) 176 171 "Non-destructively multiply monomial M1 by M2." 177 172 (multiply-by (copy-instance m1) (copy-instance m2))) 178 173 179 (defmethod r/((numerator monom) &rest denominators)174 (defmethod monom* ((numerator monom) &rest denominators) 180 175 "Non-destructively divide monomial NUMERATOR by product of DENOMINATORS." 181 (divide-by (copy-instance numerator) (reduce #'r* denominators))) 182 183 (defmethod r-divides-p ((m1 monom) (m2 monom)) 176 (divide-by (copy-instance numerator) (reduce #' 177 monom* denominators))) 178 179 (defmethod monom-divides-p ((m1 monom) (m2 monom)) 184 180 "Returns T if monomial M1 divides monomial M2, NIL otherwise." 185 181 (with-slots ((exponents1 exponents)) … … 190 186 191 187 192 (defmethod r-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))188 (defmethod monom-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom)) 193 189 "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise." 194 190 (every #'(lambda (x y z) (<= x (max y z))) … … 196 192 197 193 198 (defmethod r-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))194 (defmethod monom-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom)) 199 195 "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise." 200 196 (declare (type monom m1 m2 m3 m4)) … … 202 198 m1 m2 m3 m4)) 203 199 204 (defmethod r-lcm-equal-lcm-p (m1 m2 m3 m4)200 (defmethod monom-lcm-equal-lcm-p (m1 m2 m3 m4) 205 201 "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise." 206 202 (with-slots ((exponents1 exponents)) … … 216 212 exponents1 exponents2 exponents3 exponents4)))))) 217 213 218 (defmethod r-divisible-by-p ((m1 monom) (m2 monom))214 (defmethod monom-divisible-by-p ((m1 monom) (m2 monom)) 219 215 "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise." 220 216 (with-slots ((exponents1 exponents)) … … 224 220 (every #'>= exponents1 exponents2)))) 225 221 226 (defmethod r-rel-prime-p ((m1 monom) (m2 monom))222 (defmethod monom-rel-prime-p ((m1 monom) (m2 monom)) 227 223 "Returns T if two monomials M1 and M2 are relatively prime (disjoint)." 228 224 (with-slots ((exponents1 exponents)) … … 233 229 234 230 235 (defmethod r-lcm ((m1 monom) (m2 monom))231 (defmethod monom-lcm ((m1 monom) (m2 monom)) 236 232 "Returns least common multiple of monomials M1 and M2." 237 233 (with-slots ((exponents1 exponents)) … … 244 240 245 241 246 (defmethod r-gcd ((m1 monom) (m2 monom))242 (defmethod monom-gcd ((m1 monom) (m2 monom)) 247 243 "Returns greatest common divisor of monomials M1 and M2." 248 244 (with-slots ((exponents1 exponents)) … … 254 250 (make-instance 'monom :exponents exponents))))) 255 251 256 (defmethod r-depends-p ((m monom) k)252 (defmethod monom-depends-p ((m monom) k) 257 253 "Return T if the monomial M depends on variable number K." 258 254 (declare (type fixnum k)) … … 261 257 (plusp (elt exponents k)))) 262 258 263 (defmethod left-tensor-product-by ((self monom) (other monom))259 (defmethod monom-left-tensor-product-by ((self monom) (other monom)) 264 260 (with-slots ((exponents1 exponents)) 265 261 self … … 269 265 self) 270 266 271 (defmethod right-tensor-product-by ((self monom) (other monom))267 (defmethod monom-right-tensor-product-by ((self monom) (other monom)) 272 268 (with-slots ((exponents1 exponents)) 273 269 self … … 277 273 self) 278 274 279 (defmethod left-contract ((self monom) k)275 (defmethod monom-left-contract ((self monom) k) 280 276 "Drop the first K variables in monomial M." 281 277 (declare (fixnum k)) … … 298 294 m)) 299 295 300 (defmethod r->list ((m monom))296 (defmethod monom->list ((m monom)) 301 297 "A human-readable representation of a monomial M as a list of exponents." 302 298 (coerce (monom-exponents m) 'list)) 303 304 (defmethod r-dimension ((self monom))305 (monom-dimension self))306 307 (defmethod r-exponents ((self monom))308 (monom-exponents self))
Note:
See TracChangeset
for help on using the changeset viewer.