From: Barton W. <wil...@us...> - 2007-07-23 11:11:37
|
Update of /cvsroot/maxima/maxima/share/linearalgebra In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv5211/share/linearalgebra Modified Files: linalg-extra.lisp linearalgebra.mac Log Message: Faster function vandermonde_matrix Index: linalg-extra.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linalg-extra.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- linalg-extra.lisp 17 Jul 2007 13:47:28 -0000 1.6 +++ linalg-extra.lisp 23 Jul 2007 11:11:13 -0000 1.7 @@ -49,6 +49,21 @@ ($genmatrix `((lambda) ((mlist) i j) ($diff (nth i ,e) (nth j ,vars))) m n)) `(($jacobian) ,e ,vars))) +(defun $vandermonde_matrix (l) + (let ((x) (row) (acc)) + (setq l (require-list l "$vandermonde_matrix")) + (dolist (li l) + (setq x 1 row nil) + (dolist (lk l) + (push x row) + (setq x (mul x li))) + (setq row (nreverse row)) + (push '(mlist) row) + (push row acc)) + (setq acc (nreverse acc)) + (push '($matrix) acc) + acc)) + ;; Use Sylvester's criterion to decide if the self-adjoint part of a matrix is ;; negative definite (neg) or positive definite (pos). By the self-adjoint part ;; of a matrix M, I mean (M + M^*) / 2, where ^* is the conjugate transpose. For Index: linearalgebra.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linearalgebra.mac,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- linearalgebra.mac 19 Jul 2007 16:24:47 -0000 1.6 +++ linearalgebra.mac 23 Jul 2007 11:11:13 -0000 1.7 @@ -291,14 +291,6 @@ require_posinteger(n,"first","hilbert_matrix"), funmake('matrix, makelist(makelist(1/(i + j - 1),i,1, n),j, 1, n))); -/* To avoid a "too many arguments" error, use use funmake('matrix, ....) instead of - apply('matrix, ...). -*/ - -vandermonde_matrix(vars) := block([n], - require_list(vars,"first","vandermonde_matrix"), - n : length(vars), - funmake('matrix, makelist(makelist(if j=0 then 1 else vars[i]^j,j,0,n-1),i,1,n))); hankel([q]) := block([col,row,m,n,partswitch : false], if length(q) > 2 or length(q) < 1 then error("The function 'hankel' requires one or two arguments"), @@ -324,7 +316,7 @@ polytocompanion(p,x) := block([n], if not polynomialp(p,[x], lambda([e], freeof(x,e))) then - error("First argument to 'polytocompanion' must be a polynomial"), + error("First argument to 'polytocompanion' must be a polynomial"), p : expand(p), n : hipow(p,x), p : multthru(p / coeff(p,x,n)), |