Those are a lot of libraries to check. Looking superficially none seem to have what i want.
I made a vector package. It satisfies most of my requirements. It even makes matrices as extensions of macros (inpr being matrix multiplication.) I tried to make the addition/substraction work 'in one go' rather then one by one. I mean doing (+ a b c) as such instead of (+ a (+ b c)) ) but unfortunately that made the method system go crazy, taking ages to load and such, only other way to fix it i see violates my first demand.
Code below is 318 lines total.
vect.lisp Package, basic definitions.
Code: Select all
(defpackage #:vect
(:use #:common-lisp #:iterate)
(:export mk-vect define-vect u v w x y z
v+ v- v* v/ inpr crosspr lensqr len distsqr dist
v-angle angle-v2 angle-v3
vect-as-list)
(:documentation "Vectors/matrices with numbers in them."))
(in-package #:vect)
(defgeneric r* (a b)
(:documentation "Multiplies two numbers. v* is the macro that users use.\
There is no r/ it is done via r*."))
(defgeneric r+2 (a b)
(:documentation "Adds two numbers. v+ is the macro that users use. It
leads to r+n methods."))
(defgeneric r-2 (a b)
(:documentation "subtracts two numbers. v+ is the macro that users use.\
It leads to r+n methods."))
(defgeneric r+3 (a b c) (:documentation "See r+2"))
(defgeneric r+4 (a b c d) (:documentation "See r+2"))
(defgeneric r+5 (a b c d e) (:documentation "See r+2"))
(defgeneric r+6 (a b c d e f) (:documentation "See r+2"))
(defgeneric r-3 (a b c) (:documentation "See r+2"))
(defgeneric r-4 (a b c d) (:documentation "See r+2"))
(defgeneric r-5 (a b c d e) (:documentation "See r+2"))
(defgeneric r-6 (a b c d e f) (:documentation "See r+2"))
(defgeneric mk-vect2 (x y)
(:documentation "Makes two-dimensional vector, with type inferred from\
arguments."))
(defgeneric mk-vect3 (x y z)
(:documentation "Makes three-dimensional vector, with type inferred from\
arguments."))
(defgeneric mk-vect4 (w x y z) (:documentation "See mk-vect2"))
(defgeneric mk-vect5 (v w x y z) (:documentation "See mk-vect2"))
(defgeneric mk-vect6 (u v w x y z) (:documentation "See mk-vect2"))
(defun vect-maker-name (n)
(case n (2 'mk-vect2) (3 'mk-vect3) (4 'mk-vect4)
(5 'mk-vect5) (6 'mk-vect6)))
(defmacro mk-vect (&rest args)
`(,(vect-maker-name (length args)) ,@args))
(defmacro v* (vect &rest factors)
"Multiplies vect with factors."
(if (null factors) vect
`(r* ,vect (v* ,@factors))))
(defmacro v/ (vect &rest dividers)
"Divides vect with dividers."
(if (null dividers) vect
`(r* ,vect (/ (v* ,@dividers)))))
(defmacro v+ (&rest add)
"Addition macro. Chooses from the r+n functions, chains them if more then\
6."
(case (length add)
(1 (car add)) (2 `(r+2 ,@add)); (3 `(r+3 ,@add))
; (4 `(r+4 ,@add)) (5 `(r+5 ,@add)) (6 `(r+6 ,@add))
(t `(v+ (v+2 ,@(subseq add 0 2)) ,@(subseq add 2)))))
(defmacro v- (&rest add)
"Substraction macro. Chooses from the r-n functions, chains them if\
more then 6."
(case (length add)
(1 (car add)) (2 `(r-2 ,@add)); (3 `(r-3 ,@add))
(t `(v- (v-2 ,@(subseq add 0 2)) ,@(subseq add 2)))))
; (4 `(r-4 ,@add)) (5 `(r-5 ,@add)) (6 `(r-6 ,@add))
; (t `(v- (v-6 ,@(subseq add 0 6)) ,@(subseq add 6)))))
(defgeneric r-inpr (a b) (:documentation "Inproduct between two things.
Used through inpr macro."))
(defgeneric crosspr (a b) (:documentation "Cross product between two\
things."))
(defmacro inpr (&rest args)
"Inproduct between things. Usually two."
`(r-inpr ,(car args) (inpr ,@(cdr args))))
(declaim (inline len lensqr distsqr dist))
(defun lensqr (vect)
"Length squared of a vector."
(r-inpr vect vect))
(defun len (vect)
"Length of a vector."
(sqrt (lensqr vect)))
(defun distsqr (a b)
"Distance squared between two vectors."
(lensqr (v- a b)))
(defun dist (a b)
"Distance between two vectors."
(sqrt (distsqr a b)))
(defgeneric v-angle (vect) (:documentation "Angles from a vector."))
(defun angle-v2 (angle)
"Vector from a angle."
(mk-vect (cos angle) (sin angle)))
(defun angle-v3 (angle up-angle)
"Vector from two angles, so three-dimensional.
(Not the usual illogical polar coordinates, height is sin up-angle.)"
(mk-vect (* (cos angle) (cos up-angle)) (* (sin angle) (cos up-angle))
(sin up-angle)))
(defgeneric vect-as-list (vec) (:documentation "Converts a vector to a list\
for printing and such."))
vect-number.lisp The vector code treats things internally as 'vectors' so that it can do matrices as well, hence we need to make a few methods to make numbers work.
Code: Select all
(in-package #:vect)
;;Regular number version.
(defmethod r* ((x number) (y number))
(* x y))
;Addition and substraction.
(eval (let*((vars '(v1 v2 v3 v4 v5 v6))
(args (iter (for v in vars)
(collect `(,v number)))))
`(progn ,@(iter (for n from 2)
(for r+ in '(r+2 r+3 r+4 r+5 r+6))
(for r- in '(r-2 r-3 r-4 r-5 r-6))
(appending `((defmethod ,r+ (,@(subseq args 0 n))
(+ ,@(subseq vars 0 n)))
(defmethod ,r- (,@(subseq args 0 n))
(+ ,@(subseq vars 0 n)))))))))
;Inproduct.
(defmethod r-inpr ((a number) (b number))
(* a b))
vect-define.lisp Allows one to make vectors, it connects it to other vectors via mk-vect (which can be overridden)
Code: Select all
(in-package #:vect)
(defun components-from-integer (dimension)
"Uses standard component names."
(case dimension (1 '(x)) (2 '(x y)) (3 '(x y z))))
(defmacro do-components (fun maker components &rest args)
"Macro, does function with the arguments from all the arguments.
Components is the number of elements, or their names."
(when (integerp components)
(setf components (components-from-integer)))
`(,maker
,@(iter (for c in components)
(collect
`(,fun
,@(iter (for a in args)
(collect `(,c ,a))))))))
(defmacro make-do-components-method (method fun maker components type
arg-cnt)
"Makes a method from the components."
(let ((gs (iter (repeat arg-cnt)
(collect (gensym)))))
`(defmethod ,method (,@(iter (for g in gs)
(collect `(,g ,type))))
(do-components ,fun ,maker ,components ,@gs))))
(defun any-eql (eql list)
"Any of list eql to eql."
(dolist (el list) (when (eql eql el) (return el))))
(defun all-combinations (list n fun &optional args)
(dolist (el list)
(if (= n 1)
(funcall fun (cons el args))
(all-combinations list (- n 1) fun (cons el args)))))
(defun r+n-name (n) (case n (2 'r+2) (3 'r+3) (4 'r+4) (5 'r+5) (6 'r+6)))
(defun r-n-name (n) (case n (2 'r-2) (3 'r-3) (4 'r-4) (5 'r-5) (6 'r-6)))
(defvar *vector-types* nil "Types that already exist.")
(defmacro define-vect (name of-type initform components &key maker
fun-maker)
"Defines vector type with components of given type.
Also makes all methods."
(when (integerp components)
(setf components (components-from-integer components)))
(unless maker
(setf maker (vect-maker-name (length components))))
(when (any-eql name *vector-types*)
(error "Vector type with this name already exists."))
(push name *vector-types*)
`(progn
;The class.
(defclass ,name ()
(,@(iter (for c in components)
(collect `(,c :initarg ,c :accessor ,c
:type ,of-type :initform ,initform))))
(:documentation ,(format nil "A ~D-dimensional vector of type ~D."
(length components) of-type)))
;Creation.
(defmethod ,maker (,@(iter (for c in components)
(collect `(,c ,of-type))))
(make-instance ',name ,@(iter (for c in components)
(appending `(',c ,c)))))
,@(when fun-maker
`((defun ,fun-maker (,@components)
(make-instance ',name ,@(iter (for c in components)
(appending `(',c ,c)))))))
;Multiplication. (Dividing based on it.)
(defmethod r* ((vect ,name) (scalar number))
(mk-vect ,@(iter (for c in components)
(collect `(* (,c vect) scalar)))))
;Adding/substracting, different counts of arguments.
,@(iter (for n from 2) (while (<= n 2))
(all-combinations *vector-types* n
(lambda (tps)
(when (any-eql name tps)
(let*((vars (iter (repeat n) (collect (gensym))))
(args (iter (for v in vars)
(for tp in tps)
(collect `(,v ,tp)))))
(appending
`((defmethod ,(r+n-name n) (,@args)
(do-components v+ mk-vect ,components
,@vars))
(defmethod ,(r-n-name n) (,@args)
(do-components v- mk-vect ,components
,@vars)))))))))
;Other stuff.
,@(iter
(all-combinations *vector-types* 2
(lambda (tps)
(when (any-eql name tps)
(destructuring-bind (tp-a tp-b) tps
(appending
`((defmethod r-inpr ((a ,tp-a) (b ,tp-b)) ;Inproduct
(v+ ,@(iter (for c in components)
(collect `(r-inpr (,c a) (,c b))))))
,(case (length components)
(2 ;Cross product of 2 dimensional is 1 dimensional.
(destructuring-bind (x y) components
`(defmethod crosspr ((a ,tp-a) (b ,tp-b))
(- (* (,y a) (,x b)) (* (,x a) (,y b))))))
(3
(destructuring-bind (x y z) components
`(defmethod crosspr ((a ,tp-a) (b ,tp-b))
(mk-vect
(- (* (,z a) (,y b)) (* (,y a) (,z b)))
(- (* (,x a) (,z b)) (* (,z a) (,x b)))
(- (* (,y a) (,x b)) (* (,x a) (,y b))))))))))))))
(finish))
;Listing
(defmethod vect-as-list ((vec ,name))
,(if (any-eql of-type (cdr *vector-types*))
`(iter (for el in (do-components identity list ,components vec))
(collect (vect-as-list el)))
`(do-components identity list ,components vec)))
;TODO v-angle
))
vect-specific.lisp Some vectors themselves.
Code: Select all
(in-package #:vect)
;;Matrices from vectors.
(define-vect vect2d double-float 0d0 2 :fun-maker mk-vect2d)
(define-vect vect2f single-float 0.0 2 :fun-maker mk-vect2f)
(define-vect vect2i fixnum 0 2 :fun-maker mk-vect2i)
(define-vect vect3d double-float 0d0 3 :fun-maker mk-vect3d)
(define-vect vect3f single-float 0.0 3 :fun-maker mk-vect3f)
(define-vect vect3i fixnum 0 3 :fun-maker mk-vect3i)
Some matrices made from those
Code: Select all
(in-package #:vect)
;;Matrices from vectors.
(define-vect matrix22d vect2d (mk-vect2d 0d0 0d0) 2
:fun-maker mk-matrix22d)
(define-vect matrix23d vect3d (mk-vect3d 0d0 0d0 0d0) 2
:fun-maker mk-matrix23d)
(define-vect matrix32d vect2d (mk-vect2d 0d0 0d0) 3
:fun-maker mk-matrix32d)
(define-vect matrix33d vect3d (mk-vect3d 0d0 0d0 0d0) 3
:fun-maker mk-matrix33d)