Changeset 868 for branches/f4grobner
- Timestamp:
- 2015-06-09T11:46:13-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/monomial.lisp
r866 r868 174 174 (defun monom-rel-prime-p (m1 m2) 175 175 "Returns T if two monomials M1 and M2 are relatively prime (disjoint)." 176 (declare (type monom m1 m2)) 177 (every #'(lambda (x y) (declare (type exponent x y)) (zerop (min x y))) 178 (monom-exponents m1) 179 (monom-exponents m2))) 176 (every #'(lambda (x y) (declare (type exponent x y)) (zerop (min x y))) m1 m2)) 180 177 181 178 (defun monom-equal-p (m1 m2) 182 179 "Returns T if two monomials M1 and M2 are equal." 183 (declare (type monom m1 m2))184 180 (every #'= (monom-exponents m1) (monom-exponents m2))) 185 181 186 (defun monom-lcm (m1 m2 &aux (result (copy-s tructure m1)))182 (defun monom-lcm (m1 m2 &aux (result (copy-sequence m1))) 187 183 "Returns least common multiple of monomials M1 and M2." 188 (declare (type monom m1 m2)) 189 (map-into (monom-exponents result) #'max 190 (monom-exponents m1) 191 (monom-exponents m2)) 192 result) 193 194 (defun monom-gcd (m1 m2 &aux (result (copy-structure m1))) 184 (map-into result #'max m1 m2)) 185 186 (defun monom-gcd (m1 m2 &aux (result (copy-sequence m1))) 195 187 "Returns greatest common divisor of monomials M1 and M2." 196 (declare (type monom m1 m2)) 197 (map-into (monom-exponents result) #'min (monom-exponents m1) (monom-exponents m2)) 198 result) 188 (map-into result #'min m1 m2)) 199 189 200 190 (defun monom-depends-p (m k) 201 191 "Return T if the monomial M depends on variable number K." 202 (declare (type monom m) (fixnum k))203 192 (plusp (monom-elt m k))) 204 193 205 (defmacro monom-map (fun m &rest ml &aux (result `(copy-s tructure ,m)))206 `(map-into (monom-exponents ,result) ,fun (monom-exponents ,m),@ml))194 (defmacro monom-map (fun m &rest ml &aux (result `(copy-sequence ,m))) 195 `(map-into ,result ,fun ,m ,@ml)) 207 196 208 197 (defmacro monom-append (m1 m2) 209 `( make-monom :exponents (concatenate 'vector (monom-exponents ,m1) (monom-exponents ,m2))))198 `(concatenate 'vector ,m1 ,m2)) 210 199 211 200 (defmacro monom-contract (k m) 212 `(setf (monom-exponents ,m) (subseq (monom-exponents ,m),k)))201 `(setf ,m (subseq ,m ,k)))
Note:
See TracChangeset
for help on using the changeset viewer.