## [Maxima-commits] CVS: maxima/share/linearalgebra linalg-utilities.lisp,1.11,1.12 linalg.mac,1.20,1.21 lu.lisp,1.9,1.10

 [Maxima-commits] CVS: maxima/share/linearalgebra linalg-utilities.lisp,1.11,1.12 linalg.mac,1.20,1.21 lu.lisp,1.9,1.10 From: Barton Willis - 2006-01-26 22:24:20 ```Update of /cvsroot/maxima/maxima/share/linearalgebra In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8138/share/linearalgebra Modified Files: linalg-utilities.lisp linalg.mac lu.lisp Log Message: (1) Deleted extra load("linalg-extra") from linalg.mac (2) Better identfor function (also moved it to linalg-utilities) Index: linalg-utilities.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linalg-utilities.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- linalg-utilities.lisp 26 Jan 2006 03:12:04 -0000 1.11 +++ linalg-utilities.lisp 26 Jan 2006 22:24:06 -0000 1.12 @@ -83,6 +83,37 @@ (cons (car mat) (mapcar #'(lambda (s) (zerofor s zero)) (cdr mat))) zero)) +;; Return an identity matrix that has the same shape as the matrix +;; mat. The first argument 'mat' should be a square Maxima matrix or a +;; non-matrix. When 'mat' is a matrix, each entry of 'mat' can be a +;; square matrix -- thus 'mat' can be a blocked Maxima matrix. The +;; matrix can be blocked to any (finite) depth. + +(defun \$identfor (mat &optional (fld-name '\$generalring)) + (let* ((fld (\$require_ring fld-name "\$second" "\$zerofor")) + (add-id (funcall (mring-mring-to-maxima fld) (funcall (mring-add-id fld)))) + (mult-id (funcall (mring-mring-to-maxima fld) (funcall (mring-mult-id fld))))) + (if (\$matrixp mat) (identfor mat add-id mult-id) mult-id))) + +(defun identfor (mat zero one) + (let ((i) (acc) (j) (new-mat)) + (setq mat (rest mat)) + (setq i 0) + (dolist (row mat) + (setq row (rest row)) + (setq acc nil) + (setq j 0) + (dolist (aij row) + (push (cond ((\$matrixp aij) + (if (= i j) (identfor aij zero one) (zerofor aij zero))) + ((= i j) one) + (t zero)) acc) + (incf j)) + (incf i) + (push '(mlist) acc) + (push acc new-mat)) + (push '(\$matrix) new-mat))) + (defun \$ctranspose (m) (mfuncall '\$transpose (full-matrix-map m #'(lambda (s) (simplifya `((\$conjugate) ,s) nil))))) Index: linalg.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linalg.mac,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- linalg.mac 26 Jan 2006 11:54:42 -0000 1.20 +++ linalg.mac 26 Jan 2006 22:24:06 -0000 1.21 @@ -37,7 +37,6 @@ load("eigens-by-jacobi"), load("linalg-extra"), load("matrixexp"), - load("linalg-extra"), load("linalg-utilities")); require_integer(i, pos, fn) := Index: lu.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/lu.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- lu.lisp 26 Jan 2006 03:12:04 -0000 1.9 +++ lu.lisp 26 Jan 2006 22:24:06 -0000 1.10 @@ -80,7 +80,6 @@ (defun \$get_lu_factors (x) (let ((mat (\$first x)) (mp) (p (\$second x)) (perm) (r) (c) (id) (lower) (upper) (zero)) - (setq r (\$matrix_size mat)) (setq c (\$second r)) (setq r (\$first r)) @@ -95,7 +94,6 @@ (setq lower (copy-tree mp)) (setq upper (copy-tree mp)) - (setq id (\$identfor (\$first (\$first mat)))) (setq zero (\$zerofor (\$first (\$first mat)))) (loop for i from 1 to r do @@ -267,29 +265,6 @@ (mul (simplify (mfunction-call |\$mat_norm| m p)) (simplify (mfunction-call |\$mat_norm| (\$invert_by_lu m) p)))) -;; Return an identity matrix that has the same shape as the matrix -;; mat. The first argument 'mat' should be a square Maxima matrix or a -;; non-matrix. When 'mat' is a matrix, each entry of 'mat' can be a -;; square matrix -- thus 'mat' can be a blocked Maxima matrix. The -;; matrix can be blocked to any (finite) depth. - -(defun \$identfor (mat &optional (fld-name '\$generalring) (p 1) (q 1)) - (\$require_ring fld-name "\$second" "\$identfor") - (let* ((fld (get fld-name 'ring)) - (add-id (funcall (mring-mring-to-maxima fld) (funcall (mring-add-id fld)))) - (mul-id (funcall (mring-mring-to-maxima fld) (funcall (mring-mult-id fld))))) - - (cond ((\$matrixp mat) - (\$require_square_matrix mat "\$first" "\$identfor") - (let ((n (\$first (\$matrix_size mat))) (mc)) - (setq mc (copy-tree mat)) - (loop for i from 1 to n do - (loop for j from 1 to n do - (setf (nth j (nth i mc)) (if (= p q) (\$identfor (nth j (nth i mat)) fld-name j i) - (\$identfor (nth j (nth i mat)) fld-name p q))))) - mc)) - (t (if (= p q) mul-id add-id))))) - \ No newline at end of file ```

 [Maxima-commits] CVS: maxima/share/linearalgebra linalg-utilities.lisp,1.11,1.12 linalg.mac,1.20,1.21 lu.lisp,1.9,1.10 From: Barton Willis - 2006-01-26 22:24:20 ```Update of /cvsroot/maxima/maxima/share/linearalgebra In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8138/share/linearalgebra Modified Files: linalg-utilities.lisp linalg.mac lu.lisp Log Message: (1) Deleted extra load("linalg-extra") from linalg.mac (2) Better identfor function (also moved it to linalg-utilities) Index: linalg-utilities.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linalg-utilities.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- linalg-utilities.lisp 26 Jan 2006 03:12:04 -0000 1.11 +++ linalg-utilities.lisp 26 Jan 2006 22:24:06 -0000 1.12 @@ -83,6 +83,37 @@ (cons (car mat) (mapcar #'(lambda (s) (zerofor s zero)) (cdr mat))) zero)) +;; Return an identity matrix that has the same shape as the matrix +;; mat. The first argument 'mat' should be a square Maxima matrix or a +;; non-matrix. When 'mat' is a matrix, each entry of 'mat' can be a +;; square matrix -- thus 'mat' can be a blocked Maxima matrix. The +;; matrix can be blocked to any (finite) depth. + +(defun \$identfor (mat &optional (fld-name '\$generalring)) + (let* ((fld (\$require_ring fld-name "\$second" "\$zerofor")) + (add-id (funcall (mring-mring-to-maxima fld) (funcall (mring-add-id fld)))) + (mult-id (funcall (mring-mring-to-maxima fld) (funcall (mring-mult-id fld))))) + (if (\$matrixp mat) (identfor mat add-id mult-id) mult-id))) + +(defun identfor (mat zero one) + (let ((i) (acc) (j) (new-mat)) + (setq mat (rest mat)) + (setq i 0) + (dolist (row mat) + (setq row (rest row)) + (setq acc nil) + (setq j 0) + (dolist (aij row) + (push (cond ((\$matrixp aij) + (if (= i j) (identfor aij zero one) (zerofor aij zero))) + ((= i j) one) + (t zero)) acc) + (incf j)) + (incf i) + (push '(mlist) acc) + (push acc new-mat)) + (push '(\$matrix) new-mat))) + (defun \$ctranspose (m) (mfuncall '\$transpose (full-matrix-map m #'(lambda (s) (simplifya `((\$conjugate) ,s) nil))))) Index: linalg.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/linalg.mac,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- linalg.mac 26 Jan 2006 11:54:42 -0000 1.20 +++ linalg.mac 26 Jan 2006 22:24:06 -0000 1.21 @@ -37,7 +37,6 @@ load("eigens-by-jacobi"), load("linalg-extra"), load("matrixexp"), - load("linalg-extra"), load("linalg-utilities")); require_integer(i, pos, fn) := Index: lu.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/linearalgebra/lu.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- lu.lisp 26 Jan 2006 03:12:04 -0000 1.9 +++ lu.lisp 26 Jan 2006 22:24:06 -0000 1.10 @@ -80,7 +80,6 @@ (defun \$get_lu_factors (x) (let ((mat (\$first x)) (mp) (p (\$second x)) (perm) (r) (c) (id) (lower) (upper) (zero)) - (setq r (\$matrix_size mat)) (setq c (\$second r)) (setq r (\$first r)) @@ -95,7 +94,6 @@ (setq lower (copy-tree mp)) (setq upper (copy-tree mp)) - (setq id (\$identfor (\$first (\$first mat)))) (setq zero (\$zerofor (\$first (\$first mat)))) (loop for i from 1 to r do @@ -267,29 +265,6 @@ (mul (simplify (mfunction-call |\$mat_norm| m p)) (simplify (mfunction-call |\$mat_norm| (\$invert_by_lu m) p)))) -;; Return an identity matrix that has the same shape as the matrix -;; mat. The first argument 'mat' should be a square Maxima matrix or a -;; non-matrix. When 'mat' is a matrix, each entry of 'mat' can be a -;; square matrix -- thus 'mat' can be a blocked Maxima matrix. The -;; matrix can be blocked to any (finite) depth. - -(defun \$identfor (mat &optional (fld-name '\$generalring) (p 1) (q 1)) - (\$require_ring fld-name "\$second" "\$identfor") - (let* ((fld (get fld-name 'ring)) - (add-id (funcall (mring-mring-to-maxima fld) (funcall (mring-add-id fld)))) - (mul-id (funcall (mring-mring-to-maxima fld) (funcall (mring-mult-id fld))))) - - (cond ((\$matrixp mat) - (\$require_square_matrix mat "\$first" "\$identfor") - (let ((n (\$first (\$matrix_size mat))) (mc)) - (setq mc (copy-tree mat)) - (loop for i from 1 to n do - (loop for j from 1 to n do - (setf (nth j (nth i mc)) (if (= p q) (\$identfor (nth j (nth i mat)) fld-name j i) - (\$identfor (nth j (nth i mat)) fld-name p q))))) - mc)) - (t (if (= p q) mul-id add-id))))) - \ No newline at end of file ```