From ac0052e07811d54a1699e697304aeffc6193b8ae Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 3 Apr 2024 14:48:00 +1300 Subject: [PATCH 01/26] Create linearalgebra.mac Version 0.2 of linearalgebra.mac --- stack/maxima/contrib/linearalgebra.mac | 622 +++++++++++++++++++++++++ 1 file changed, 622 insertions(+) create mode 100644 stack/maxima/contrib/linearalgebra.mac diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac new file mode 100644 index 00000000000..1ca64d1c9ed --- /dev/null +++ b/stack/maxima/contrib/linearalgebra.mac @@ -0,0 +1,622 @@ +/* Author Luke Longworth + University of Canterbury + Copyright (C) 2024 Luke Longworth + + This program is free software: you can redistribute it or modify + it under the terms of the GNU General Public License version two. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/****************************************************************/ +/* Linear algebra functions for STACK */ +/* */ +/* V0.2 March 2024 */ +/* */ +/****************************************************************/ + +/*******************************************************************************/ +/* Provides convenience functions for column and row vectors for student input */ +/*******************************************************************************/ +texput(c, + lambda([ex], block( + ns: args(ex), + str: ["\\begin{bmatrix} "], + for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " \\\\ "])), + str[length(str)]: " \\end{bmatrix}", + simplode(str) + )) +); + +texput(r, + lambda([ex], block( + ns: args(ex), + str: ["\\begin{bmatrix} "], + for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " & "])), + str[length(str)]: " \\end{bmatrix}", + simplode(str) + )) +); + +/* Manually convert student answers to the appropriate vector form. Needs simp false. */ +vec_convert(sa):= ev(sa, + c = lambda([[ex]],transpose(matrix(ex))), + r = lambda([[ex]],matrix(ex)) + ); + +s_test_case(vec_convert(c(1,2)+r(1,2)),matrix([1],[2])+matrix([1,2])); +s_test_case(vec_convert(2*c(1,2)-4*r(1,2,3)),2*matrix([1],[2])-4*matrix([1,2,3])); + +/* Automatically converts answers like c(1,2,3) to matrix([1],[2],[3]) etc. May make the above function obsolete. */ +/* TODO which approach to take: vec_convert or defining c and r as functions? */ +c([ex]):= transpose(matrix(ex)); +r([ex]):= matrix(ex); + +s_test_case(c(1,2,3),matrix([1],[2],[3])); +s_test_case(c(1,2),matrix([1],[2])); +s_test_case(r(1,2,3),matrix([1,2,3])); +s_test_case(r(1,2),matrix([1,2])); + +/*********************************************************************************/ +/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +triu(M):= block([Mupp,imax,jmax,ii,jj], + Mupp: copymatrix(M), + [imax, jmax]: ev(matrix_size(M),simp), + for ii: 2 thru imax do block( + ii: ev(ii,simp), + for jj: 1 thru ev(min(ii-1, jmax),simp) do block( + jj: ev(jj,simp), + Mupp[ii,jj]: 0 + ) + ), + return(Mupp) +); + +s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[0,5,6],[0,0,9])); +s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])); +s_test_case(triu(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])); + +/*********************************************************************************/ +/* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +tril(M):= transpose(triu(transpose(M))); + +s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[4,5,0],[7,8,9])); +s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])); +s_test_case(tril(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])); + +/*********************************************************************************/ +/* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +get_diag(M):= tril(triu(M)); + +s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0,0,9])); +s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); +s_test_case(get_diag(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); + +/*********************************************************************************/ +/* Predicate functions about the shape of a matrix */ +/*********************************************************************************/ + +/* Is the matrix upper triangular? */ +triup(M):= is(M = triu(M)); + +/* Is the matrix lower triangular? */ +trilp(M):= is(M = tril(M)); + +/* Is the matrix diagonal? */ +diagp(M):= triup(M) and trilp(M); + +s_test_case(triup(ident(5)),true); +s_test_case(trilp(ident(5)),true); +s_test_case(diagp(ident(5)),true); +s_test_case(triup(zeromatrix(5,4)),true); +s_test_case(trilp(zeromatrix(5,4)),true); +s_test_case(diagp(zeromatrix(5,4)),true); + +s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9])),true); +s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); +s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])),true); +s_test_case(triup(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); +s_test_case(triup(matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])),true); + +s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9])),true); +s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); +s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])),true); +s_test_case(trilp(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); +s_test_case(trilp(matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])),true); + +s_test_case((simp:false,diagp(matrix([1,0],[1-1,1]))),false); + +/* Is the matrix in row echelon form (not reduced)? */ + +REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], + if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), + isREF: true, + pivot_row: 0, + [m, n]: matrix_size(M), + for jj: 1 thru n do block( + jj: ev(jj,simp), + if is(pivot_row < m) then block( + if is(M[ev(pivot_row+1,simp),jj] # 0) then block( + pivot_row: ev(pivot_row + 1,simp), + if normalise_pivots and is(M[ev(pivot_row,simp),jj] # 1) then isREF: false + ), + for ii: ev(pivot_row+1,simp) thru m do block( + ii: ev(ii,simp), + if is(M[ii,jj] # 0) then isREF: false + ) + ) + ), + return(isREF) +); + +s_test_case(REFp(ident(4)),true); +s_test_case(REFp(ev(2*ident(4),simp)),true); +s_test_case(REFp(ev(2*ident(4),simp),true),false); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0])),true); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),true),false); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),false),true); +s_test_case(REFp(matrix([2,1,1],[0,0,0],[0,0,3],[0,0,0])),false); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1])),true); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1]),true),true); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,1,0,1,1],[0,0,0,0,0,1])),true); +s_test_case(REFp(matrix([1,2,3],[0,5,6])),true); +s_test_case(REFp(matrix([1,2,3],[4,5,6])),false); +s_test_case(REFp(matrix([1,2,3],[0,5,6],[0,8,9])),false); + +/*********************************************************************************/ +/* Returns the diagonal of a matrix as a list */ +/*********************************************************************************/ + +diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); + +s_test_case(diag_entries(ident(3)),[1,1,1]); +s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); +s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); + +/*********************************************************************************/ +/* Returns a diagonal matrix of size m by n with given diagonal */ +/*********************************************************************************/ + +diagmatrix_like(d, m, n):= block([M,ii], + M: zeromatrix(m, n), + for ii: 1 thru ev(min(m, n, length(d)),simp) do block( + ii: ev(ii,simp), + M[ii,ii]: d[ii] + ), + return(M) +); + +s_test_case(diagmatrix_like([1,1,1],3,3),ident(3)); +s_test_case(diagmatrix_like([1,2,3],3,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0])); +s_test_case(diagmatrix_like([1,2,3],4,3),matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])); +s_test_case(diagmatrix_like([1,2,3],4,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0],[0,0,0,0])); +s_test_case(diagmatrix_like([1,2,3],2,3),matrix([1,0,0],[0,2,0])); +s_test_case(diagmatrix_like([1,2,3],3,2),matrix([1,0],[0,2],[0,0])); + +/*********************************************************************************/ +/* Predicate function to test whether a set of vectors is linearly independent */ +/*********************************************************************************/ +/* If given a matrix, it checks whether it has full column rank */ +/* If given a list of atoms, it treats it as a single vector and returns true */ +/* If given a list, set, ntuple or span of lists and/or matrices, it converts + the matrices to lists, checks that all lists are the same length, and checks + whether the matrix with these vectors as rows has full row rank */ + +lin_indp(M):= block( + if matrixp(M) then return(is(rank(M) = ev(second(matrix_size(M)),simp))) + else if setp(M) then M: listify(M) + else if ntuplep(M) or safe_op(M)="span" then M: args(M), + if every(atom,M) then return(true), + M: map(lambda([ex], if matrixp(ex) then list_matrix_entries(ex) else ex),M), + if every(lambda([ex],length(ex)=length(first(M))),M) then return(is(rank(apply(matrix,M)) = ev(first(matrix_size(apply(matrix,M))),simp))), + return(false) +); + +s_test_case(lin_indp(matrix([1,2],[4,5],[7,8])),true); +s_test_case(lin_indp(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(lin_indp(matrix([1,2,3],[4,5,6])),false); +s_test_case(lin_indp([[1,2],[4,5],[7,8]]),false); +s_test_case(lin_indp([[1,4,7],[2,5,8]]),true); +s_test_case(lin_indp({[1,2],[4,5],[7,8]}),false); +s_test_case(lin_indp({[1,4,7],[2,5,8]}),true); +s_test_case(lin_indp(ntuple([1,2],[4,5],[7,8])),false); +s_test_case(lin_indp(ntuple([1,4,7],[2,5,8])),true); +s_test_case(lin_indp(span([1,2],[4,5],[7,8])),false); +s_test_case(lin_indp(span([1,4,7],[2,5,8])),true); +s_test_case(lin_indp([transpose([1,4,7]),[2,5,8]]),true); +s_test_case(lin_indp({transpose([1,4,7]),matrix([2,5,8])}),true); + +/*********************************************************************************/ +/* Maps the significantfigures function over a matrix */ +/*********************************************************************************/ +/* Should this be core functionality? Surely when given a matrix the base sigfigsfun + or significantfigures function could do this by mapping itself over the arguments + and re-constructing the matrix. */ + +sf_map(ex,n):= block([rows], + if matrixp(ex) then block( + return(apply(matrix,map(lambda([ex2],significantfigures(ex2,n)),args(ex)))) + ) else if listp(ex) or ev(numberp(ex),simp) then return(significantfigures(ex,n)) + else return(ex) +); + +s_test_case(sf_map(1/3,2),0.33); +s_test_case(sf_map(1/3,3),0.333); +s_test_case(sf_map(12345,2),12000); +s_test_case(sf_map(12345,3),12300); +s_test_case(sf_map(1.5,1),2); +s_test_case(sf_map(2.5,1),3); + +s_test_case(sf_map([1/3,12345],2),[0.33,12000]); +s_test_case(sf_map(matrix([1/3,12345]),2),matrix([0.33,12000])); +s_test_case(sf_map(matrix([1/3],[12345]),2),matrix([0.33],[12000])); +s_test_case(sf_map(matrix([1/3,12345],[1/4,5/4]),2),matrix([0.33,12000],[0.25,1.3])); +s_test_case(sf_map({1/3,1/4},1),{1/3,1/4}); + +/*********************************************************************************/ +/* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ +/*********************************************************************************/ +/* I don't know if this has a good use case in a CAS like Maxima. + I would happily remove this if this feels out of place, as I don't + anticipate using this in my course regularly. */ + +mat_norm2(M):= block([svs], + if matrixp(M) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + return(ev(lmax(svs),simp)) + ) else return(und) +); + +s_test_case(mat_norm2(ident(2)),1.0); +s_test_case(mat_norm2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); +s_test_case(mat_norm2(matrix([1,2],[2,-2])),3.0); +s_test_case(mat_norm2(matrix([2,2],[1,0],[0,1])),3.0); +s_test_case(mat_norm2(matrix([1,1],[1,1])),2.0); +s_test_case(mat_norm2(1),und); + +mat_cond2(M):= block([svs,cond2], + cond2: und, + if matrixp(M) then block( + if ev(is(first(matrix_size(M))=second(matrix_size(M))),simp) then block( + if ev(is(determinant(M)#0),simp) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + cond2: ev(lmax(svs)/lmin(svs),simp) + ) + ) + ), + return(cond2) +); + +s_test_case(mat_cond2(ident(2)),1.0); +s_test_case(mat_cond2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); +s_test_case(mat_cond2(matrix([1,2],[2,-2])),1.5); +s_test_case(mat_cond2(1),und); +s_test_case(mat_cond2(matrix([1,1],[1,0],[0,1])),und); +s_test_case(mat_cond2(matrix([1,2],[1,2])),und); + +/*********************************************************************************/ +/* Is a matrix row or column equivalent to another? */ +/*********************************************************************************/ +/* Note: some behaviour may be unexpected when variables appear in either matrix, + as row/column equivalence is unclear in instances where division by an unknown occurs */ + +row_equiv(ex,ta):= block( + if matrixp(ex) and matrixp(ta) then ( + return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) + ) +); + +col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); + +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); + +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); + +remove_dep(ex):= block( + ex_op: "list", + vec_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") + else if setp(ex) then block(ex: listify(ex), ex_op: "set") + else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") + else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), + if matrixp(first(ex)) then vec_op: "matrix" + else if ntuplep(first(ex)) then vec_op: "ntuple", + ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,jj-1),lastn(ex,length(ex)-jj)) + else jj: jj+1, + if is(jj>length(ex)) then return(ex) + ), + if is(vec_op="matrix") then ex: map(transpose,ex) + else if is(vec_op="ntuple") then ex: map(ntupleify,ex), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) + else if is(ex_op="set") then ex: setify(ex) + else if is(ex_op="ntuple") then ex: ntupleify(ex) + else if is(ex_op="span") then ex: apply(span,ex), + return(ex) +); + +remove_dep(ex):= block( + ex_op: "list", + vec_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") + else if setp(ex) then block(ex: listify(ex), ex_op: "set") + else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") + else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), + if matrixp(first(ex)) then vec_op: "matrix" + else if ntuplep(first(ex)) then vec_op: "ntuple", + ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + ii: ev(ii,simp), + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) + else jj: ev(jj+1,simp), + if is(jj>length(ex)) then return(ex) + ), + if is(vec_op="matrix") then ex: map(transpose,ex) + else if is(vec_op="ntuple") then ex: map(ntupleify,ex), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) + else if is(ex_op="set") then ex: setify(ex) + else if is(ex_op="ntuple") then ex: ntupleify(ex) + else if is(ex_op="span") then ex: apply(span,ex), + return(ex) +); + +subspace_equiv(ex,ta):= block( + if setp(ex) then ex: listify(ex) else if ntuplep(ex) or safe_op(ex)="span" then ex: args(ex), + if setp(ta) then ex: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), + ex: map(lambda([ex2],if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + /*ex: remove_dep(ex),*/ + ta: map(lambda([ta2],if matrixp(ta2) then list_matrix_entries(ta2) else ta2),ta), + /*ta: remove_dep(ta),z*/ + /*return(row_equiv(apply(matrix,ex),apply(matrix,ta)))*/ + ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), + ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), + return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +); + +/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ +s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ +s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ +one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ +delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ + +/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ +/* local variable p will be a gradually growing list of strings that eventually get stitched together */ +disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], + n: length(eqns), /* n = number of equations */ + m: length(vars), /* m = number of variables */ + p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ + p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ + for ii: 1 thru n do block( + ii: ev(ii,simp), + pivot: false, /* each row will have a pivot, assume false until we find it */ + v: vars[1], /* v is the variable we are looking at in this column */ + a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ + if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ + /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ + if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), + for jj: 2 thru m do block( + jj: ev(jj,simp), + v: vars[jj], + a: ev(coeff(lhs(eqns[ii]),v),simp), + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if is(a#0) and not(pivot) then pivot: true + ), + p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), + if is(ii#n) then p: append(p,["\\\\"]) + ), + p: append(p,["\\end{array}"]), + return(simplode(p)) +); + +mat_solve(A,b,[lstsq]):= block( + if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), + if listp(b) then b: transpose(b), + [m, n]: matrix_size(A), + if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), + vars: rest(stack_var_makelist(tmp,n)), + if lstsq then AT: transpose(A) else AT: ident(m), + eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), + sol: map(rhs,linsolve(eqns,vars)), + if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) +); + +QR(M):= block([cols,Q,R], + if is(rank(M)#second(matrix_size(M))) then return([]), + cols: ev(gramschmidt(transpose(M)),simp), + cols: ev(map(lambda([ex],ex/sqrt(ex.ex)),cols),simp), + Q: transpose(apply(matrix,cols)), + R: ev(transpose(Q).M,simp), + return([Q,R]) +); + +squarep(M):= block( + isSquare: false, + if matrixp(M) then block( + if is(apply("=",matrix_size(M))) then isSquare: true + ), + return(isSquare) +); + +diagonalisablep(M):= block( + if squarep(M) then return(ev(diagp(dispJordan(jordan(M))),simp)) else return(false) +); + +get_Jordan_form(M):= block( + if not(squarep(M)) then return([]), + jordan_info: ev(jordan(M),simp), + J: ev(dispJordan(jordan_info),simp), + P: ev(ModeMatrix(M,jordan_info),simp), + return([P,J]) +); + +sym_p(M):= is(M = ev(transpose(M),simp)); + +diagonalise(M):= block([P,J], + if not(squarep(M)) then return([]), + [P, J]: get_Jordan_form(M), + if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), + if diagp(J) then return([P,J]) else return([]) +); + +SVD_red(M):= block( + if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), + MTM: ev(transpose(M).M,simp), + if atom(MTM) then MTM: matrix([MTM]), + [V, S2]: diagonalise(MTM), + /* TODO: does this work? */ + V: first(QR(V)), + components: ev(makelist([S2[ii,ii],col(V,ii)],ii,1,second(matrix_size(MTM))),simp), + components: ev(reverse(sort(components)),simp), + components: ev(sublist(components,lambda([ex],is(first(ex)#0))),simp), + n: length(components), + S: zeromatrix(n,n), + S[1,1]: ev(sqrt(first(first(components))),simp), + V: second(first(components)), + U: ev(M.V/S[1,1],simp), + if atom(U) then U: matrix([U]), + if is(n>1) then block( + for ii: 2 thru n do block( + ii: ev(ii,simp), + S[ii,ii]: ev(sqrt(first(components[ii])),simp), + V: addcol(V,second(components[ii])), + U: addcol(U,ev(M.second(components[ii])/S[ii,ii],simp)) + ) + ), + return([U,S,transpose(V)]) +); + +pinv(M):= block( + if ev(zeromatrixp(M),simp) then return(M), + [U, S, VT]: SVD_red(M), + return(ev(transpose(VT) . invert(S) . transpose(U),simp)) +); + +basisify(M,[orth]):= block( + if emptyp(orth) then orth: false else orth: first(orth), + if not(lin_indp(M)) then M: remove_dep(M), + [m, n]: matrix_size(M), + vecs: args(transpose(M)), + new_vecs: args(ident(m)), + for ii: 1 thru m do block( + ii: ev(ii,simp), + if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) + ), + if orth then block( + vecs: ev(gramschmidt(apply(matrix,vecs)),simp), + vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) + ), + return(transpose(apply(matrix,vecs))) +); + +SVD(M):= block( + [U, S, VT]: SVD_red(M), + if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), + if is(VT=matrix([])) then VT: ident(second(matrix_size(M))) else VT: transpose(basisify(transpose(VT),true)), + S: diagmatrix_like(diag_entries(S),first(matrix_size(M)),second(matrix_size(M))), + return([U,S,VT]) +); + +invertiblep(M):= block( + isInvertible: false, + if squarep(M) then block( + if ev(is(determinant(M)#0),simp) then isInvertible: true + ), + return(isInvertible) +); + +get_PLU(M):= block( + if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) +); + +unit_vecp(v):= is(ev(v.conjugate(v),simp)=1); + +eigenvectorp(v,M):= block( + if matrixp(v) then block( + if is(first(matrix_size(v))=1) then v: transpose(v) + ) else if listp(v) then v: transpose(v) + else if ntuplep(v) then v: transpose(args(v)), + if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), + return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) +); + +rowspace(M):= ev(columnspace(transpose(M)),simp); +nullTspace(M):= ev(nullspace(transpose(M)),simp); + +lgcd(ex):= block( + ex_gcd: first(ex), + for ii: 2 thru length(ex) do block( + ii: ev(ii,simp), + ex_gcd: gcd(ex_gcd,ex[ii]) + ), + return(ex_gcd) +); + +integerify(v):= block( + v_op: "list", + if matrixp(v) then (v_op: "matrix", v: list_matrix_entries(v)), + v: ev(v/lgcd(v),simp), + if is(v_op="matrix") then return(transpose(v)) else return(v) +); + +alg_mult(M,L):= block( + if squarep(M) then block( + evals: ev(eigenvalues(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(second(evals)[ii]) + ) +); + +geo_mult(M,L):= block( + if squarep(M) then block( + [evals, evects]: ev(eigenvectors(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(length(evects[ii])) + ) +); + +Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); + +orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); +orthonormal_columnsp(M):= is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))); +orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); + +projection_matrix(M):= block( + if ev(zeromatrixp(M),simp) then return(0), + reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), + return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) +); From f560ba78583f2de51ab322d59932fd9a7eae66e7 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 3 Apr 2024 14:55:51 +1300 Subject: [PATCH 02/26] Update linearalgebra.mac Remove the s_test_case for vec_convert that seems to be causing issues. --- stack/maxima/contrib/linearalgebra.mac | 3 --- 1 file changed, 3 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 1ca64d1c9ed..698e7d4e2e6 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -49,9 +49,6 @@ vec_convert(sa):= ev(sa, r = lambda([[ex]],matrix(ex)) ); -s_test_case(vec_convert(c(1,2)+r(1,2)),matrix([1],[2])+matrix([1,2])); -s_test_case(vec_convert(2*c(1,2)-4*r(1,2,3)),2*matrix([1],[2])-4*matrix([1,2,3])); - /* Automatically converts answers like c(1,2,3) to matrix([1],[2],[3]) etc. May make the above function obsolete. */ /* TODO which approach to take: vec_convert or defining c and r as functions? */ c([ex]):= transpose(matrix(ex)); From 002d966f6f47efc370b97feaa850254e040e87c6 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 4 Apr 2024 11:11:38 +1300 Subject: [PATCH 03/26] Update linearalgebra.mac The convenience functions `c` and `r` throw errors regularly if non-conforming vectors are added/multiplied inappropriately, so the original solution of directly converting to matrix form was inappropriate. The solution is to keep `c` and `r` as inert functions and use `vec_convert` to remove these as needed. Correspondingly, `vec_convert` now uses `errcatch` and will return the original expression when errors arise. A new predicate function, `vec_convertedp`, will detect whether an expression was successfully converted to matrix form. --- stack/maxima/contrib/linearalgebra.mac | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 698e7d4e2e6..5769ab9c9c2 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -16,7 +16,7 @@ /****************************************************************/ /* Linear algebra functions for STACK */ /* */ -/* V0.2 March 2024 */ +/* V0.2.1 April 2024 */ /* */ /****************************************************************/ @@ -43,21 +43,19 @@ texput(r, )) ); -/* Manually convert student answers to the appropriate vector form. Needs simp false. */ -vec_convert(sa):= ev(sa, - c = lambda([[ex]],transpose(matrix(ex))), - r = lambda([[ex]],matrix(ex)) - ); +/* Manually convert student answers to the appropriate vector form. */ +/* If vectors do not conform then the original expression is returned. */ +vec_convert(ex):= block( + ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), + if emptyp(ex2) then return(ex) else return(first(ex2)) +); -/* Automatically converts answers like c(1,2,3) to matrix([1],[2],[3]) etc. May make the above function obsolete. */ -/* TODO which approach to take: vec_convert or defining c and r as functions? */ -c([ex]):= transpose(matrix(ex)); -r([ex]):= matrix(ex); +/* A predicate to determine whether an expression has been converted to matrix form. */ +vec_convertedp(ex):= block( + ex_ops: get_ops(ex), + if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) +); -s_test_case(c(1,2,3),matrix([1],[2],[3])); -s_test_case(c(1,2),matrix([1],[2])); -s_test_case(r(1,2,3),matrix([1,2,3])); -s_test_case(r(1,2),matrix([1,2])); /*********************************************************************************/ /* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ From 3291c7c86625ea8b087f63aa9c610b542cc929af Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 4 Apr 2024 11:33:54 +1300 Subject: [PATCH 04/26] Create linearalgebra_no_test.mac Whilst editing questions I have found that saving and loading has been very burdensome compared to normal and my theory is that it runs all tests on every save, and on every preview (perhaps with deployed variants this would stop). This file exists with no `s_test_case` lines to see if the load times are improved. --- .../maxima/contrib/linearalgebra_no_test.mac | 501 ++++++++++++++++++ 1 file changed, 501 insertions(+) create mode 100644 stack/maxima/contrib/linearalgebra_no_test.mac diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac new file mode 100644 index 00000000000..327fe1c14a8 --- /dev/null +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -0,0 +1,501 @@ +/* Author Luke Longworth + University of Canterbury + Copyright (C) 2024 Luke Longworth + + This program is free software: you can redistribute it or modify + it under the terms of the GNU General Public License version two. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/****************************************************************/ +/* Linear algebra functions for STACK */ +/* */ +/* V0.2.1 April 2024 */ +/* */ +/****************************************************************/ + +/*******************************************************************************/ +/* Provides convenience functions for column and row vectors for student input */ +/*******************************************************************************/ +texput(c, + lambda([ex], block( + ns: args(ex), + str: ["\\begin{bmatrix} "], + for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " \\\\ "])), + str[length(str)]: " \\end{bmatrix}", + simplode(str) + )) +); + +texput(r, + lambda([ex], block( + ns: args(ex), + str: ["\\begin{bmatrix} "], + for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " & "])), + str[length(str)]: " \\end{bmatrix}", + simplode(str) + )) +); + +/* Manually convert student answers to the appropriate vector form. */ +/* If vectors do not conform then the original expression is returned. */ +vec_convert(ex):= block( + ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), + if emptyp(ex2) then return(ex) else return(first(ex2)) +); + +/* A predicate to determine whether an expression has been converted to matrix form. */ +vec_convertedp(ex):= block( + ex_ops: get_ops(ex), + if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) +); + + +/*********************************************************************************/ +/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +triu(M):= block([Mupp,imax,jmax,ii,jj], + Mupp: copymatrix(M), + [imax, jmax]: ev(matrix_size(M),simp), + for ii: 2 thru imax do block( + ii: ev(ii,simp), + for jj: 1 thru ev(min(ii-1, jmax),simp) do block( + jj: ev(jj,simp), + Mupp[ii,jj]: 0 + ) + ), + return(Mupp) +); + +/*********************************************************************************/ +/* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +tril(M):= transpose(triu(transpose(M))); + +/*********************************************************************************/ +/* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ +/*********************************************************************************/ + +get_diag(M):= tril(triu(M)); + +/*********************************************************************************/ +/* Predicate functions about the shape of a matrix */ +/*********************************************************************************/ + +/* Is the matrix upper triangular? */ +triup(M):= is(M = triu(M)); + +/* Is the matrix lower triangular? */ +trilp(M):= is(M = tril(M)); + +/* Is the matrix diagonal? */ +diagp(M):= triup(M) and trilp(M); + +/* Is the matrix in row echelon form (not reduced)? */ + +REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], + if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), + isREF: true, + pivot_row: 0, + [m, n]: matrix_size(M), + for jj: 1 thru n do block( + jj: ev(jj,simp), + if is(pivot_row < m) then block( + if is(M[ev(pivot_row+1,simp),jj] # 0) then block( + pivot_row: ev(pivot_row + 1,simp), + if normalise_pivots and is(M[ev(pivot_row,simp),jj] # 1) then isREF: false + ), + for ii: ev(pivot_row+1,simp) thru m do block( + ii: ev(ii,simp), + if is(M[ii,jj] # 0) then isREF: false + ) + ) + ), + return(isREF) +); + +/*********************************************************************************/ +/* Returns the diagonal of a matrix as a list */ +/*********************************************************************************/ + +diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); + +/*********************************************************************************/ +/* Returns a diagonal matrix of size m by n with given diagonal */ +/*********************************************************************************/ + +diagmatrix_like(d, m, n):= block([M,ii], + M: zeromatrix(m, n), + for ii: 1 thru ev(min(m, n, length(d)),simp) do block( + ii: ev(ii,simp), + M[ii,ii]: d[ii] + ), + return(M) +); + +/*********************************************************************************/ +/* Predicate function to test whether a set of vectors is linearly independent */ +/*********************************************************************************/ +/* If given a matrix, it checks whether it has full column rank */ +/* If given a list of atoms, it treats it as a single vector and returns true */ +/* If given a list, set, ntuple or span of lists and/or matrices, it converts + the matrices to lists, checks that all lists are the same length, and checks + whether the matrix with these vectors as rows has full row rank */ + +lin_indp(M):= block( + if matrixp(M) then return(is(rank(M) = ev(second(matrix_size(M)),simp))) + else if setp(M) then M: listify(M) + else if ntuplep(M) or safe_op(M)="span" then M: args(M), + if every(atom,M) then return(true), + M: map(lambda([ex], if matrixp(ex) then list_matrix_entries(ex) else ex),M), + if every(lambda([ex],length(ex)=length(first(M))),M) then return(is(rank(apply(matrix,M)) = ev(first(matrix_size(apply(matrix,M))),simp))), + return(false) +); + +/*********************************************************************************/ +/* Maps the significantfigures function over a matrix */ +/*********************************************************************************/ +/* Should this be core functionality? Surely when given a matrix the base sigfigsfun + or significantfigures function could do this by mapping itself over the arguments + and re-constructing the matrix. */ + +sf_map(ex,n):= block([rows], + if matrixp(ex) then block( + return(apply(matrix,map(lambda([ex2],significantfigures(ex2,n)),args(ex)))) + ) else if listp(ex) or ev(numberp(ex),simp) then return(significantfigures(ex,n)) + else return(ex) +); + +/*********************************************************************************/ +/* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ +/*********************************************************************************/ +/* I don't know if this has a good use case in a CAS like Maxima. + I would happily remove this if this feels out of place, as I don't + anticipate using this in my course regularly. */ + +mat_norm2(M):= block([svs], + if matrixp(M) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + return(ev(lmax(svs),simp)) + ) else return(und) +); + +mat_cond2(M):= block([svs,cond2], + cond2: und, + if matrixp(M) then block( + if ev(is(first(matrix_size(M))=second(matrix_size(M))),simp) then block( + if ev(is(determinant(M)#0),simp) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + cond2: ev(lmax(svs)/lmin(svs),simp) + ) + ) + ), + return(cond2) +); + +/*********************************************************************************/ +/* Is a matrix row or column equivalent to another? */ +/*********************************************************************************/ +/* Note: some behaviour may be unexpected when variables appear in either matrix, + as row/column equivalence is unclear in instances where division by an unknown occurs */ + +row_equiv(ex,ta):= block( + if matrixp(ex) and matrixp(ta) then ( + return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) + ) +); + +col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); + +remove_dep(ex):= block( + ex_op: "list", + vec_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") + else if setp(ex) then block(ex: listify(ex), ex_op: "set") + else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") + else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), + if matrixp(first(ex)) then vec_op: "matrix" + else if ntuplep(first(ex)) then vec_op: "ntuple", + ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,jj-1),lastn(ex,length(ex)-jj)) + else jj: jj+1, + if is(jj>length(ex)) then return(ex) + ), + if is(vec_op="matrix") then ex: map(transpose,ex) + else if is(vec_op="ntuple") then ex: map(ntupleify,ex), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) + else if is(ex_op="set") then ex: setify(ex) + else if is(ex_op="ntuple") then ex: ntupleify(ex) + else if is(ex_op="span") then ex: apply(span,ex), + return(ex) +); + +remove_dep(ex):= block( + ex_op: "list", + vec_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") + else if setp(ex) then block(ex: listify(ex), ex_op: "set") + else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") + else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), + if matrixp(first(ex)) then vec_op: "matrix" + else if ntuplep(first(ex)) then vec_op: "ntuple", + ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + ii: ev(ii,simp), + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) + else jj: ev(jj+1,simp), + if is(jj>length(ex)) then return(ex) + ), + if is(vec_op="matrix") then ex: map(transpose,ex) + else if is(vec_op="ntuple") then ex: map(ntupleify,ex), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) + else if is(ex_op="set") then ex: setify(ex) + else if is(ex_op="ntuple") then ex: ntupleify(ex) + else if is(ex_op="span") then ex: apply(span,ex), + return(ex) +); + +subspace_equiv(ex,ta):= block( + if setp(ex) then ex: listify(ex) else if ntuplep(ex) or safe_op(ex)="span" then ex: args(ex), + if setp(ta) then ex: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), + ex: map(lambda([ex2],if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), + /*ex: remove_dep(ex),*/ + ta: map(lambda([ta2],if matrixp(ta2) then list_matrix_entries(ta2) else ta2),ta), + /*ta: remove_dep(ta),z*/ + /*return(row_equiv(apply(matrix,ex),apply(matrix,ta)))*/ + ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), + ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), + return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +); + +/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ +s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ +s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ +one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ +delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ + +/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ +/* local variable p will be a gradually growing list of strings that eventually get stitched together */ +disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], + n: length(eqns), /* n = number of equations */ + m: length(vars), /* m = number of variables */ + p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ + p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ + for ii: 1 thru n do block( + ii: ev(ii,simp), + pivot: false, /* each row will have a pivot, assume false until we find it */ + v: vars[1], /* v is the variable we are looking at in this column */ + a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ + if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ + /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ + if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), + for jj: 2 thru m do block( + jj: ev(jj,simp), + v: vars[jj], + a: ev(coeff(lhs(eqns[ii]),v),simp), + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if is(a#0) and not(pivot) then pivot: true + ), + p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), + if is(ii#n) then p: append(p,["\\\\"]) + ), + p: append(p,["\\end{array}"]), + return(simplode(p)) +); + +mat_solve(A,b,[lstsq]):= block( + if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), + if listp(b) then b: transpose(b), + [m, n]: matrix_size(A), + if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), + vars: rest(stack_var_makelist(tmp,n)), + if lstsq then AT: transpose(A) else AT: ident(m), + eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), + sol: map(rhs,linsolve(eqns,vars)), + if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) +); + +QR(M):= block([cols,Q,R], + if is(rank(M)#second(matrix_size(M))) then return([]), + cols: ev(gramschmidt(transpose(M)),simp), + cols: ev(map(lambda([ex],ex/sqrt(ex.ex)),cols),simp), + Q: transpose(apply(matrix,cols)), + R: ev(transpose(Q).M,simp), + return([Q,R]) +); + +squarep(M):= block( + isSquare: false, + if matrixp(M) then block( + if is(apply("=",matrix_size(M))) then isSquare: true + ), + return(isSquare) +); + +diagonalisablep(M):= block( + if squarep(M) then return(ev(diagp(dispJordan(jordan(M))),simp)) else return(false) +); + +get_Jordan_form(M):= block( + if not(squarep(M)) then return([]), + jordan_info: ev(jordan(M),simp), + J: ev(dispJordan(jordan_info),simp), + P: ev(ModeMatrix(M,jordan_info),simp), + return([P,J]) +); + +sym_p(M):= is(M = ev(transpose(M),simp)); + +diagonalise(M):= block([P,J], + if not(squarep(M)) then return([]), + [P, J]: get_Jordan_form(M), + if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), + if diagp(J) then return([P,J]) else return([]) +); + +SVD_red(M):= block( + if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), + MTM: ev(transpose(M).M,simp), + if atom(MTM) then MTM: matrix([MTM]), + [V, S2]: diagonalise(MTM), + /* TODO: does this work? */ + V: first(QR(V)), + components: ev(makelist([S2[ii,ii],col(V,ii)],ii,1,second(matrix_size(MTM))),simp), + components: ev(reverse(sort(components)),simp), + components: ev(sublist(components,lambda([ex],is(first(ex)#0))),simp), + n: length(components), + S: zeromatrix(n,n), + S[1,1]: ev(sqrt(first(first(components))),simp), + V: second(first(components)), + U: ev(M.V/S[1,1],simp), + if atom(U) then U: matrix([U]), + if is(n>1) then block( + for ii: 2 thru n do block( + ii: ev(ii,simp), + S[ii,ii]: ev(sqrt(first(components[ii])),simp), + V: addcol(V,second(components[ii])), + U: addcol(U,ev(M.second(components[ii])/S[ii,ii],simp)) + ) + ), + return([U,S,transpose(V)]) +); + +pinv(M):= block( + if ev(zeromatrixp(M),simp) then return(M), + [U, S, VT]: SVD_red(M), + return(ev(transpose(VT) . invert(S) . transpose(U),simp)) +); + +basisify(M,[orth]):= block( + if emptyp(orth) then orth: false else orth: first(orth), + if not(lin_indp(M)) then M: remove_dep(M), + [m, n]: matrix_size(M), + vecs: args(transpose(M)), + new_vecs: args(ident(m)), + for ii: 1 thru m do block( + ii: ev(ii,simp), + if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) + ), + if orth then block( + vecs: ev(gramschmidt(apply(matrix,vecs)),simp), + vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) + ), + return(transpose(apply(matrix,vecs))) +); + +SVD(M):= block( + [U, S, VT]: SVD_red(M), + if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), + if is(VT=matrix([])) then VT: ident(second(matrix_size(M))) else VT: transpose(basisify(transpose(VT),true)), + S: diagmatrix_like(diag_entries(S),first(matrix_size(M)),second(matrix_size(M))), + return([U,S,VT]) +); + +invertiblep(M):= block( + isInvertible: false, + if squarep(M) then block( + if ev(is(determinant(M)#0),simp) then isInvertible: true + ), + return(isInvertible) +); + +get_PLU(M):= block( + if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) +); + +unit_vecp(v):= is(ev(v.conjugate(v),simp)=1); + +eigenvectorp(v,M):= block( + if matrixp(v) then block( + if is(first(matrix_size(v))=1) then v: transpose(v) + ) else if listp(v) then v: transpose(v) + else if ntuplep(v) then v: transpose(args(v)), + if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), + return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) +); + +rowspace(M):= ev(columnspace(transpose(M)),simp); +nullTspace(M):= ev(nullspace(transpose(M)),simp); + +lgcd(ex):= block( + ex_gcd: first(ex), + for ii: 2 thru length(ex) do block( + ii: ev(ii,simp), + ex_gcd: gcd(ex_gcd,ex[ii]) + ), + return(ex_gcd) +); + +integerify(v):= block( + v_op: "list", + if matrixp(v) then (v_op: "matrix", v: list_matrix_entries(v)), + v: ev(v/lgcd(v),simp), + if is(v_op="matrix") then return(transpose(v)) else return(v) +); + +alg_mult(M,L):= block( + if squarep(M) then block( + evals: ev(eigenvalues(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(second(evals)[ii]) + ) +); + +geo_mult(M,L):= block( + if squarep(M) then block( + [evals, evects]: ev(eigenvectors(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(length(evects[ii])) + ) +); + +Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); + +orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); +orthonormal_columnsp(M):= is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))); +orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); + +projection_matrix(M):= block( + if ev(zeromatrixp(M),simp) then return(0), + reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), + return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) +); From 0b457f13644d92f1daf47ac1c5bb0f8f3fe564a9 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 4 Apr 2024 13:20:25 +1300 Subject: [PATCH 05/26] Update linearalgebra_no_test.mac Declared `c` and `r` to be nonscalar so that they behave appropriately with other matrices in expressions. --- stack/maxima/contrib/linearalgebra_no_test.mac | 2 ++ 1 file changed, 2 insertions(+) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index 327fe1c14a8..20d73bd468b 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -43,6 +43,8 @@ texput(r, )) ); +declare([c,r],nonscalar); + /* Manually convert student answers to the appropriate vector form. */ /* If vectors do not conform then the original expression is returned. */ vec_convert(ex):= block( From 5c86b68e884d6e675a7a526c69a0fa5819ded713 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 4 Apr 2024 16:21:37 +1300 Subject: [PATCH 06/26] Update linearalgebra_no_test.mac Fixed the vector display functions; they now display the tex-formatted entries rather than just the plaintex (how did I miss this earlier??) --- stack/maxima/contrib/linearalgebra_no_test.mac | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index 20d73bd468b..cca3e764000 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -16,7 +16,7 @@ /****************************************************************/ /* Linear algebra functions for STACK */ /* */ -/* V0.2.1 April 2024 */ +/* V0.2.2 April 2024 */ /* */ /****************************************************************/ @@ -27,7 +27,7 @@ texput(c, lambda([ex], block( ns: args(ex), str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " \\\\ "])), + for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " \\\\ "])), str[length(str)]: " \\end{bmatrix}", simplode(str) )) @@ -37,7 +37,7 @@ texput(r, lambda([ex], block( ns: args(ex), str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " & "])), + for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " & "])), str[length(str)]: " \\end{bmatrix}", simplode(str) )) From 19548453b1b059d6106b4d4383fc99efcb0fef63 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 18 Apr 2024 16:09:39 +1200 Subject: [PATCH 07/26] Update linearalgebra_no_test.mac Prevented divide by zero errors in integerify --- stack/maxima/contrib/linearalgebra_no_test.mac | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index cca3e764000..7633203c76d 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -468,7 +468,8 @@ lgcd(ex):= block( integerify(v):= block( v_op: "list", if matrixp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - v: ev(v/lgcd(v),simp), + tmp: ev(lgcd(v),simp), + if ev(is(tmp#0),simp) then v: ev(v/tmp,simp), if is(v_op="matrix") then return(transpose(v)) else return(v) ); From 125f3b3f2d0d16681a57920c6e38dc731498d50c Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Fri, 19 Apr 2024 12:26:18 +1200 Subject: [PATCH 08/26] Update linearalgebra_no_test.mac Fixed subspace_equiv Added col_vecp and row_vecp --- stack/maxima/contrib/linearalgebra_no_test.mac | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index 7633203c76d..8a07fd6cb94 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -58,6 +58,16 @@ vec_convertedp(ex):= block( if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) ); +col_vecp(ex):= block( + if not(matrixp(ex)) then return(false) + else return(is(second(matrix_size(ex))=1)) +); + +row_vecp(ex):= block( + if not(matrixp(ex)) then return(false) + else return(is(first(matrix_size(ex))=1)) +); + /*********************************************************************************/ /* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ @@ -276,7 +286,7 @@ remove_dep(ex):= block( subspace_equiv(ex,ta):= block( if setp(ex) then ex: listify(ex) else if ntuplep(ex) or safe_op(ex)="span" then ex: args(ex), - if setp(ta) then ex: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), + if setp(ta) then ta: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), ex: map(lambda([ex2],if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), /*ex: remove_dep(ex),*/ ta: map(lambda([ta2],if matrixp(ta2) then list_matrix_entries(ta2) else ta2),ta), From 4e3a9c33dc34baf4e9c283c92113559b93fa490f Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 8 May 2024 11:05:42 +1200 Subject: [PATCH 09/26] Update linearalgebra.mac v0.2 of linearalgebra.mac features most of the functions I expect to use, and test cases for almost all of these functions. It contains: - Convenience functions for student vector input - Various predicate functions for vector and matrix properties - Functions to manipulate/extract parts of matrices - Functions to convert collections of vectors into a locally standard form (currently preferring lists of lists or matrices) - Functions to compare objects, typically checking for independence, or equivalence to subspaces. - Functions to convert collection of vectors to a basis - Extension of significantfigures to work for matrices - Extension of norm and cond functions to use the 2-norm - Extension of linsolve to accept matrix input and optionally use least squares - A function to produce smallest integer vector parallel to given vector (useful for eigenproblems!) - rowspace and nullTspace functions to pair with columnspace and nullspace - Rayleigh quotient calculation - Algebraic and geometric multiplicities of eigenvalues - Computing various matrices and factorisations, including rectangular diagonal matrix, projection matrices, QR, Jordan form, (orthgonal) diagonalisation, SVD, and pseudoinverse. Still to-do: - Possibly write some eigenvalue/eigenvector predicates (need to determine what is actually useful) - Work on the disp_eqns function that produces nice LaTeX for displaying systems of linear equations. - More functions will likely get added (and possibly removed) as work continues on local linear algebra course. --- stack/maxima/contrib/linearalgebra.mac | 817 ++++++++++++++++--------- 1 file changed, 519 insertions(+), 298 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 5769ab9c9c2..3f19138a4cd 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -14,9 +14,9 @@ along with this program. If not, see . */ /****************************************************************/ -/* Linear algebra functions for STACK */ +/* Linear algebra functions for STACK */ /* */ -/* V0.2.1 April 2024 */ +/* V0.2.3 May 2024 */ /* */ /****************************************************************/ @@ -24,43 +24,97 @@ /* Provides convenience functions for column and row vectors for student input */ /*******************************************************************************/ texput(c, - lambda([ex], block( + lambda([ex], block([ns,str,ii], ns: args(ex), str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " \\\\ "])), + for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " \\\\ "])), str[length(str)]: " \\end{bmatrix}", simplode(str) )) ); texput(r, - lambda([ex], block( + lambda([ex], block([ns,str,ii], ns: args(ex), str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(ns[ii],simp), " & "])), + for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " & "])), str[length(str)]: " \\end{bmatrix}", simplode(str) )) ); +declare([c,r],nonscalar); + /* Manually convert student answers to the appropriate vector form. */ /* If vectors do not conform then the original expression is returned. */ -vec_convert(ex):= block( +vec_convert(ex):= block([ex2], ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), if emptyp(ex2) then return(ex) else return(first(ex2)) ); +s_test_case(vec_convert(c(1,2,3)),matrix([1],[2],[3])); +s_test_case(vec_convert(r(1,2,3)),matrix([1,2,3])); +s_test_case(vec_convert(c(1,2,3) + matrix([1],[1],[1])),matrix([1],[2],[3])+matrix([1],[1],[1])); +s_test_case(vec_convert(c(1,2) + r(3,4)),matrix([1],[2])+matrix([3,4]) ); +s_test_case(ev(vec_convert(c(1,2) + r(3,4)),simp),c(1,2) + r(3,4) ); + +/*******************************************************************************/ +/* Predicate functions for vectors */ +/*******************************************************************************/ + /* A predicate to determine whether an expression has been converted to matrix form. */ -vec_convertedp(ex):= block( +vec_convertedp(ex):= block([ex_ops], ex_ops: get_ops(ex), if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) ); +s_test_case(vec_convertedp(c(1,2)),false); +s_test_case(vec_convertedp(r(1,2)),false); +s_test_case(vec_convertedp(vec_convert(c(1,2))),true); +s_test_case(vec_convertedp(ev(vec_convert(c(1,2)+r(3,4)),simp)),false); + +/* Predicates for determining whether a given object is an Mx1 or 1xN matrix (a vector) */ +/* Note: excludes c() and r() by design. Use vec_convert() before these. */ +col_vecp(ex):= block( + if not(matrixp(ex)) then return(false) + else return(is(second(matrix_size(ex))=1)) +); + +row_vecp(ex):= block( + if not(matrixp(ex)) then return(false) + else return(is(first(matrix_size(ex))=1)) +); + +s_test_case(col_vecp(matrix([1],[2])),true); +s_test_case(col_vecp(matrix([1,2])),false); +s_test_case(row_vecp(matrix([1],[2])),false); +s_test_case(row_vecp(matrix([1,2])),true); +s_test_case(col_vecp(c(1,2)),false); +s_test_case(row_vecp(r(1,2)),false); + +vectorp(ex):= col_vecp(ex) or row_vecp(ex); + +s_test_case(vectorp(matrix([1],[2])),true); +s_test_case(vectorp(matrix([1,2])),true); +s_test_case(vectorp(c(1,2)),false); + +/* TODO write function to convert row/col vectors in matrix form to c or r form */ +/* Should be useful for creating teacher answers */ + +/* Predicate to determine whether a given object is a unit vector. */ +unit_vecp(ex):= if vectorp(ex) then is(ev(ex.conjugate(ex),simp)=1) else false; + +s_test_case(unit_vecp(matrix([1],[0])),true); +s_test_case(unit_vecp(matrix([1/sqrt(2),1/sqrt(2)])),true); +s_test_case(unit_vecp(matrix([1],[1])),false); +s_test_case(unit_vecp(c(1,0)),false); /*********************************************************************************/ -/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ +/* Functions to extract parts of matrices */ /*********************************************************************************/ +/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ + triu(M):= block([Mupp,imax,jmax,ii,jj], Mupp: copymatrix(M), [imax, jmax]: ev(matrix_size(M),simp), @@ -78,9 +132,7 @@ s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[0,5,6],[0,0,9] s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])); s_test_case(triu(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])); -/*********************************************************************************/ /* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ -/*********************************************************************************/ tril(M):= transpose(triu(transpose(M))); @@ -88,9 +140,7 @@ s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[4,5,0],[7,8,9] s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])); s_test_case(tril(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])); -/*********************************************************************************/ /* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ -/*********************************************************************************/ get_diag(M):= tril(triu(M)); @@ -98,15 +148,23 @@ s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0, s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); s_test_case(get_diag(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); +/* Extracts the diagonal of a matrix as a list. */ + +diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); + +s_test_case(diag_entries(ident(3)),[1,1,1]); +s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); +s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); + /*********************************************************************************/ -/* Predicate functions about the shape of a matrix */ +/* Predicate functions for matrices */ /*********************************************************************************/ /* Is the matrix upper triangular? */ -triup(M):= is(M = triu(M)); +triup(M):= if matrixp(M) then is(M = triu(M)) else false; /* Is the matrix lower triangular? */ -trilp(M):= is(M = tril(M)); +trilp(M):= if matrixp(M) then is(M = tril(M)) else false; /* Is the matrix diagonal? */ diagp(M):= triup(M) and trilp(M); @@ -132,9 +190,7 @@ s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])),true); s_test_case(trilp(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); s_test_case(trilp(matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])),true); -s_test_case((simp:false,diagp(matrix([1,0],[1-1,1]))),false); - -/* Is the matrix in row echelon form (not reduced)? */ +s_test_case(diagp(matrix([1,0],[1-1,1])),false);/* Is the matrix in row echelon form (not reduced)? */ REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), @@ -171,52 +227,127 @@ s_test_case(REFp(matrix([1,2,3],[0,5,6])),true); s_test_case(REFp(matrix([1,2,3],[4,5,6])),false); s_test_case(REFp(matrix([1,2,3],[0,5,6],[0,8,9])),false); -/*********************************************************************************/ -/* Returns the diagonal of a matrix as a list */ -/*********************************************************************************/ +/* Is a given object a square matrix? */ +squarep(M):= block([isSquare], + isSquare: false, + if matrixp(M) then block( + if is(apply("=",matrix_size(M))) then isSquare: true + ), + return(isSquare) +); -diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); +s_test_case(squarep(ident(4)),true); +s_test_case(squarep(matrix([1],[2])),false); +s_test_case(squarep(matrix([1,2],[2,3])),true); +s_test_case(squarep(1),false); -s_test_case(diag_entries(ident(3)),[1,1,1]); -s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); -s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); +/* Is a given object a diagonalisable matrix? */ +diagonalisablep(M):= if squarep(M) then ev(diagp(dispJordan(jordan(M))),simp) else false; + +s_test_case(diagonalisablep(ident(2)),true); +s_test_case(diagonalisablep(matrix([1,1],[0,1])),false); +s_test_case(diagonalisablep(1),false); +s_test_case(diagonalisablep(matrix([1,1],[1,1])),true); + +/* Is a given object a symmetric matrix? */ +/* NOTE: The native function symmetricp() does the same thing and more, but is currently banned. */ +sym_p(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; + +s_test_case(sym_p(ident(3)),true); +s_test_case(sym_p(matrix([1,1],[0,1])),false); +s_test_case(sym_p(1),false); + +/* Is a given object an invertible matrix? */ +invertiblep(M):= block([isInvertible], + isInvertible: false, + if squarep(M) then block( + if ev(is(determinant(M)#0),simp) then isInvertible: true + ), + return(isInvertible) +); + +s_test_case(invertiblep(ident(2)),true); +s_test_case(invertiblep(matrix([1,1],[0,1])),true); +s_test_case(invertiblep(1),false); +s_test_case(invertiblep(matrix([1,1],[1,1])),false); + +/* Is a given object a matrix with orthogonal columns? */ +orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); + +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1],[1,0])),true); +s_test_case(orthogonal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,2],[1,0])),false); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])),true); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])/sqrt(2)),true); +s_test_case(orthogonal_columnsp(1),false); + +/* Is a given object a matrix with orthonormal columns? */ +orthonormal_columnsp(M):= if matrixp(M) then is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))) else false; + +s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1],[1,0])),false); +s_test_case(orthonormal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); +s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1])),false); +s_test_case(orthonormal_columnsp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); +s_test_case(orthonormal_columnsp(1),false); + +/* Is a given object an orthogonal matrix? */ +orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); + +s_test_case(orth_matrixp(matrix([1,1],[1,-1],[1,0])),false); +s_test_case(orth_matrixp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),false); +s_test_case(orth_matrixp(matrix([1,1],[1,-1])),false); +s_test_case(orth_matrixp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); +s_test_case(orth_matrixp(1),false); /*********************************************************************************/ -/* Returns a diagonal matrix of size m by n with given diagonal */ +/* Functions to convert objects into standard forms */ /*********************************************************************************/ -diagmatrix_like(d, m, n):= block([M,ii], - M: zeromatrix(m, n), - for ii: 1 thru ev(min(m, n, length(d)),simp) do block( - ii: ev(ii,simp), - M[ii,ii]: d[ii] - ), - return(M) +/* It is feasible that different institutions will prefer students to enter their answers in different ways */ +/* linearalgebra.mac prefers to work with either lists of lists (not distinguishing between column and row + vectors) or matrices whose columns are vectors of interest. */ + +/* A function to convert any of the following to a list of lists: + - op may be a list, ntuple, set, span, or matrix (considering its columns) + - elements of the op may be lists, sets, ntuples, matrices, c, or r. */ +make_list_of_lists(ex):= block([op1], + op1: safe_op(ex), + /* TODO: What if given a single vector? */ + if not(member(op1,["[","ntuple","{","span","matrix"])) then return(ex), + ex: vec_convert(ex), + if vectorp(ex) then return([list_matrix_entries(ex)]), + if is(op1="matrix") then return(args(transpose(ex))), + ex: args(ex), + ex: map(lambda([ex2],if vectorp(ex2) then list_matrix_entries(ex2) else args(ex2)),ex), + return(ex) ); -s_test_case(diagmatrix_like([1,1,1],3,3),ident(3)); -s_test_case(diagmatrix_like([1,2,3],3,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0])); -s_test_case(diagmatrix_like([1,2,3],4,3),matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])); -s_test_case(diagmatrix_like([1,2,3],4,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0],[0,0,0,0])); -s_test_case(diagmatrix_like([1,2,3],2,3),matrix([1,0,0],[0,2,0])); -s_test_case(diagmatrix_like([1,2,3],3,2),matrix([1,0],[0,2],[0,0])); +s_test_case(make_list_of_lists(1),1); +s_test_case(make_list_of_lists(matrix([1,3,5])),[[1,3,5]]); +s_test_case(make_list_of_lists(matrix([1,2],[3,4],[5,6])),[[1,3,5],[2,4,6]]); +s_test_case(make_list_of_lists({c(1,2,3),[2,3,4],ntuple(3,4,5),{4,5,6}}),[[1,2,3],[2,3,4],[3,4,5],[4,5,6]]); + +/* Given a list of lists, construct a matrix with the entries as columns. */ +column_stack(ex):= block([ex2], + ex2: errcatch(transpose(apply(matrix,args(ex)))), + if emptyp(ex2) then return(ex2) else return(first(ex2)) +); + +s_test_case(column_stack([[1,2,3],[4,5,6]]),matrix([1,4],[2,5],[3,6])); +s_test_case(column_stack([[1,2,3]]),matrix([1],[2],[3])); +s_test_case(column_stack([1,2,3]),[]); + +/* TODO function to convert list of lists to list of column vectors. */ /*********************************************************************************/ -/* Predicate function to test whether a set of vectors is linearly independent */ +/* Comparison functions */ /*********************************************************************************/ -/* If given a matrix, it checks whether it has full column rank */ -/* If given a list of atoms, it treats it as a single vector and returns true */ -/* If given a list, set, ntuple or span of lists and/or matrices, it converts - the matrices to lists, checks that all lists are the same length, and checks - whether the matrix with these vectors as rows has full row rank */ - -lin_indp(M):= block( - if matrixp(M) then return(is(rank(M) = ev(second(matrix_size(M)),simp))) - else if setp(M) then M: listify(M) - else if ntuplep(M) or safe_op(M)="span" then M: args(M), - if every(atom,M) then return(true), - M: map(lambda([ex], if matrixp(ex) then list_matrix_entries(ex) else ex),M), - if every(lambda([ex],length(ex)=length(first(M))),M) then return(is(rank(apply(matrix,M)) = ev(first(matrix_size(apply(matrix,M))),simp))), + +/* Given a list of lists or a matrix, determine whether the list elements or columns are linearly independent. */ +lin_indp(ex):= block( + if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))) + else ex: column_stack(ex), + if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))), return(false) ); @@ -225,18 +356,98 @@ s_test_case(lin_indp(matrix([1,2,3],[4,5,6],[7,8,9])),false); s_test_case(lin_indp(matrix([1,2,3],[4,5,6])),false); s_test_case(lin_indp([[1,2],[4,5],[7,8]]),false); s_test_case(lin_indp([[1,4,7],[2,5,8]]),true); -s_test_case(lin_indp({[1,2],[4,5],[7,8]}),false); -s_test_case(lin_indp({[1,4,7],[2,5,8]}),true); -s_test_case(lin_indp(ntuple([1,2],[4,5],[7,8])),false); -s_test_case(lin_indp(ntuple([1,4,7],[2,5,8])),true); -s_test_case(lin_indp(span([1,2],[4,5],[7,8])),false); -s_test_case(lin_indp(span([1,4,7],[2,5,8])),true); -s_test_case(lin_indp([transpose([1,4,7]),[2,5,8]]),true); -s_test_case(lin_indp({transpose([1,4,7]),matrix([2,5,8])}),true); +s_test_case(lin_indp(make_list_of_lists({[1,2],[4,5],[7,8]})),false); +s_test_case(lin_indp(make_list_of_lists({[1,4,7],[2,5,8]})),true); +s_test_case(lin_indp(make_list_of_lists(ntuple([1,2],[4,5],[7,8]))),false); +s_test_case(lin_indp(make_list_of_lists(ntuple([1,4,7],[2,5,8]))),true); +s_test_case(lin_indp(make_list_of_lists(span([1,2],[4,5],[7,8]))),false); +s_test_case(lin_indp(make_list_of_lists(span([1,4,7],[2,5,8]))),true); +s_test_case(lin_indp(make_list_of_lists([transpose([1,4,7]),[2,5,8]])),true); +s_test_case(lin_indp(make_list_of_lists({transpose([1,4,7]),matrix([2,5,8])})),true); + +/* Given a pair of matrices, check whether they are row or column equivalent. */ +row_equiv(ex,ta):= block( + if matrixp(ex) and matrixp(ta) then ( + return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) + ) +); + +col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); + +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); + +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); + +/* Given two lists of lists, determine whether they span the same subspace. */ +/* Note: This does not check for redundancies. To check whether two bases are equivalent, + use this function in conjunction with lin_indp. */ + +subspace_equiv(ex,ta):= block([ex_rref,ta_rref], + ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), + ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), + return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +); + +s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0],[0,1]]),true); +s_test_case(subspace_equiv([[1,2],[2,4]],[[1,0],[0,1]]),false); +s_test_case(subspace_equiv([[1,2],[2,3],[3,4]],[[1,0],[0,1]]),true); +s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0]]),false); + +/* TODO: eigenvectorp(v,M). + What is actually useful functionality here? A predicate that checks + whether a given vector is an eigenvector of a given matrix? Should + we check that it corresponds to an optionally given eigenvalue? Do + we want an equivalent eigenvaluep(L,M) function? + +eigenvectorp(v,M):= block( + if matrixp(v) then block( + if is(first(matrix_size(v))=1) then v: transpose(v) + ) else if listp(v) then v: transpose(v) + else if ntuplep(v) then v: transpose(args(v)), + if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), + return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) +); +*/ /*********************************************************************************/ -/* Maps the significantfigures function over a matrix */ +/* Some useful functions to perform routine tasks or extend existing functions */ /*********************************************************************************/ + +/* Given a list of lists or a matrix, remove linearly dependent entries/columns. */ +remove_dep(ex):= block([ex_op,n_max,jj,ii], + ex_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix"), + ex: ev(sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))),simp), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + ii: ev(ii,simp), + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) + else jj: ev(jj+1,simp), + if is(jj>length(ex)) then return(ex) + ), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)), + return(ex) +); + +s_test_case(remove_dep(matrix([0,0])),[]); +s_test_case(remove_dep([[1,0],[0,1],[1,1]]),[[1,0],[0,1]]); +s_test_case(remove_dep([[1,0],[2,0],[1,1]]),[[1,0],[1,1]]); +s_test_case(remove_dep(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2],[4,5],[7,8])); + +/* Map significantfigures over a matrix */ /* Should this be core functionality? Surely when given a matrix the base sigfigsfun or significantfigures function could do this by mapping itself over the arguments and re-constructing the matrix. */ @@ -261,9 +472,26 @@ s_test_case(sf_map(matrix([1/3],[12345]),2),matrix([0.33],[12000])); s_test_case(sf_map(matrix([1/3,12345],[1/4,5/4]),2),matrix([0.33,12000],[0.25,1.3])); s_test_case(sf_map({1/3,1/4},1),{1/3,1/4}); -/*********************************************************************************/ +/* Construct a diagonal matrix of size m by n with diagonal given as a list */ + +diagmatrix_like(d, m, n):= block([M,ii], + M: zeromatrix(m, n), + for ii: 1 thru ev(min(m, n, length(d)),simp) do block( + ii: ev(ii,simp), + M[ii,ii]: d[ii] + ), + return(M) +); + +s_test_case(diagmatrix_like([1,1,1],3,3),ident(3)); +s_test_case(diagmatrix_like([1,2,3],3,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0])); +s_test_case(diagmatrix_like([1,2,3],4,3),matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])); +s_test_case(diagmatrix_like([1,2,3],4,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0],[0,0,0,0])); +s_test_case(diagmatrix_like([1,2,3],2,3),matrix([1,0,0],[0,2,0])); +s_test_case(diagmatrix_like([1,2,3],3,2),matrix([1,0],[0,2],[0,0])); + /* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ -/*********************************************************************************/ + /* I don't know if this has a good use case in a CAS like Maxima. I would happily remove this if this feels out of place, as I don't anticipate using this in my course regularly. */ @@ -284,13 +512,9 @@ s_test_case(mat_norm2(1),und); mat_cond2(M):= block([svs,cond2], cond2: und, - if matrixp(M) then block( - if ev(is(first(matrix_size(M))=second(matrix_size(M))),simp) then block( - if ev(is(determinant(M)#0),simp) then block( - svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), - cond2: ev(lmax(svs)/lmin(svs),simp) - ) - ) + if invertiblep(M) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + cond2: ev(lmax(svs)/lmin(svs),simp) ), return(cond2) ); @@ -302,152 +526,161 @@ s_test_case(mat_cond2(1),und); s_test_case(mat_cond2(matrix([1,1],[1,0],[0,1])),und); s_test_case(mat_cond2(matrix([1,2],[1,2])),und); -/*********************************************************************************/ -/* Is a matrix row or column equivalent to another? */ -/*********************************************************************************/ -/* Note: some behaviour may be unexpected when variables appear in either matrix, - as row/column equivalence is unclear in instances where division by an unknown occurs */ +/* Solve the matrix equation Ax = b given matrix A and column vector (or list) b. */ +/* Optional extra argument: mat_solve(A,b,true) will find the least squares solution symbolically. */ +/* Note that the least squares solution may be non-unique (in the case of linearly dependent columns) */ +/* For minimal least squares solution, use pinv(A) . b (see below) */ +/* Always returns a matrix output. */ -row_equiv(ex,ta):= block( - if matrixp(ex) and matrixp(ta) then ( - return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) - ) +mat_solve(A,b,[lstsq]):= block([m,n,vars,eqns,sol], + if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), + if listp(b) then b: transpose(b), + [m, n]: matrix_size(A), + if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), + vars: rest(stack_var_makelist(tmp,n)), + if lstsq then AT: transpose(A) else AT: ident(m), + eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), + sol: map(rhs,linsolve(eqns,vars)), + if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) ); -col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); +s_test_case(mat_solve(matrix([1,2],[3,4]),[3,7]),matrix([1],[1])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[0,0]),matrix([%r1],[%r1])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0]),matrix([])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0],true),matrix([(2*%r2+1)/2],[%r2])); +s_test_case(mat_solve(matrix([0,0],[1,1]),[1,0],true),matrix([-%r3],[%r3])); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); +/* Given a list of lists or a matrix, make a basis for R^m where m = length of each vector. */ +/* If you don't want to expand to R^m, use remove_dep instead */ +/* Optional input: basisify(ex,true) will make it an orthonormal basis. */ -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); - -remove_dep(ex):= block( - ex_op: "list", - vec_op: "list", - if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") - else if setp(ex) then block(ex: listify(ex), ex_op: "set") - else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") - else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), - if matrixp(first(ex)) then vec_op: "matrix" - else if ntuplep(first(ex)) then vec_op: "ntuple", - ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), - if emptyp(ex) or is(length(ex)=1) then return(ex), - n_max: length(ex), - jj: 2, - for ii: 2 thru n_max do block( - if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,jj-1),lastn(ex,length(ex)-jj)) - else jj: jj+1, - if is(jj>length(ex)) then return(ex) +basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], + if emptyp(orth) then orth: false else orth: first(orth), + ex_op: "matrix", + if listp(M) then block(M: column_stack(M), ex_op: "list"), + if not(lin_indp(M)) then M: remove_dep(M), + [m, n]: matrix_size(M), + vecs: args(transpose(M)), + new_vecs: args(ident(m)), + for ii: 1 thru m do block( + ii: ev(ii,simp), + if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) ), - if is(vec_op="matrix") then ex: map(transpose,ex) - else if is(vec_op="ntuple") then ex: map(ntupleify,ex), - if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) - else if is(ex_op="set") then ex: setify(ex) - else if is(ex_op="ntuple") then ex: ntupleify(ex) - else if is(ex_op="span") then ex: apply(span,ex), - return(ex) + if orth then block( + vecs: ev(gramschmidt(apply(matrix,vecs)),simp), + vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) + ), + if is(ex_op="matrix") then return(transpose(apply(matrix,vecs))) else return(vecs) ); -remove_dep(ex):= block( - ex_op: "list", - vec_op: "list", - if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") - else if setp(ex) then block(ex: listify(ex), ex_op: "set") - else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") - else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), - if matrixp(first(ex)) then vec_op: "matrix" - else if ntuplep(first(ex)) then vec_op: "ntuple", - ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), - if emptyp(ex) or is(length(ex)=1) then return(ex), - n_max: length(ex), - jj: 2, - for ii: 2 thru n_max do block( +s_test_case(basisify(matrix([1,2],[0,0],[0,0])),ident(3)); +s_test_case(basisify(matrix([1,2],[1,2],[0,0])),matrix([1,1,0],[1,0,0],[0,0,1])); +s_test_case(basisify([[1,1,0],[2,2,0]],true),[[1/sqrt(2),1/sqrt(2),0],[1/sqrt(2),-(1/sqrt(2)),0],[0,0,1]]); + +/* Maps the gcd (greatest common divisor) function across a list */ +lgcd(ex):= block([ex_gcd,ii], + ex_gcd: first(ex), + for ii: 2 thru length(ex) do block( ii: ev(ii,simp), - if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) - else jj: ev(jj+1,simp), - if is(jj>length(ex)) then return(ex) + ex_gcd: gcd(ex_gcd,ex[ii]) ), - if is(vec_op="matrix") then ex: map(transpose,ex) - else if is(vec_op="ntuple") then ex: map(ntupleify,ex), - if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) - else if is(ex_op="set") then ex: setify(ex) - else if is(ex_op="ntuple") then ex: ntupleify(ex) - else if is(ex_op="span") then ex: apply(span,ex), - return(ex) + return(ex_gcd) ); -subspace_equiv(ex,ta):= block( - if setp(ex) then ex: listify(ex) else if ntuplep(ex) or safe_op(ex)="span" then ex: args(ex), - if setp(ta) then ex: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), - ex: map(lambda([ex2],if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - /*ex: remove_dep(ex),*/ - ta: map(lambda([ta2],if matrixp(ta2) then list_matrix_entries(ta2) else ta2),ta), - /*ta: remove_dep(ta),z*/ - /*return(row_equiv(apply(matrix,ex),apply(matrix,ta)))*/ - ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), - ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), - return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +s_test_case(lgcd([9,12,27]),3); +s_test_case(lgcd([-9,-12,-27]),3); +s_test_case(lgcd([1/2,1/4,5/6]),1/12); + +/* Given a vector (or list) return the shortest possible parallel vector with integer entries. */ +integerify(v):= block([v_op], + v_op: "list", + if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), + v: ev(v/lgcd(v),simp), + if ev(every(lambda([ex],is(signum(ex)=-1)),v),simp) then v: ev(-v,simp), + if is(v_op="matrix") then return(transpose(v)) else return(v) ); -/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ -s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ -s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ -one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ -delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ +s_test_case(integerify([9,12,27]),[3,4,9]); +s_test_case(integerify(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); +s_test_case(integerify([1/2,1/4,-5/6]),[6,3,-10]); -/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ -/* local variable p will be a gradually growing list of strings that eventually get stitched together */ -disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], - n: length(eqns), /* n = number of equations */ - m: length(vars), /* m = number of variables */ - p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ - p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ - for ii: 1 thru n do block( - ii: ev(ii,simp), - pivot: false, /* each row will have a pivot, assume false until we find it */ - v: vars[1], /* v is the variable we are looking at in this column */ - a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ - if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ - /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ - if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), - for jj: 2 thru m do block( - jj: ev(jj,simp), - v: vars[jj], - a: ev(coeff(lhs(eqns[ii]),v),simp), - if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), - if is(a#0) and not(pivot) then pivot: true - ), - p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), - if is(ii#n) then p: append(p,["\\\\"]) - ), - p: append(p,["\\end{array}"]), - return(simplode(p)) +/* We have columnspace and nullspace functions already. The author keeps assuming that + rowspace must exist too, but it doesn't. The nullTspace function was added for + completeness' sake, and finds the nullspace of M^T. We could call it the cokernel + function, but since maxima uses nullspace rather than kernel this feels inappropriate. */ + +rowspace(M):= ev(columnspace(transpose(M)),simp); +nullTspace(M):= ev(nullspace(transpose(M)),simp); + +s_test_case(rowspace(ident(2)),span(matrix([1],[0]),matrix([0],[1]))); +s_test_case(rowspace(matrix([1,0],[0,1],[1,1])),span(matrix([1],[0]),matrix([0],[1]))); +s_test_case(nullTspace(matrix([1,0],[0,1],[1,1])),span(matrix([-1],[-1],[1]))); + +/* Computes the Rayleigh quotient */ +Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); + +s_test_case(Rayleigh(matrix([1,1],[1,1]),matrix([1],[1])),2); +s_test_case(Rayleigh(matrix([1,1],[0,1]),matrix([1],[1])),3/2); +s_test_case(Rayleigh(matrix([0,-1],[1,0]),matrix([%i],[2])),(4*%i)/5); + +/* Compute the algebraic and geometric multiplicity of an eigenvalue. */ +/* Returns 0 if L is not an eigenvalue of M. */ +alg_mult(M,L):= block([evals,ii], + if squarep(M) then block( + evals: ev(eigenvalues(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(second(evals)[ii]) + ) ); -mat_solve(A,b,[lstsq]):= block( - if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), - if listp(b) then b: transpose(b), - [m, n]: matrix_size(A), - if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), - vars: rest(stack_var_makelist(tmp,n)), - if lstsq then AT: transpose(A) else AT: ident(m), - eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), - sol: map(rhs,linsolve(eqns,vars)), - if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) +geo_mult(M,L):= block([evals,evects,ii], + if squarep(M) then block( + [evals, evects]: ev(eigenvectors(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(length(evects[ii])) + ) ); +s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),3); +s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),2); +s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); +s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); +s_test_case(alg_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); +s_test_case(geo_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); + +/* Find the matrix that projects orthogonally onto the column space of M */ +projection_matrix(M):= block([reduced_M], + if ev(zeromatrixp(M),simp) then return(0), + reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), + return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) +); + +s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,10])),ident(3)); +s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([5/6,1/3,-(1/6)],[1/3,1/3,1/3],[-(1/6),1/3,5/6])); + +/*********************************************************************************/ +/* Matrix factorisations */ +/*********************************************************************************/ + +/* Overall notes: + - These are in no way efficient functions, but seem to be fine for small + matrices with carefully deployed variants. + - I'm not convinced these add much to the package, but it felt wrong to not + include them in a linear algebra package. + - In most cases, teachers should begin with the factorisation, compute the + original matrix, and ask students to work backwards to your KNOWN answer. +*/ + +/* PM = LU */ +/* The built-in functions throw errors at annoying times and require two function calls. */ +/* TODO: Surely we can make a better function that works for singular and/or rectangular matrices? */ +/* get_PLU(M):= block( + if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) +); */ + +/* M = QR */ QR(M):= block([cols,Q,R], if is(rank(M)#second(matrix_size(M))) then return([]), cols: ev(gramschmidt(transpose(M)),simp), @@ -457,19 +690,13 @@ QR(M):= block([cols,Q,R], return([Q,R]) ); -squarep(M):= block( - isSquare: false, - if matrixp(M) then block( - if is(apply("=",matrix_size(M))) then isSquare: true - ), - return(isSquare) -); - -diagonalisablep(M):= block( - if squarep(M) then return(ev(diagp(dispJordan(jordan(M))),simp)) else return(false) -); +s_test_case(QR(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3])),[matrix([1/2,1/2,1/2],[1/2,-(1/2),-(1/2)],[1/2,-(1/2),1/2],[1/2,1/2,-(1/2)]),matrix([2,4,5],[0,2,3],[0,0,2])]); +s_test_case(QR(matrix([1,1],[2,2])),[]); -get_Jordan_form(M):= block( +/* M = P.J.P^^-1 */ +/* This really just calls existing functions in one go + and avoids annoying errors. */ +get_Jordan_form(M):= block([jordan_info,J,P], if not(squarep(M)) then return([]), jordan_info: ev(jordan(M),simp), J: ev(dispJordan(jordan_info),simp), @@ -477,16 +704,32 @@ get_Jordan_form(M):= block( return([P,J]) ); -sym_p(M):= is(M = ev(transpose(M),simp)); +s_test_case(get_Jordan_form(1),[]); +s_test_case(get_Jordan_form(matrix([1,2])),[]); +s_test_case(get_Jordan_form(matrix([1,1],[0,1])),[ident(2),matrix([1,1],[0,1])]); +s_test_case(get_Jordan_form(matrix([1,2],[2,3])),[matrix([1,1],[-((sqrt(5)-1)/2),(sqrt(5)+1)/2]),matrix([2-sqrt(5),0],[0,sqrt(5)+2])]); +s_test_case(get_Jordan_form(matrix([8,-3],[12,-4])),[matrix([6,1],[12,0]),matrix([2,1],[0,2])]); -diagonalise(M):= block([P,J], +/* M = P.D.P^^-1 */ +/* If M is symmetric it will automatically orthogonally diagonalise */ +diagonalise(M):= block([P,D], if not(squarep(M)) then return([]), - [P, J]: get_Jordan_form(M), + [P, D]: get_Jordan_form(M), if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), - if diagp(J) then return([P,J]) else return([]) + if diagp(D) then return([P,D]) else return([]) ); -SVD_red(M):= block( +s_test_case(diagonalise(1),[]); +s_test_case(diagonalise(matrix([1,2])),[]); +s_test_case(diagonalise(matrix([8,-3],[12,-4])),[]); +s_test_case(diagonalise(matrix([1,2],[3,4])),[matrix([1,1],[-(sqrt(33)-3)/4,(sqrt(33)+3)/4]),matrix([-(sqrt(33)-5)/2,0],[0,(sqrt(33)+5)/2])]); +s_test_case(diagonalise(matrix([1,2],[2,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-1/sqrt(2)]),matrix([3,0],[0,-1])]); +s_test_case(diagonalise(matrix([1,2],[1,2])),[matrix([1,1],[-1/2,1]),matrix([0,0],[0,3])]); +s_test_case(diagonalise(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[-1/sqrt(2),1/sqrt(2)]),matrix([0,0],[0,2])]); + +/* Reduced SVD */ +/* Always produces minimum required diagonal Sigma and associated U and V. */ +SVD_red(M):= block([MTM,V,S2,components,n,S,U,ii], if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), MTM: ev(transpose(M).M,simp), if atom(MTM) then MTM: matrix([MTM]), @@ -513,30 +756,28 @@ SVD_red(M):= block( return([U,S,transpose(V)]) ); -pinv(M):= block( +s_test_case(SVD_red(matrix([0,0],[0,0])),[matrix([]),matrix([]),matrix([])]); +s_test_case(SVD_red(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); +s_test_case(SVD_red(matrix([1,1],[1,1])),[matrix([1/sqrt(2)],[1/sqrt(2)]),matrix([2]),matrix([1/sqrt(2),1/sqrt(2)])]); +s_test_case(SVD_red(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0],[1/sqrt(6),1/sqrt(2)],[1/sqrt(6),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD_red(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)])]); + +/* M^+ = V.S^+.U^T */ +/* Moore-penrose pseudoinverse. I'm convinced this routine exists somewhere in a package, + because I've used it before in other maxima terminals, but I was unable to find it. */ +pinv(M):= block([U,S,VT], if ev(zeromatrixp(M),simp) then return(M), [U, S, VT]: SVD_red(M), return(ev(transpose(VT) . invert(S) . transpose(U),simp)) ); -basisify(M,[orth]):= block( - if emptyp(orth) then orth: false else orth: first(orth), - if not(lin_indp(M)) then M: remove_dep(M), - [m, n]: matrix_size(M), - vecs: args(transpose(M)), - new_vecs: args(ident(m)), - for ii: 1 thru m do block( - ii: ev(ii,simp), - if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) - ), - if orth then block( - vecs: ev(gramschmidt(apply(matrix,vecs)),simp), - vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) - ), - return(transpose(apply(matrix,vecs))) -); +s_test_case(pinv(matrix([0,0],[0,0])),matrix([0,0],[0,0])); +s_test_case(pinv(matrix([1,1],[1,1])),matrix([1/4,1/4],[1/4,1/4])); +s_test_case(pinv(matrix([1,0],[0,1],[1,1])),matrix([2/3,-(1/3),1/3],[-(1/3),2/3,1/3])); +s_test_case(pinv(matrix([1,0,1],[0,1,1])),matrix([2/3,-(1/3)],[-(1/3),2/3],[1/3,1/3])); -SVD(M):= block( +/* Full SVD */ +SVD(M):= block([U,S,VT], [U, S, VT]: SVD_red(M), if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), if is(VT=matrix([])) then VT: ident(second(matrix_size(M))) else VT: transpose(basisify(transpose(VT),true)), @@ -544,74 +785,54 @@ SVD(M):= block( return([U,S,VT]) ); -invertiblep(M):= block( - isInvertible: false, - if squarep(M) then block( - if ev(is(determinant(M)#0),simp) then isInvertible: true - ), - return(isInvertible) -); - -get_PLU(M):= block( - if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) -); +s_test_case(SVD(matrix([0,0],[0,0])),[matrix([1,0],[0,1]),matrix([0,0],[0,0]),matrix([1,0],[0,1])]); +s_test_case(SVD(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); +s_test_case(SVD(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([2,0],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0,1/sqrt(3)],[1/sqrt(6),1/sqrt(2),-(1/sqrt(3))],[1/sqrt(6),-(1/sqrt(2)),-(1/sqrt(3))]),matrix([sqrt(3),0],[0,1],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0,0],[0,1,0]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)],[1/sqrt(3),-(1/sqrt(3)),-(1/sqrt(3))])]); -unit_vecp(v):= is(ev(v.conjugate(v),simp)=1); +/*********************************************************************************/ +/* Automatically formats a system of linear equations */ +/*********************************************************************************/ -eigenvectorp(v,M):= block( - if matrixp(v) then block( - if is(first(matrix_size(v))=1) then v: transpose(v) - ) else if listp(v) then v: transpose(v) - else if ntuplep(v) then v: transpose(args(v)), - if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), - return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) -); +/* TODO: + - Needs another pass to fix 0 = 0 equations + - Perhaps we want an extra function that takes A, x and b for matrix A, + symbolic vector x, and constant vector b and then runs this? + - Doesn't have s_test_case yet because the string output will be ridiculous +*/ -rowspace(M):= ev(columnspace(transpose(M)),simp); -nullTspace(M):= ev(nullspace(transpose(M)),simp); +/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ +s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ +s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ +one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ +delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ -lgcd(ex):= block( - ex_gcd: first(ex), - for ii: 2 thru length(ex) do block( +/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ +/* local variable p will be a gradually growing list of strings that eventually get stitched together */ +disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], + n: length(eqns), /* n = number of equations */ + m: length(vars), /* m = number of variables */ + p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ + p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ + for ii: 1 thru n do block( ii: ev(ii,simp), - ex_gcd: gcd(ex_gcd,ex[ii]) + pivot: false, /* each row will have a pivot, assume false until we find it */ + v: vars[1], /* v is the variable we are looking at in this column */ + a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ + if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ + /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ + if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), + for jj: 2 thru m do block( + jj: ev(jj,simp), + v: vars[jj], + a: ev(coeff(lhs(eqns[ii]),v),simp), + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if is(a#0) and not(pivot) then pivot: true + ),/*TODO: what about 0=0? Currently displays as "=0"*/ + p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), + if is(ii#n) then p: append(p,["\\\\"]) ), - return(ex_gcd) -); - -integerify(v):= block( - v_op: "list", - if matrixp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - v: ev(v/lgcd(v),simp), - if is(v_op="matrix") then return(transpose(v)) else return(v) -); - -alg_mult(M,L):= block( - if squarep(M) then block( - evals: ev(eigenvalues(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(second(evals)[ii]) - ) -); - -geo_mult(M,L):= block( - if squarep(M) then block( - [evals, evects]: ev(eigenvectors(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(length(evects[ii])) - ) -); - -Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); - -orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); -orthonormal_columnsp(M):= is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))); -orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); - -projection_matrix(M):= block( - if ev(zeromatrixp(M),simp) then return(0), - reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), - return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) + p: append(p,["\\end{array}"]), + return(simplode(p)) ); From 69bf4bc242c2d67a40042cdbc5813bc081f91f2d Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 8 May 2024 14:40:22 +1200 Subject: [PATCH 10/26] Update linearalgebra_no_test.mac Copy of linearalgebra.mac v0.2.3 (committed 8th May 2024) with the s_test_case lines removed. --- .../maxima/contrib/linearalgebra_no_test.mac | 592 ++++++++++-------- 1 file changed, 323 insertions(+), 269 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index 8a07fd6cb94..b138895bc55 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -14,9 +14,9 @@ along with this program. If not, see . */ /****************************************************************/ -/* Linear algebra functions for STACK */ +/* Linear algebra functions for STACK */ /* */ -/* V0.2.2 April 2024 */ +/* V0.2.3 May 2024 */ /* */ /****************************************************************/ @@ -24,7 +24,7 @@ /* Provides convenience functions for column and row vectors for student input */ /*******************************************************************************/ texput(c, - lambda([ex], block( + lambda([ex], block([ns,str,ii], ns: args(ex), str: ["\\begin{bmatrix} "], for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " \\\\ "])), @@ -34,7 +34,7 @@ texput(c, ); texput(r, - lambda([ex], block( + lambda([ex], block([ns,str,ii], ns: args(ex), str: ["\\begin{bmatrix} "], for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " & "])), @@ -47,17 +47,23 @@ declare([c,r],nonscalar); /* Manually convert student answers to the appropriate vector form. */ /* If vectors do not conform then the original expression is returned. */ -vec_convert(ex):= block( +vec_convert(ex):= block([ex2], ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), if emptyp(ex2) then return(ex) else return(first(ex2)) ); +/*******************************************************************************/ +/* Predicate functions for vectors */ +/*******************************************************************************/ + /* A predicate to determine whether an expression has been converted to matrix form. */ -vec_convertedp(ex):= block( +vec_convertedp(ex):= block([ex_ops], ex_ops: get_ops(ex), if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) ); +/* Predicates for determining whether a given object is an Mx1 or 1xN matrix (a vector) */ +/* Note: excludes c() and r() by design. Use vec_convert() before these. */ col_vecp(ex):= block( if not(matrixp(ex)) then return(false) else return(is(second(matrix_size(ex))=1)) @@ -68,11 +74,20 @@ row_vecp(ex):= block( else return(is(first(matrix_size(ex))=1)) ); +vectorp(ex):= col_vecp(ex) or row_vecp(ex); + +/* TODO write function to convert row/col vectors in matrix form to c or r form */ +/* Should be useful for creating teacher answers */ + +/* Predicate to determine whether a given object is a unit vector. */ +unit_vecp(ex):= if vectorp(ex) then is(ev(ex.conjugate(ex),simp)=1) else false; /*********************************************************************************/ -/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ +/* Functions to extract parts of matrices */ /*********************************************************************************/ +/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ + triu(M):= block([Mupp,imax,jmax,ii,jj], Mupp: copymatrix(M), [imax, jmax]: ev(matrix_size(M),simp), @@ -86,33 +101,31 @@ triu(M):= block([Mupp,imax,jmax,ii,jj], return(Mupp) ); -/*********************************************************************************/ /* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ -/*********************************************************************************/ tril(M):= transpose(triu(transpose(M))); -/*********************************************************************************/ /* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ -/*********************************************************************************/ get_diag(M):= tril(triu(M)); +/* Extracts the diagonal of a matrix as a list. */ + +diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); + /*********************************************************************************/ -/* Predicate functions about the shape of a matrix */ +/* Predicate functions for matrices */ /*********************************************************************************/ /* Is the matrix upper triangular? */ -triup(M):= is(M = triu(M)); +triup(M):= if matrixp(M) then is(M = triu(M)) else false; /* Is the matrix lower triangular? */ -trilp(M):= is(M = tril(M)); +trilp(M):= if matrixp(M) then is(M = tril(M)) else false; /* Is the matrix diagonal? */ diagp(M):= triup(M) and trilp(M); -/* Is the matrix in row echelon form (not reduced)? */ - REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), isREF: true, @@ -134,47 +147,141 @@ REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], return(isREF) ); -/*********************************************************************************/ -/* Returns the diagonal of a matrix as a list */ -/*********************************************************************************/ +/* Is a given object a square matrix? */ +squarep(M):= block([isSquare], + isSquare: false, + if matrixp(M) then block( + if is(apply("=",matrix_size(M))) then isSquare: true + ), + return(isSquare) +); -diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); +/* Is a given object a diagonalisable matrix? */ +diagonalisablep(M):= if squarep(M) then ev(diagp(dispJordan(jordan(M))),simp) else false; + +/* Is a given object a symmetric matrix? */ +/* NOTE: The native function symmetricp() does the same thing and more, but is currently banned. */ +sym_p(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; + +/* Is a given object an invertible matrix? */ +invertiblep(M):= block([isInvertible], + isInvertible: false, + if squarep(M) then block( + if ev(is(determinant(M)#0),simp) then isInvertible: true + ), + return(isInvertible) +); + +/* Is a given object a matrix with orthogonal columns? */ +orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); + +/* Is a given object a matrix with orthonormal columns? */ +orthonormal_columnsp(M):= if matrixp(M) then is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))) else false; + +/* Is a given object an orthogonal matrix? */ +orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); /*********************************************************************************/ -/* Returns a diagonal matrix of size m by n with given diagonal */ +/* Functions to convert objects into standard forms */ /*********************************************************************************/ -diagmatrix_like(d, m, n):= block([M,ii], - M: zeromatrix(m, n), - for ii: 1 thru ev(min(m, n, length(d)),simp) do block( - ii: ev(ii,simp), - M[ii,ii]: d[ii] - ), - return(M) +/* It is feasible that different institutions will prefer students to enter their answers in different ways */ +/* linearalgebra.mac prefers to work with either lists of lists (not distinguishing between column and row + vectors) or matrices whose columns are vectors of interest. */ + +/* A function to convert any of the following to a list of lists: + - op may be a list, ntuple, set, span, or matrix (considering its columns) + - elements of the op may be lists, sets, ntuples, matrices, c, or r. */ +make_list_of_lists(ex):= block([op1], + op1: safe_op(ex), + /* TODO: What if given a single vector? */ + if not(member(op1,["[","ntuple","{","span","matrix"])) then return(ex), + ex: vec_convert(ex), + if vectorp(ex) then return([list_matrix_entries(ex)]), + if is(op1="matrix") then return(args(transpose(ex))), + ex: args(ex), + ex: map(lambda([ex2],if vectorp(ex2) then list_matrix_entries(ex2) else args(ex2)),ex), + return(ex) +); + +/* Given a list of lists, construct a matrix with the entries as columns. */ +column_stack(ex):= block([ex2], + ex2: errcatch(transpose(apply(matrix,args(ex)))), + if emptyp(ex2) then return(ex2) else return(first(ex2)) ); +/* TODO function to convert list of lists to list of column vectors. */ + /*********************************************************************************/ -/* Predicate function to test whether a set of vectors is linearly independent */ +/* Comparison functions */ /*********************************************************************************/ -/* If given a matrix, it checks whether it has full column rank */ -/* If given a list of atoms, it treats it as a single vector and returns true */ -/* If given a list, set, ntuple or span of lists and/or matrices, it converts - the matrices to lists, checks that all lists are the same length, and checks - whether the matrix with these vectors as rows has full row rank */ - -lin_indp(M):= block( - if matrixp(M) then return(is(rank(M) = ev(second(matrix_size(M)),simp))) - else if setp(M) then M: listify(M) - else if ntuplep(M) or safe_op(M)="span" then M: args(M), - if every(atom,M) then return(true), - M: map(lambda([ex], if matrixp(ex) then list_matrix_entries(ex) else ex),M), - if every(lambda([ex],length(ex)=length(first(M))),M) then return(is(rank(apply(matrix,M)) = ev(first(matrix_size(apply(matrix,M))),simp))), + +/* Given a list of lists or a matrix, determine whether the list elements or columns are linearly independent. */ +lin_indp(ex):= block( + if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))) + else ex: column_stack(ex), + if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))), return(false) ); +/* Given a pair of matrices, check whether they are row or column equivalent. */ +row_equiv(ex,ta):= block( + if matrixp(ex) and matrixp(ta) then ( + return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) + ) +); + +col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); + +/* Given two lists of lists, determine whether they span the same subspace. */ +/* Note: This does not check for redundancies. To check whether two bases are equivalent, + use this function in conjunction with lin_indp. */ + +subspace_equiv(ex,ta):= block([ex_rref,ta_rref], + ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), + ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), + return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +); + +/* TODO: eigenvectorp(v,M). + What is actually useful functionality here? A predicate that checks + whether a given vector is an eigenvector of a given matrix? Should + we check that it corresponds to an optionally given eigenvalue? Do + we want an equivalent eigenvaluep(L,M) function? + +eigenvectorp(v,M):= block( + if matrixp(v) then block( + if is(first(matrix_size(v))=1) then v: transpose(v) + ) else if listp(v) then v: transpose(v) + else if ntuplep(v) then v: transpose(args(v)), + if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), + return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) +); +*/ + /*********************************************************************************/ -/* Maps the significantfigures function over a matrix */ +/* Some useful functions to perform routine tasks or extend existing functions */ /*********************************************************************************/ + +/* Given a list of lists or a matrix, remove linearly dependent entries/columns. */ +remove_dep(ex):= block([ex_op,n_max,jj,ii], + ex_op: "list", + if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix"), + ex: ev(sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))),simp), + if emptyp(ex) or is(length(ex)=1) then return(ex), + n_max: length(ex), + jj: 2, + for ii: 2 thru n_max do block( + ii: ev(ii,simp), + if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) + else jj: ev(jj+1,simp), + if is(jj>length(ex)) then return(ex) + ), + if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)), + return(ex) +); + +/* Map significantfigures over a matrix */ /* Should this be core functionality? Surely when given a matrix the base sigfigsfun or significantfigures function could do this by mapping itself over the arguments and re-constructing the matrix. */ @@ -186,9 +293,19 @@ sf_map(ex,n):= block([rows], else return(ex) ); -/*********************************************************************************/ +/* Construct a diagonal matrix of size m by n with diagonal given as a list */ + +diagmatrix_like(d, m, n):= block([M,ii], + M: zeromatrix(m, n), + for ii: 1 thru ev(min(m, n, length(d)),simp) do block( + ii: ev(ii,simp), + M[ii,ii]: d[ii] + ), + return(M) +); + /* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ -/*********************************************************************************/ + /* I don't know if this has a good use case in a CAS like Maxima. I would happily remove this if this feels out of place, as I don't anticipate using this in my course regularly. */ @@ -202,148 +319,132 @@ mat_norm2(M):= block([svs], mat_cond2(M):= block([svs,cond2], cond2: und, - if matrixp(M) then block( - if ev(is(first(matrix_size(M))=second(matrix_size(M))),simp) then block( - if ev(is(determinant(M)#0),simp) then block( - svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), - cond2: ev(lmax(svs)/lmin(svs),simp) - ) - ) + if invertiblep(M) then block( + svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), + cond2: ev(lmax(svs)/lmin(svs),simp) ), return(cond2) ); -/*********************************************************************************/ -/* Is a matrix row or column equivalent to another? */ -/*********************************************************************************/ -/* Note: some behaviour may be unexpected when variables appear in either matrix, - as row/column equivalence is unclear in instances where division by an unknown occurs */ +/* Solve the matrix equation Ax = b given matrix A and column vector (or list) b. */ +/* Optional extra argument: mat_solve(A,b,true) will find the least squares solution symbolically. */ +/* Note that the least squares solution may be non-unique (in the case of linearly dependent columns) */ +/* For minimal least squares solution, use pinv(A) . b (see below) */ +/* Always returns a matrix output. */ -row_equiv(ex,ta):= block( - if matrixp(ex) and matrixp(ta) then ( - return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) - ) +mat_solve(A,b,[lstsq]):= block([m,n,vars,eqns,sol], + if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), + if listp(b) then b: transpose(b), + [m, n]: matrix_size(A), + if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), + vars: rest(stack_var_makelist(tmp,n)), + if lstsq then AT: transpose(A) else AT: ident(m), + eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), + sol: map(rhs,linsolve(eqns,vars)), + if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) ); -col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); +/* Given a list of lists or a matrix, make a basis for R^m where m = length of each vector. */ +/* If you don't want to expand to R^m, use remove_dep instead */ +/* Optional input: basisify(ex,true) will make it an orthonormal basis. */ -remove_dep(ex):= block( - ex_op: "list", - vec_op: "list", - if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") - else if setp(ex) then block(ex: listify(ex), ex_op: "set") - else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") - else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), - if matrixp(first(ex)) then vec_op: "matrix" - else if ntuplep(first(ex)) then vec_op: "ntuple", - ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), - if emptyp(ex) or is(length(ex)=1) then return(ex), - n_max: length(ex), - jj: 2, - for ii: 2 thru n_max do block( - if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,jj-1),lastn(ex,length(ex)-jj)) - else jj: jj+1, - if is(jj>length(ex)) then return(ex) +basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], + if emptyp(orth) then orth: false else orth: first(orth), + ex_op: "matrix", + if listp(M) then block(M: column_stack(M), ex_op: "list"), + if not(lin_indp(M)) then M: remove_dep(M), + [m, n]: matrix_size(M), + vecs: args(transpose(M)), + new_vecs: args(ident(m)), + for ii: 1 thru m do block( + ii: ev(ii,simp), + if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) ), - if is(vec_op="matrix") then ex: map(transpose,ex) - else if is(vec_op="ntuple") then ex: map(ntupleify,ex), - if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) - else if is(ex_op="set") then ex: setify(ex) - else if is(ex_op="ntuple") then ex: ntupleify(ex) - else if is(ex_op="span") then ex: apply(span,ex), - return(ex) + if orth then block( + vecs: ev(gramschmidt(apply(matrix,vecs)),simp), + vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) + ), + if is(ex_op="matrix") then return(transpose(apply(matrix,vecs))) else return(vecs) ); -remove_dep(ex):= block( - ex_op: "list", - vec_op: "list", - if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix") - else if setp(ex) then block(ex: listify(ex), ex_op: "set") - else if ntuplep(ex) then block(ex: args(ex), ex_op: "ntuple") - else if is(safe_op(ex)="span") then block(ex: args(ex), ex_op: "span"), - if matrixp(first(ex)) then vec_op: "matrix" - else if ntuplep(first(ex)) then vec_op: "ntuple", - ex: map(lambda([ex2], if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - ex: sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))), - if emptyp(ex) or is(length(ex)=1) then return(ex), - n_max: length(ex), - jj: 2, - for ii: 2 thru n_max do block( +/* Maps the gcd (greatest common divisor) function across a list */ +lgcd(ex):= block([ex_gcd,ii], + ex_gcd: first(ex), + for ii: 2 thru length(ex) do block( ii: ev(ii,simp), - if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) - else jj: ev(jj+1,simp), - if is(jj>length(ex)) then return(ex) + ex_gcd: gcd(ex_gcd,ex[ii]) ), - if is(vec_op="matrix") then ex: map(transpose,ex) - else if is(vec_op="ntuple") then ex: map(ntupleify,ex), - if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)) - else if is(ex_op="set") then ex: setify(ex) - else if is(ex_op="ntuple") then ex: ntupleify(ex) - else if is(ex_op="span") then ex: apply(span,ex), - return(ex) + return(ex_gcd) ); -subspace_equiv(ex,ta):= block( - if setp(ex) then ex: listify(ex) else if ntuplep(ex) or safe_op(ex)="span" then ex: args(ex), - if setp(ta) then ta: listify(ta) else if ntuplep(ta) or safe_op(ta)="span" then ta: args(ta), - ex: map(lambda([ex2],if matrixp(ex2) then list_matrix_entries(ex2) else ex2),ex), - /*ex: remove_dep(ex),*/ - ta: map(lambda([ta2],if matrixp(ta2) then list_matrix_entries(ta2) else ta2),ta), - /*ta: remove_dep(ta),z*/ - /*return(row_equiv(apply(matrix,ex),apply(matrix,ta)))*/ - ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), - ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), - return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) +/* Given a vector (or list) return the shortest possible parallel vector with integer entries. */ +integerify(v):= block([v_op], + v_op: "list", + if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), + v: ev(v/lgcd(v),simp), + if ev(every(lambda([ex],is(signum(ex)=-1)),v),simp) then v: ev(-v,simp), + if is(v_op="matrix") then return(transpose(v)) else return(v) ); -/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ -s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ -s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ -one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ -delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ +/* We have columnspace and nullspace functions already. The author keeps assuming that + rowspace must exist too, but it doesn't. The nullTspace function was added for + completeness' sake, and finds the nullspace of M^T. We could call it the cokernel + function, but since maxima uses nullspace rather than kernel this feels inappropriate. */ -/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ -/* local variable p will be a gradually growing list of strings that eventually get stitched together */ -disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], - n: length(eqns), /* n = number of equations */ - m: length(vars), /* m = number of variables */ - p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ - p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ - for ii: 1 thru n do block( - ii: ev(ii,simp), - pivot: false, /* each row will have a pivot, assume false until we find it */ - v: vars[1], /* v is the variable we are looking at in this column */ - a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ - if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ - /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ - if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), - for jj: 2 thru m do block( - jj: ev(jj,simp), - v: vars[jj], - a: ev(coeff(lhs(eqns[ii]),v),simp), - if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), - if is(a#0) and not(pivot) then pivot: true - ), - p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), - if is(ii#n) then p: append(p,["\\\\"]) - ), - p: append(p,["\\end{array}"]), - return(simplode(p)) +rowspace(M):= ev(columnspace(transpose(M)),simp); +nullTspace(M):= ev(nullspace(transpose(M)),simp); + +/* Computes the Rayleigh quotient */ +Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); + +/* Compute the algebraic and geometric multiplicity of an eigenvalue. */ +/* Returns 0 if L is not an eigenvalue of M. */ +alg_mult(M,L):= block([evals,ii], + if squarep(M) then block( + evals: ev(eigenvalues(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(second(evals)[ii]) + ) ); -mat_solve(A,b,[lstsq]):= block( - if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), - if listp(b) then b: transpose(b), - [m, n]: matrix_size(A), - if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), - vars: rest(stack_var_makelist(tmp,n)), - if lstsq then AT: transpose(A) else AT: ident(m), - eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), - sol: map(rhs,linsolve(eqns,vars)), - if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) +geo_mult(M,L):= block([evals,evects,ii], + if squarep(M) then block( + [evals, evects]: ev(eigenvectors(M),simp), + if not(member(L,first(evals))) then return(0), + ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), + return(length(evects[ii])) + ) ); +/* Find the matrix that projects orthogonally onto the column space of M */ +projection_matrix(M):= block([reduced_M], + if ev(zeromatrixp(M),simp) then return(0), + reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), + return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) +); + +/*********************************************************************************/ +/* Matrix factorisations */ +/*********************************************************************************/ + +/* Overall notes: + - These are in no way efficient functions, but seem to be fine for small + matrices with carefully deployed variants. + - I'm not convinced these add much to the package, but it felt wrong to not + include them in a linear algebra package. + - In most cases, teachers should begin with the factorisation, compute the + original matrix, and ask students to work backwards to your KNOWN answer. +*/ + +/* PM = LU */ +/* The built-in functions throw errors at annoying times and require two function calls. */ +/* TODO: Surely we can make a better function that works for singular and/or rectangular matrices? */ +/* get_PLU(M):= block( + if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) +); */ + +/* M = QR */ QR(M):= block([cols,Q,R], if is(rank(M)#second(matrix_size(M))) then return([]), cols: ev(gramschmidt(transpose(M)),simp), @@ -353,19 +454,10 @@ QR(M):= block([cols,Q,R], return([Q,R]) ); -squarep(M):= block( - isSquare: false, - if matrixp(M) then block( - if is(apply("=",matrix_size(M))) then isSquare: true - ), - return(isSquare) -); - -diagonalisablep(M):= block( - if squarep(M) then return(ev(diagp(dispJordan(jordan(M))),simp)) else return(false) -); - -get_Jordan_form(M):= block( +/* M = P.J.P^^-1 */ +/* This really just calls existing functions in one go + and avoids annoying errors. */ +get_Jordan_form(M):= block([jordan_info,J,P], if not(squarep(M)) then return([]), jordan_info: ev(jordan(M),simp), J: ev(dispJordan(jordan_info),simp), @@ -373,16 +465,18 @@ get_Jordan_form(M):= block( return([P,J]) ); -sym_p(M):= is(M = ev(transpose(M),simp)); - -diagonalise(M):= block([P,J], +/* M = P.D.P^^-1 */ +/* If M is symmetric it will automatically orthogonally diagonalise */ +diagonalise(M):= block([P,D], if not(squarep(M)) then return([]), - [P, J]: get_Jordan_form(M), + [P, D]: get_Jordan_form(M), if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), - if diagp(J) then return([P,J]) else return([]) + if diagp(D) then return([P,D]) else return([]) ); -SVD_red(M):= block( +/* Reduced SVD */ +/* Always produces minimum required diagonal Sigma and associated U and V. */ +SVD_red(M):= block([MTM,V,S2,components,n,S,U,ii], if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), MTM: ev(transpose(M).M,simp), if atom(MTM) then MTM: matrix([MTM]), @@ -409,30 +503,17 @@ SVD_red(M):= block( return([U,S,transpose(V)]) ); -pinv(M):= block( +/* M^+ = V.S^+.U^T */ +/* Moore-penrose pseudoinverse. I'm convinced this routine exists somewhere in a package, + because I've used it before in other maxima terminals, but I was unable to find it. */ +pinv(M):= block([U,S,VT], if ev(zeromatrixp(M),simp) then return(M), [U, S, VT]: SVD_red(M), return(ev(transpose(VT) . invert(S) . transpose(U),simp)) ); -basisify(M,[orth]):= block( - if emptyp(orth) then orth: false else orth: first(orth), - if not(lin_indp(M)) then M: remove_dep(M), - [m, n]: matrix_size(M), - vecs: args(transpose(M)), - new_vecs: args(ident(m)), - for ii: 1 thru m do block( - ii: ev(ii,simp), - if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) - ), - if orth then block( - vecs: ev(gramschmidt(apply(matrix,vecs)),simp), - vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) - ), - return(transpose(apply(matrix,vecs))) -); - -SVD(M):= block( +/* Full SVD */ +SVD(M):= block([U,S,VT], [U, S, VT]: SVD_red(M), if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), if is(VT=matrix([])) then VT: ident(second(matrix_size(M))) else VT: transpose(basisify(transpose(VT),true)), @@ -440,75 +521,48 @@ SVD(M):= block( return([U,S,VT]) ); -invertiblep(M):= block( - isInvertible: false, - if squarep(M) then block( - if ev(is(determinant(M)#0),simp) then isInvertible: true - ), - return(isInvertible) -); - -get_PLU(M):= block( - if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) -); +/*********************************************************************************/ +/* Automatically formats a system of linear equations */ +/*********************************************************************************/ -unit_vecp(v):= is(ev(v.conjugate(v),simp)=1); +/* TODO: + - Needs another pass to fix 0 = 0 equations + - Perhaps we want an extra function that takes A, x and b for matrix A, + symbolic vector x, and constant vector b and then runs this? + - Doesn't have s_test_case yet because the string output will be ridiculous +*/ -eigenvectorp(v,M):= block( - if matrixp(v) then block( - if is(first(matrix_size(v))=1) then v: transpose(v) - ) else if listp(v) then v: transpose(v) - else if ntuplep(v) then v: transpose(args(v)), - if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), - return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) -); - -rowspace(M):= ev(columnspace(transpose(M)),simp); -nullTspace(M):= ev(nullspace(transpose(M)),simp); +/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ +s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ +s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ +one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ +delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ -lgcd(ex):= block( - ex_gcd: first(ex), - for ii: 2 thru length(ex) do block( +/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ +/* local variable p will be a gradually growing list of strings that eventually get stitched together */ +disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], + n: length(eqns), /* n = number of equations */ + m: length(vars), /* m = number of variables */ + p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ + p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ + for ii: 1 thru n do block( ii: ev(ii,simp), - ex_gcd: gcd(ex_gcd,ex[ii]) + pivot: false, /* each row will have a pivot, assume false until we find it */ + v: vars[1], /* v is the variable we are looking at in this column */ + a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ + if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ + /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ + if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), + for jj: 2 thru m do block( + jj: ev(jj,simp), + v: vars[jj], + a: ev(coeff(lhs(eqns[ii]),v),simp), + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if is(a#0) and not(pivot) then pivot: true + ),/*TODO: what about 0=0? Currently displays as "=0"*/ + p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), + if is(ii#n) then p: append(p,["\\\\"]) ), - return(ex_gcd) -); - -integerify(v):= block( - v_op: "list", - if matrixp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - tmp: ev(lgcd(v),simp), - if ev(is(tmp#0),simp) then v: ev(v/tmp,simp), - if is(v_op="matrix") then return(transpose(v)) else return(v) -); - -alg_mult(M,L):= block( - if squarep(M) then block( - evals: ev(eigenvalues(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(second(evals)[ii]) - ) -); - -geo_mult(M,L):= block( - if squarep(M) then block( - [evals, evects]: ev(eigenvectors(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(length(evects[ii])) - ) -); - -Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); - -orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); -orthonormal_columnsp(M):= is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))); -orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); - -projection_matrix(M):= block( - if ev(zeromatrixp(M),simp) then return(0), - reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), - return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) + p: append(p,["\\end{array}"]), + return(simplode(p)) ); From 90cbc3b81b8355f303381cfe4243cfcfb5fda65d Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 8 May 2024 15:44:15 +1200 Subject: [PATCH 11/26] Update linearalgebra.mac Implemented old fix for integerify (missed in the upgrade to 0.2.3). --- stack/maxima/contrib/linearalgebra.mac | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 3f19138a4cd..e95dcaa951f 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -595,7 +595,8 @@ s_test_case(lgcd([1/2,1/4,5/6]),1/12); integerify(v):= block([v_op], v_op: "list", if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - v: ev(v/lgcd(v),simp), + tmp: ev(lgcd(v),simp), + if ev(is(tmp#0),simp) then v: ev(v/tmp,simp), if ev(every(lambda([ex],is(signum(ex)=-1)),v),simp) then v: ev(-v,simp), if is(v_op="matrix") then return(transpose(v)) else return(v) ); @@ -603,6 +604,7 @@ integerify(v):= block([v_op], s_test_case(integerify([9,12,27]),[3,4,9]); s_test_case(integerify(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); s_test_case(integerify([1/2,1/4,-5/6]),[6,3,-10]); +s_test_case(integerify([0,0,0]),[0,0,0]); /* We have columnspace and nullspace functions already. The author keeps assuming that rowspace must exist too, but it doesn't. The nullTspace function was added for From 595daa857f1bfe531ddfac7c2697d1295cc4d8fe Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 8 May 2024 15:44:31 +1200 Subject: [PATCH 12/26] Update linearalgebra_no_test.mac Implemented old fix to integerify (missed in upgrade to 0.2.3) --- stack/maxima/contrib/linearalgebra_no_test.mac | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra_no_test.mac index b138895bc55..cb70a0bbb8b 100644 --- a/stack/maxima/contrib/linearalgebra_no_test.mac +++ b/stack/maxima/contrib/linearalgebra_no_test.mac @@ -381,7 +381,8 @@ lgcd(ex):= block([ex_gcd,ii], integerify(v):= block([v_op], v_op: "list", if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - v: ev(v/lgcd(v),simp), + tmp: ev(lgcd(v),simp), + if ev(is(tmp#0),simp) then v: ev(v/tmp,simp), if ev(every(lambda([ex],is(signum(ex)=-1)),v),simp) then v: ev(-v,simp), if is(v_op="matrix") then return(transpose(v)) else return(v) ); From 32429320bae3b6fd748cc954cc2357a1cecab577 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 9 May 2024 12:55:29 +1200 Subject: [PATCH 13/26] Create linearalgebra_test.mac Following the fix to #1148: https://github.com/maths/moodle-qtype_stack/commit/a35ebc0da85b955462222ba6c850d1638b4febbd --- stack/maxima/contrib/linearalgebra_test.mac | 294 ++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 stack/maxima/contrib/linearalgebra_test.mac diff --git a/stack/maxima/contrib/linearalgebra_test.mac b/stack/maxima/contrib/linearalgebra_test.mac new file mode 100644 index 00000000000..df4fd9d299c --- /dev/null +++ b/stack/maxima/contrib/linearalgebra_test.mac @@ -0,0 +1,294 @@ +/* Author Luke Longworth + University of Canterbury + Copyright (C) 2024 Luke Longworth + + This program is free software: you can redistribute it or modify + it under the terms of the GNU General Public License version two. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/****************************************************************/ +/* Linear algebra functions for STACK */ +/* */ +/* Test cases. */ +/* */ +/* V0.2.3 May 2024 */ +/* */ +/****************************************************************/ + +s_test_case(vec_convert(c(1,2,3)),matrix([1],[2],[3])); +s_test_case(vec_convert(r(1,2,3)),matrix([1,2,3])); +s_test_case(vec_convert(c(1,2,3) + matrix([1],[1],[1])),matrix([1],[2],[3])+matrix([1],[1],[1])); +s_test_case(vec_convert(c(1,2) + r(3,4)),matrix([1],[2])+matrix([3,4]) ); +s_test_case(ev(vec_convert(c(1,2) + r(3,4)),simp),c(1,2) + r(3,4) ); + +s_test_case(vec_convertedp(c(1,2)),false); +s_test_case(vec_convertedp(r(1,2)),false); +s_test_case(vec_convertedp(vec_convert(c(1,2))),true); +s_test_case(vec_convertedp(ev(vec_convert(c(1,2)+r(3,4)),simp)),false); + +s_test_case(col_vecp(matrix([1],[2])),true); +s_test_case(col_vecp(matrix([1,2])),false); +s_test_case(row_vecp(matrix([1],[2])),false); +s_test_case(row_vecp(matrix([1,2])),true); +s_test_case(col_vecp(c(1,2)),false); +s_test_case(row_vecp(r(1,2)),false); + +s_test_case(vectorp(matrix([1],[2])),true); +s_test_case(vectorp(matrix([1,2])),true); +s_test_case(vectorp(c(1,2)),false); + +s_test_case(unit_vecp(matrix([1],[0])),true); +s_test_case(unit_vecp(matrix([1/sqrt(2),1/sqrt(2)])),true); +s_test_case(unit_vecp(matrix([1],[1])),false); +s_test_case(unit_vecp(c(1,0)),false); + +s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[0,5,6],[0,0,9])); +s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])); +s_test_case(triu(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])); + +s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[4,5,0],[7,8,9])); +s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])); +s_test_case(tril(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])); + +s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0,0,9])); +s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); +s_test_case(get_diag(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); + +s_test_case(diag_entries(ident(3)),[1,1,1]); +s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); +s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); + +s_test_case(triup(ident(5)),true); +s_test_case(trilp(ident(5)),true); +s_test_case(diagp(ident(5)),true); +s_test_case(triup(zeromatrix(5,4)),true); +s_test_case(trilp(zeromatrix(5,4)),true); +s_test_case(diagp(zeromatrix(5,4)),true); + +s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9])),true); +s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); +s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])),true); +s_test_case(triup(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); +s_test_case(triup(matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])),true); + +s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9])),true); +s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); +s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])),true); +s_test_case(trilp(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); +s_test_case(trilp(matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])),true); + +s_test_case(diagp(matrix([1,0],[1-1,1])),false);/* Is the matrix in row echelon form (not reduced)? */ + +s_test_case(REFp(ident(4)),true); +s_test_case(REFp(ev(2*ident(4),simp)),true); +s_test_case(REFp(ev(2*ident(4),simp),true),false); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0])),true); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),true),false); +s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),false),true); +s_test_case(REFp(matrix([2,1,1],[0,0,0],[0,0,3],[0,0,0])),false); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1])),true); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1]),true),true); +s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,1,0,1,1],[0,0,0,0,0,1])),true); +s_test_case(REFp(matrix([1,2,3],[0,5,6])),true); +s_test_case(REFp(matrix([1,2,3],[4,5,6])),false); +s_test_case(REFp(matrix([1,2,3],[0,5,6],[0,8,9])),false); + +s_test_case(squarep(ident(4)),true); +s_test_case(squarep(matrix([1],[2])),false); +s_test_case(squarep(matrix([1,2],[2,3])),true); +s_test_case(squarep(1),false); + +s_test_case(diagonalisablep(ident(2)),true); +s_test_case(diagonalisablep(matrix([1,1],[0,1])),false); +s_test_case(diagonalisablep(1),false); +s_test_case(diagonalisablep(matrix([1,1],[1,1])),true); + +s_test_case(sym_p(ident(3)),true); +s_test_case(sym_p(matrix([1,1],[0,1])),false); +s_test_case(sym_p(1),false); + +s_test_case(invertiblep(ident(2)),true); +s_test_case(invertiblep(matrix([1,1],[0,1])),true); +s_test_case(invertiblep(1),false); +s_test_case(invertiblep(matrix([1,1],[1,1])),false); + +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1],[1,0])),true); +s_test_case(orthogonal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,2],[1,0])),false); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])),true); +s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])/sqrt(2)),true); +s_test_case(orthogonal_columnsp(1),false); + +s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1],[1,0])),false); +s_test_case(orthonormal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); +s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1])),false); +s_test_case(orthonormal_columnsp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); +s_test_case(orthonormal_columnsp(1),false); + +s_test_case(orth_matrixp(matrix([1,1],[1,-1],[1,0])),false); +s_test_case(orth_matrixp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),false); +s_test_case(orth_matrixp(matrix([1,1],[1,-1])),false); +s_test_case(orth_matrixp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); +s_test_case(orth_matrixp(1),false); + +s_test_case(make_list_of_lists(1),1); +s_test_case(make_list_of_lists(matrix([1,3,5])),[[1,3,5]]); +s_test_case(make_list_of_lists(matrix([1,2],[3,4],[5,6])),[[1,3,5],[2,4,6]]); +s_test_case(make_list_of_lists({c(1,2,3),[2,3,4],ntuple(3,4,5),{4,5,6}}),[[1,2,3],[2,3,4],[3,4,5],[4,5,6]]); + +s_test_case(column_stack([[1,2,3],[4,5,6]]),matrix([1,4],[2,5],[3,6])); +s_test_case(column_stack([[1,2,3]]),matrix([1],[2],[3])); +s_test_case(column_stack([1,2,3]),[]); + +s_test_case(lin_indp(matrix([1,2],[4,5],[7,8])),true); +s_test_case(lin_indp(matrix([1,2,3],[4,5,6],[7,8,9])),false); +s_test_case(lin_indp(matrix([1,2,3],[4,5,6])),false); +s_test_case(lin_indp([[1,2],[4,5],[7,8]]),false); +s_test_case(lin_indp([[1,4,7],[2,5,8]]),true); +s_test_case(lin_indp(make_list_of_lists({[1,2],[4,5],[7,8]})),false); +s_test_case(lin_indp(make_list_of_lists({[1,4,7],[2,5,8]})),true); +s_test_case(lin_indp(make_list_of_lists(ntuple([1,2],[4,5],[7,8]))),false); +s_test_case(lin_indp(make_list_of_lists(ntuple([1,4,7],[2,5,8]))),true); +s_test_case(lin_indp(make_list_of_lists(span([1,2],[4,5],[7,8]))),false); +s_test_case(lin_indp(make_list_of_lists(span([1,4,7],[2,5,8]))),true); +s_test_case(lin_indp(make_list_of_lists([transpose([1,4,7]),[2,5,8]])),true); +s_test_case(lin_indp(make_list_of_lists({transpose([1,4,7]),matrix([2,5,8])})),true); + +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); +s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); +s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); + +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); + +s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0],[0,1]]),true); +s_test_case(subspace_equiv([[1,2],[2,4]],[[1,0],[0,1]]),false); +s_test_case(subspace_equiv([[1,2],[2,3],[3,4]],[[1,0],[0,1]]),true); +s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0]]),false); + +s_test_case(remove_dep(matrix([0,0])),[]); +s_test_case(remove_dep([[1,0],[0,1],[1,1]]),[[1,0],[0,1]]); +s_test_case(remove_dep([[1,0],[2,0],[1,1]]),[[1,0],[1,1]]); +s_test_case(remove_dep(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2],[4,5],[7,8])); + +s_test_case(sf_map(1/3,2),0.33); +s_test_case(sf_map(1/3,3),0.333); +s_test_case(sf_map(12345,2),12000); +s_test_case(sf_map(12345,3),12300); +s_test_case(sf_map(1.5,1),2); +s_test_case(sf_map(2.5,1),3); + +s_test_case(sf_map([1/3,12345],2),[0.33,12000]); +s_test_case(sf_map(matrix([1/3,12345]),2),matrix([0.33,12000])); +s_test_case(sf_map(matrix([1/3],[12345]),2),matrix([0.33],[12000])); +s_test_case(sf_map(matrix([1/3,12345],[1/4,5/4]),2),matrix([0.33,12000],[0.25,1.3])); +s_test_case(sf_map({1/3,1/4},1),{1/3,1/4}); + +s_test_case(diagmatrix_like([1,1,1],3,3),ident(3)); +s_test_case(diagmatrix_like([1,2,3],3,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0])); +s_test_case(diagmatrix_like([1,2,3],4,3),matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])); +s_test_case(diagmatrix_like([1,2,3],4,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0],[0,0,0,0])); +s_test_case(diagmatrix_like([1,2,3],2,3),matrix([1,0,0],[0,2,0])); +s_test_case(diagmatrix_like([1,2,3],3,2),matrix([1,0],[0,2],[0,0])); + +s_test_case(mat_norm2(ident(2)),1.0); +s_test_case(mat_norm2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); +s_test_case(mat_norm2(matrix([1,2],[2,-2])),3.0); +s_test_case(mat_norm2(matrix([2,2],[1,0],[0,1])),3.0); +s_test_case(mat_norm2(matrix([1,1],[1,1])),2.0); +s_test_case(mat_norm2(1),und); + +s_test_case(mat_cond2(ident(2)),1.0); +s_test_case(mat_cond2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); +s_test_case(mat_cond2(matrix([1,2],[2,-2])),1.5); +s_test_case(mat_cond2(1),und); +s_test_case(mat_cond2(matrix([1,1],[1,0],[0,1])),und); +s_test_case(mat_cond2(matrix([1,2],[1,2])),und); + +s_test_case(mat_solve(matrix([1,2],[3,4]),[3,7]),matrix([1],[1])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[0,0]),matrix([%r1],[%r1])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0]),matrix([])); +s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0],true),matrix([(2*%r2+1)/2],[%r2])); +s_test_case(mat_solve(matrix([0,0],[1,1]),[1,0],true),matrix([-%r3],[%r3])); + +s_test_case(basisify(matrix([1,2],[0,0],[0,0])),ident(3)); +s_test_case(basisify(matrix([1,2],[1,2],[0,0])),matrix([1,1,0],[1,0,0],[0,0,1])); +s_test_case(basisify([[1,1,0],[2,2,0]],true),[[1/sqrt(2),1/sqrt(2),0],[1/sqrt(2),-(1/sqrt(2)),0],[0,0,1]]); + +s_test_case(lgcd([9,12,27]),3); +s_test_case(lgcd([-9,-12,-27]),3); +s_test_case(lgcd([1/2,1/4,5/6]),1/12); + +s_test_case(integerify([9,12,27]),[3,4,9]); +s_test_case(integerify(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); +s_test_case(integerify([1/2,1/4,-5/6]),[6,3,-10]); +s_test_case(integerify([0,0,0]),[0,0,0]); + +s_test_case(rowspace(ident(2)),span(matrix([1],[0]),matrix([0],[1]))); +s_test_case(rowspace(matrix([1,0],[0,1],[1,1])),span(matrix([1],[0]),matrix([0],[1]))); +s_test_case(nullTspace(matrix([1,0],[0,1],[1,1])),span(matrix([-1],[-1],[1]))); + +s_test_case(Rayleigh(matrix([1,1],[1,1]),matrix([1],[1])),2); +s_test_case(Rayleigh(matrix([1,1],[0,1]),matrix([1],[1])),3/2); +s_test_case(Rayleigh(matrix([0,-1],[1,0]),matrix([%i],[2])),(4*%i)/5); + +s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),3); +s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),2); +s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); +s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); +s_test_case(alg_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); +s_test_case(geo_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); + +s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,10])),ident(3)); +s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([5/6,1/3,-(1/6)],[1/3,1/3,1/3],[-(1/6),1/3,5/6])); + +s_test_case(QR(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3])),[matrix([1/2,1/2,1/2],[1/2,-(1/2),-(1/2)],[1/2,-(1/2),1/2],[1/2,1/2,-(1/2)]),matrix([2,4,5],[0,2,3],[0,0,2])]); +s_test_case(QR(matrix([1,1],[2,2])),[]); + +s_test_case(get_Jordan_form(1),[]); +s_test_case(get_Jordan_form(matrix([1,2])),[]); +s_test_case(get_Jordan_form(matrix([1,1],[0,1])),[ident(2),matrix([1,1],[0,1])]); +s_test_case(get_Jordan_form(matrix([1,2],[2,3])),[matrix([1,1],[-((sqrt(5)-1)/2),(sqrt(5)+1)/2]),matrix([2-sqrt(5),0],[0,sqrt(5)+2])]); +s_test_case(get_Jordan_form(matrix([8,-3],[12,-4])),[matrix([6,1],[12,0]),matrix([2,1],[0,2])]); + +s_test_case(diagonalise(1),[]); +s_test_case(diagonalise(matrix([1,2])),[]); +s_test_case(diagonalise(matrix([8,-3],[12,-4])),[]); +s_test_case(diagonalise(matrix([1,2],[3,4])),[matrix([1,1],[-(sqrt(33)-3)/4,(sqrt(33)+3)/4]),matrix([-(sqrt(33)-5)/2,0],[0,(sqrt(33)+5)/2])]); +s_test_case(diagonalise(matrix([1,2],[2,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-1/sqrt(2)]),matrix([3,0],[0,-1])]); +s_test_case(diagonalise(matrix([1,2],[1,2])),[matrix([1,1],[-1/2,1]),matrix([0,0],[0,3])]); +s_test_case(diagonalise(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[-1/sqrt(2),1/sqrt(2)]),matrix([0,0],[0,2])]); + +s_test_case(SVD_red(matrix([0,0],[0,0])),[matrix([]),matrix([]),matrix([])]); +s_test_case(SVD_red(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); +s_test_case(SVD_red(matrix([1,1],[1,1])),[matrix([1/sqrt(2)],[1/sqrt(2)]),matrix([2]),matrix([1/sqrt(2),1/sqrt(2)])]); +s_test_case(SVD_red(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0],[1/sqrt(6),1/sqrt(2)],[1/sqrt(6),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD_red(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)])]); + +s_test_case(pinv(matrix([0,0],[0,0])),matrix([0,0],[0,0])); +s_test_case(pinv(matrix([1,1],[1,1])),matrix([1/4,1/4],[1/4,1/4])); +s_test_case(pinv(matrix([1,0],[0,1],[1,1])),matrix([2/3,-(1/3),1/3],[-(1/3),2/3,1/3])); +s_test_case(pinv(matrix([1,0,1],[0,1,1])),matrix([2/3,-(1/3)],[-(1/3),2/3],[1/3,1/3])); + +s_test_case(SVD(matrix([0,0],[0,0])),[matrix([1,0],[0,1]),matrix([0,0],[0,0]),matrix([1,0],[0,1])]); +s_test_case(SVD(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); +s_test_case(SVD(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([2,0],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0,1/sqrt(3)],[1/sqrt(6),1/sqrt(2),-(1/sqrt(3))],[1/sqrt(6),-(1/sqrt(2)),-(1/sqrt(3))]),matrix([sqrt(3),0],[0,1],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); +s_test_case(SVD(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0,0],[0,1,0]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)],[1/sqrt(3),-(1/sqrt(3)),-(1/sqrt(3))])]); From 0791cbfdf9023a503b0e62bcae966e65ad658f13 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 9 May 2024 12:59:52 +1200 Subject: [PATCH 14/26] Delete stack/maxima/contrib/linearalgebra.mac Deleting file with plan to rename `linearalgebra_no_test` to `linearalgebra` --- stack/maxima/contrib/linearalgebra.mac | 840 ------------------------- 1 file changed, 840 deletions(-) delete mode 100644 stack/maxima/contrib/linearalgebra.mac diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac deleted file mode 100644 index e95dcaa951f..00000000000 --- a/stack/maxima/contrib/linearalgebra.mac +++ /dev/null @@ -1,840 +0,0 @@ -/* Author Luke Longworth - University of Canterbury - Copyright (C) 2024 Luke Longworth - - This program is free software: you can redistribute it or modify - it under the terms of the GNU General Public License version two. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -/****************************************************************/ -/* Linear algebra functions for STACK */ -/* */ -/* V0.2.3 May 2024 */ -/* */ -/****************************************************************/ - -/*******************************************************************************/ -/* Provides convenience functions for column and row vectors for student input */ -/*******************************************************************************/ -texput(c, - lambda([ex], block([ns,str,ii], - ns: args(ex), - str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " \\\\ "])), - str[length(str)]: " \\end{bmatrix}", - simplode(str) - )) -); - -texput(r, - lambda([ex], block([ns,str,ii], - ns: args(ex), - str: ["\\begin{bmatrix} "], - for ii: 1 thru length(ns) do (str: append(str, [ev(tex1(ns[ii]),simp), " & "])), - str[length(str)]: " \\end{bmatrix}", - simplode(str) - )) -); - -declare([c,r],nonscalar); - -/* Manually convert student answers to the appropriate vector form. */ -/* If vectors do not conform then the original expression is returned. */ -vec_convert(ex):= block([ex2], - ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), - if emptyp(ex2) then return(ex) else return(first(ex2)) -); - -s_test_case(vec_convert(c(1,2,3)),matrix([1],[2],[3])); -s_test_case(vec_convert(r(1,2,3)),matrix([1,2,3])); -s_test_case(vec_convert(c(1,2,3) + matrix([1],[1],[1])),matrix([1],[2],[3])+matrix([1],[1],[1])); -s_test_case(vec_convert(c(1,2) + r(3,4)),matrix([1],[2])+matrix([3,4]) ); -s_test_case(ev(vec_convert(c(1,2) + r(3,4)),simp),c(1,2) + r(3,4) ); - -/*******************************************************************************/ -/* Predicate functions for vectors */ -/*******************************************************************************/ - -/* A predicate to determine whether an expression has been converted to matrix form. */ -vec_convertedp(ex):= block([ex_ops], - ex_ops: get_ops(ex), - if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) -); - -s_test_case(vec_convertedp(c(1,2)),false); -s_test_case(vec_convertedp(r(1,2)),false); -s_test_case(vec_convertedp(vec_convert(c(1,2))),true); -s_test_case(vec_convertedp(ev(vec_convert(c(1,2)+r(3,4)),simp)),false); - -/* Predicates for determining whether a given object is an Mx1 or 1xN matrix (a vector) */ -/* Note: excludes c() and r() by design. Use vec_convert() before these. */ -col_vecp(ex):= block( - if not(matrixp(ex)) then return(false) - else return(is(second(matrix_size(ex))=1)) -); - -row_vecp(ex):= block( - if not(matrixp(ex)) then return(false) - else return(is(first(matrix_size(ex))=1)) -); - -s_test_case(col_vecp(matrix([1],[2])),true); -s_test_case(col_vecp(matrix([1,2])),false); -s_test_case(row_vecp(matrix([1],[2])),false); -s_test_case(row_vecp(matrix([1,2])),true); -s_test_case(col_vecp(c(1,2)),false); -s_test_case(row_vecp(r(1,2)),false); - -vectorp(ex):= col_vecp(ex) or row_vecp(ex); - -s_test_case(vectorp(matrix([1],[2])),true); -s_test_case(vectorp(matrix([1,2])),true); -s_test_case(vectorp(c(1,2)),false); - -/* TODO write function to convert row/col vectors in matrix form to c or r form */ -/* Should be useful for creating teacher answers */ - -/* Predicate to determine whether a given object is a unit vector. */ -unit_vecp(ex):= if vectorp(ex) then is(ev(ex.conjugate(ex),simp)=1) else false; - -s_test_case(unit_vecp(matrix([1],[0])),true); -s_test_case(unit_vecp(matrix([1/sqrt(2),1/sqrt(2)])),true); -s_test_case(unit_vecp(matrix([1],[1])),false); -s_test_case(unit_vecp(c(1,0)),false); - -/*********************************************************************************/ -/* Functions to extract parts of matrices */ -/*********************************************************************************/ - -/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ - -triu(M):= block([Mupp,imax,jmax,ii,jj], - Mupp: copymatrix(M), - [imax, jmax]: ev(matrix_size(M),simp), - for ii: 2 thru imax do block( - ii: ev(ii,simp), - for jj: 1 thru ev(min(ii-1, jmax),simp) do block( - jj: ev(jj,simp), - Mupp[ii,jj]: 0 - ) - ), - return(Mupp) -); - -s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[0,5,6],[0,0,9])); -s_test_case(triu(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])); -s_test_case(triu(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])); - -/* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ - -tril(M):= transpose(triu(transpose(M))); - -s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[4,5,0],[7,8,9])); -s_test_case(tril(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])); -s_test_case(tril(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])); - -/* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ - -get_diag(M):= tril(triu(M)); - -s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0,0,9])); -s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); -s_test_case(get_diag(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); - -/* Extracts the diagonal of a matrix as a list. */ - -diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); - -s_test_case(diag_entries(ident(3)),[1,1,1]); -s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); -s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); - -/*********************************************************************************/ -/* Predicate functions for matrices */ -/*********************************************************************************/ - -/* Is the matrix upper triangular? */ -triup(M):= if matrixp(M) then is(M = triu(M)) else false; - -/* Is the matrix lower triangular? */ -trilp(M):= if matrixp(M) then is(M = tril(M)) else false; - -/* Is the matrix diagonal? */ -diagp(M):= triup(M) and trilp(M); - -s_test_case(triup(ident(5)),true); -s_test_case(trilp(ident(5)),true); -s_test_case(diagp(ident(5)),true); -s_test_case(triup(zeromatrix(5,4)),true); -s_test_case(trilp(zeromatrix(5,4)),true); -s_test_case(diagp(zeromatrix(5,4)),true); - -s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9])),false); -s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9])),true); -s_test_case(triup(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); -s_test_case(triup(matrix([1,2,3],[0,5,6],[0,0,9],[0,0,0])),true); -s_test_case(triup(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); -s_test_case(triup(matrix([1,2,3,4],[0,5,6,7],[0,0,9,10])),true); - -s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9])),false); -s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9])),true); -s_test_case(trilp(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),false); -s_test_case(trilp(matrix([1,0,0],[4,5,0],[7,8,9],[10,11,12])),true); -s_test_case(trilp(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),false); -s_test_case(trilp(matrix([1,0,0,0],[4,5,0,0],[7,8,9,0])),true); - -s_test_case(diagp(matrix([1,0],[1-1,1])),false);/* Is the matrix in row echelon form (not reduced)? */ - -REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], - if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), - isREF: true, - pivot_row: 0, - [m, n]: matrix_size(M), - for jj: 1 thru n do block( - jj: ev(jj,simp), - if is(pivot_row < m) then block( - if is(M[ev(pivot_row+1,simp),jj] # 0) then block( - pivot_row: ev(pivot_row + 1,simp), - if normalise_pivots and is(M[ev(pivot_row,simp),jj] # 1) then isREF: false - ), - for ii: ev(pivot_row+1,simp) thru m do block( - ii: ev(ii,simp), - if is(M[ii,jj] # 0) then isREF: false - ) - ) - ), - return(isREF) -); - -s_test_case(REFp(ident(4)),true); -s_test_case(REFp(ev(2*ident(4),simp)),true); -s_test_case(REFp(ev(2*ident(4),simp),true),false); -s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0])),true); -s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),true),false); -s_test_case(REFp(matrix([2,1,1],[0,0,3],[0,0,0],[0,0,0]),false),true); -s_test_case(REFp(matrix([2,1,1],[0,0,0],[0,0,3],[0,0,0])),false); -s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1])),true); -s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,0,1,1,1],[0,0,0,0,0,1]),true),true); -s_test_case(REFp(matrix([1,1,1,1,1,1],[0,1,1,1,1,1],[0,0,1,0,1,1],[0,0,0,0,0,1])),true); -s_test_case(REFp(matrix([1,2,3],[0,5,6])),true); -s_test_case(REFp(matrix([1,2,3],[4,5,6])),false); -s_test_case(REFp(matrix([1,2,3],[0,5,6],[0,8,9])),false); - -/* Is a given object a square matrix? */ -squarep(M):= block([isSquare], - isSquare: false, - if matrixp(M) then block( - if is(apply("=",matrix_size(M))) then isSquare: true - ), - return(isSquare) -); - -s_test_case(squarep(ident(4)),true); -s_test_case(squarep(matrix([1],[2])),false); -s_test_case(squarep(matrix([1,2],[2,3])),true); -s_test_case(squarep(1),false); - -/* Is a given object a diagonalisable matrix? */ -diagonalisablep(M):= if squarep(M) then ev(diagp(dispJordan(jordan(M))),simp) else false; - -s_test_case(diagonalisablep(ident(2)),true); -s_test_case(diagonalisablep(matrix([1,1],[0,1])),false); -s_test_case(diagonalisablep(1),false); -s_test_case(diagonalisablep(matrix([1,1],[1,1])),true); - -/* Is a given object a symmetric matrix? */ -/* NOTE: The native function symmetricp() does the same thing and more, but is currently banned. */ -sym_p(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; - -s_test_case(sym_p(ident(3)),true); -s_test_case(sym_p(matrix([1,1],[0,1])),false); -s_test_case(sym_p(1),false); - -/* Is a given object an invertible matrix? */ -invertiblep(M):= block([isInvertible], - isInvertible: false, - if squarep(M) then block( - if ev(is(determinant(M)#0),simp) then isInvertible: true - ), - return(isInvertible) -); - -s_test_case(invertiblep(ident(2)),true); -s_test_case(invertiblep(matrix([1,1],[0,1])),true); -s_test_case(invertiblep(1),false); -s_test_case(invertiblep(matrix([1,1],[1,1])),false); - -/* Is a given object a matrix with orthogonal columns? */ -orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); - -s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1],[1,0])),true); -s_test_case(orthogonal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); -s_test_case(orthogonal_columnsp(matrix([1,1],[1,2],[1,0])),false); -s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])),true); -s_test_case(orthogonal_columnsp(matrix([1,1],[1,-1])/sqrt(2)),true); -s_test_case(orthogonal_columnsp(1),false); - -/* Is a given object a matrix with orthonormal columns? */ -orthonormal_columnsp(M):= if matrixp(M) then is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))) else false; - -s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1],[1,0])),false); -s_test_case(orthonormal_columnsp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),true); -s_test_case(orthonormal_columnsp(matrix([1,1],[1,-1])),false); -s_test_case(orthonormal_columnsp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); -s_test_case(orthonormal_columnsp(1),false); - -/* Is a given object an orthogonal matrix? */ -orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); - -s_test_case(orth_matrixp(matrix([1,1],[1,-1],[1,0])),false); -s_test_case(orth_matrixp(matrix([1/sqrt(3),1/sqrt(2)],[1/sqrt(3),-1/sqrt(2)],[1/sqrt(3),0])),false); -s_test_case(orth_matrixp(matrix([1,1],[1,-1])),false); -s_test_case(orth_matrixp(ev(matrix([1,1],[1,-1])/sqrt(2),simp)),true); -s_test_case(orth_matrixp(1),false); - -/*********************************************************************************/ -/* Functions to convert objects into standard forms */ -/*********************************************************************************/ - -/* It is feasible that different institutions will prefer students to enter their answers in different ways */ -/* linearalgebra.mac prefers to work with either lists of lists (not distinguishing between column and row - vectors) or matrices whose columns are vectors of interest. */ - -/* A function to convert any of the following to a list of lists: - - op may be a list, ntuple, set, span, or matrix (considering its columns) - - elements of the op may be lists, sets, ntuples, matrices, c, or r. */ -make_list_of_lists(ex):= block([op1], - op1: safe_op(ex), - /* TODO: What if given a single vector? */ - if not(member(op1,["[","ntuple","{","span","matrix"])) then return(ex), - ex: vec_convert(ex), - if vectorp(ex) then return([list_matrix_entries(ex)]), - if is(op1="matrix") then return(args(transpose(ex))), - ex: args(ex), - ex: map(lambda([ex2],if vectorp(ex2) then list_matrix_entries(ex2) else args(ex2)),ex), - return(ex) -); - -s_test_case(make_list_of_lists(1),1); -s_test_case(make_list_of_lists(matrix([1,3,5])),[[1,3,5]]); -s_test_case(make_list_of_lists(matrix([1,2],[3,4],[5,6])),[[1,3,5],[2,4,6]]); -s_test_case(make_list_of_lists({c(1,2,3),[2,3,4],ntuple(3,4,5),{4,5,6}}),[[1,2,3],[2,3,4],[3,4,5],[4,5,6]]); - -/* Given a list of lists, construct a matrix with the entries as columns. */ -column_stack(ex):= block([ex2], - ex2: errcatch(transpose(apply(matrix,args(ex)))), - if emptyp(ex2) then return(ex2) else return(first(ex2)) -); - -s_test_case(column_stack([[1,2,3],[4,5,6]]),matrix([1,4],[2,5],[3,6])); -s_test_case(column_stack([[1,2,3]]),matrix([1],[2],[3])); -s_test_case(column_stack([1,2,3]),[]); - -/* TODO function to convert list of lists to list of column vectors. */ - -/*********************************************************************************/ -/* Comparison functions */ -/*********************************************************************************/ - -/* Given a list of lists or a matrix, determine whether the list elements or columns are linearly independent. */ -lin_indp(ex):= block( - if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))) - else ex: column_stack(ex), - if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))), - return(false) -); - -s_test_case(lin_indp(matrix([1,2],[4,5],[7,8])),true); -s_test_case(lin_indp(matrix([1,2,3],[4,5,6],[7,8,9])),false); -s_test_case(lin_indp(matrix([1,2,3],[4,5,6])),false); -s_test_case(lin_indp([[1,2],[4,5],[7,8]]),false); -s_test_case(lin_indp([[1,4,7],[2,5,8]]),true); -s_test_case(lin_indp(make_list_of_lists({[1,2],[4,5],[7,8]})),false); -s_test_case(lin_indp(make_list_of_lists({[1,4,7],[2,5,8]})),true); -s_test_case(lin_indp(make_list_of_lists(ntuple([1,2],[4,5],[7,8]))),false); -s_test_case(lin_indp(make_list_of_lists(ntuple([1,4,7],[2,5,8]))),true); -s_test_case(lin_indp(make_list_of_lists(span([1,2],[4,5],[7,8]))),false); -s_test_case(lin_indp(make_list_of_lists(span([1,4,7],[2,5,8]))),true); -s_test_case(lin_indp(make_list_of_lists([transpose([1,4,7]),[2,5,8]])),true); -s_test_case(lin_indp(make_list_of_lists({transpose([1,4,7]),matrix([2,5,8])})),true); - -/* Given a pair of matrices, check whether they are row or column equivalent. */ -row_equiv(ex,ta):= block( - if matrixp(ex) and matrixp(ta) then ( - return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) - ) -); - -col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); - -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); - -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); - -/* Given two lists of lists, determine whether they span the same subspace. */ -/* Note: This does not check for redundancies. To check whether two bases are equivalent, - use this function in conjunction with lin_indp. */ - -subspace_equiv(ex,ta):= block([ex_rref,ta_rref], - ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), - ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), - return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) -); - -s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0],[0,1]]),true); -s_test_case(subspace_equiv([[1,2],[2,4]],[[1,0],[0,1]]),false); -s_test_case(subspace_equiv([[1,2],[2,3],[3,4]],[[1,0],[0,1]]),true); -s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0]]),false); - -/* TODO: eigenvectorp(v,M). - What is actually useful functionality here? A predicate that checks - whether a given vector is an eigenvector of a given matrix? Should - we check that it corresponds to an optionally given eigenvalue? Do - we want an equivalent eigenvaluep(L,M) function? - -eigenvectorp(v,M):= block( - if matrixp(v) then block( - if is(first(matrix_size(v))=1) then v: transpose(v) - ) else if listp(v) then v: transpose(v) - else if ntuplep(v) then v: transpose(args(v)), - if is(second(matrix_size(M))#first(matrix_size(v))) then return(false), - return(not(lin_indp([ev(M.v,simp), v])) and is(rank(v)=1)) -); -*/ - -/*********************************************************************************/ -/* Some useful functions to perform routine tasks or extend existing functions */ -/*********************************************************************************/ - -/* Given a list of lists or a matrix, remove linearly dependent entries/columns. */ -remove_dep(ex):= block([ex_op,n_max,jj,ii], - ex_op: "list", - if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix"), - ex: ev(sublist(ex,lambda([ex2],not(zeromatrixp(matrix(ex2))))),simp), - if emptyp(ex) or is(length(ex)=1) then return(ex), - n_max: length(ex), - jj: 2, - for ii: 2 thru n_max do block( - ii: ev(ii,simp), - if not(lin_indp(firstn(ex,jj))) then ex: append(firstn(ex,ev(jj-1,simp)),lastn(ex,ev(length(ex)-jj,simp))) - else jj: ev(jj+1,simp), - if is(jj>length(ex)) then return(ex) - ), - if is(ex_op="matrix") then ex: transpose(apply(matrix,ex)), - return(ex) -); - -s_test_case(remove_dep(matrix([0,0])),[]); -s_test_case(remove_dep([[1,0],[0,1],[1,1]]),[[1,0],[0,1]]); -s_test_case(remove_dep([[1,0],[2,0],[1,1]]),[[1,0],[1,1]]); -s_test_case(remove_dep(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2],[4,5],[7,8])); - -/* Map significantfigures over a matrix */ -/* Should this be core functionality? Surely when given a matrix the base sigfigsfun - or significantfigures function could do this by mapping itself over the arguments - and re-constructing the matrix. */ - -sf_map(ex,n):= block([rows], - if matrixp(ex) then block( - return(apply(matrix,map(lambda([ex2],significantfigures(ex2,n)),args(ex)))) - ) else if listp(ex) or ev(numberp(ex),simp) then return(significantfigures(ex,n)) - else return(ex) -); - -s_test_case(sf_map(1/3,2),0.33); -s_test_case(sf_map(1/3,3),0.333); -s_test_case(sf_map(12345,2),12000); -s_test_case(sf_map(12345,3),12300); -s_test_case(sf_map(1.5,1),2); -s_test_case(sf_map(2.5,1),3); - -s_test_case(sf_map([1/3,12345],2),[0.33,12000]); -s_test_case(sf_map(matrix([1/3,12345]),2),matrix([0.33,12000])); -s_test_case(sf_map(matrix([1/3],[12345]),2),matrix([0.33],[12000])); -s_test_case(sf_map(matrix([1/3,12345],[1/4,5/4]),2),matrix([0.33,12000],[0.25,1.3])); -s_test_case(sf_map({1/3,1/4},1),{1/3,1/4}); - -/* Construct a diagonal matrix of size m by n with diagonal given as a list */ - -diagmatrix_like(d, m, n):= block([M,ii], - M: zeromatrix(m, n), - for ii: 1 thru ev(min(m, n, length(d)),simp) do block( - ii: ev(ii,simp), - M[ii,ii]: d[ii] - ), - return(M) -); - -s_test_case(diagmatrix_like([1,1,1],3,3),ident(3)); -s_test_case(diagmatrix_like([1,2,3],3,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0])); -s_test_case(diagmatrix_like([1,2,3],4,3),matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])); -s_test_case(diagmatrix_like([1,2,3],4,4),matrix([1,0,0,0],[0,2,0,0],[0,0,3,0],[0,0,0,0])); -s_test_case(diagmatrix_like([1,2,3],2,3),matrix([1,0,0],[0,2,0])); -s_test_case(diagmatrix_like([1,2,3],3,2),matrix([1,0],[0,2],[0,0])); - -/* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ - -/* I don't know if this has a good use case in a CAS like Maxima. - I would happily remove this if this feels out of place, as I don't - anticipate using this in my course regularly. */ - -mat_norm2(M):= block([svs], - if matrixp(M) then block( - svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), - return(ev(lmax(svs),simp)) - ) else return(und) -); - -s_test_case(mat_norm2(ident(2)),1.0); -s_test_case(mat_norm2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); -s_test_case(mat_norm2(matrix([1,2],[2,-2])),3.0); -s_test_case(mat_norm2(matrix([2,2],[1,0],[0,1])),3.0); -s_test_case(mat_norm2(matrix([1,1],[1,1])),2.0); -s_test_case(mat_norm2(1),und); - -mat_cond2(M):= block([svs,cond2], - cond2: und, - if invertiblep(M) then block( - svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), - cond2: ev(lmax(svs)/lmin(svs),simp) - ), - return(cond2) -); - -s_test_case(mat_cond2(ident(2)),1.0); -s_test_case(mat_cond2(matrix([sqrt(3),2],[0,sqrt(3)])),3.0); -s_test_case(mat_cond2(matrix([1,2],[2,-2])),1.5); -s_test_case(mat_cond2(1),und); -s_test_case(mat_cond2(matrix([1,1],[1,0],[0,1])),und); -s_test_case(mat_cond2(matrix([1,2],[1,2])),und); - -/* Solve the matrix equation Ax = b given matrix A and column vector (or list) b. */ -/* Optional extra argument: mat_solve(A,b,true) will find the least squares solution symbolically. */ -/* Note that the least squares solution may be non-unique (in the case of linearly dependent columns) */ -/* For minimal least squares solution, use pinv(A) . b (see below) */ -/* Always returns a matrix output. */ - -mat_solve(A,b,[lstsq]):= block([m,n,vars,eqns,sol], - if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), - if listp(b) then b: transpose(b), - [m, n]: matrix_size(A), - if ev(is(first(matrix_size(b))#m),simp) then return(matrix([])), - vars: rest(stack_var_makelist(tmp,n)), - if lstsq then AT: transpose(A) else AT: ident(m), - eqns: list_matrix_entries(ev((AT . A) . transpose(vars) - (AT . b),simp)), - sol: map(rhs,linsolve(eqns,vars)), - if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) -); - -s_test_case(mat_solve(matrix([1,2],[3,4]),[3,7]),matrix([1],[1])); -s_test_case(mat_solve(matrix([1,-1],[1,-1]),[0,0]),matrix([%r1],[%r1])); -s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0]),matrix([])); -s_test_case(mat_solve(matrix([1,-1],[1,-1]),[1,0],true),matrix([(2*%r2+1)/2],[%r2])); -s_test_case(mat_solve(matrix([0,0],[1,1]),[1,0],true),matrix([-%r3],[%r3])); - -/* Given a list of lists or a matrix, make a basis for R^m where m = length of each vector. */ -/* If you don't want to expand to R^m, use remove_dep instead */ -/* Optional input: basisify(ex,true) will make it an orthonormal basis. */ - -basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], - if emptyp(orth) then orth: false else orth: first(orth), - ex_op: "matrix", - if listp(M) then block(M: column_stack(M), ex_op: "list"), - if not(lin_indp(M)) then M: remove_dep(M), - [m, n]: matrix_size(M), - vecs: args(transpose(M)), - new_vecs: args(ident(m)), - for ii: 1 thru m do block( - ii: ev(ii,simp), - if lin_indp(append(vecs,[new_vecs[ii]])) then vecs: append(vecs,[new_vecs[ii]]) - ), - if orth then block( - vecs: ev(gramschmidt(apply(matrix,vecs)),simp), - vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),vecs),simp) - ), - if is(ex_op="matrix") then return(transpose(apply(matrix,vecs))) else return(vecs) -); - -s_test_case(basisify(matrix([1,2],[0,0],[0,0])),ident(3)); -s_test_case(basisify(matrix([1,2],[1,2],[0,0])),matrix([1,1,0],[1,0,0],[0,0,1])); -s_test_case(basisify([[1,1,0],[2,2,0]],true),[[1/sqrt(2),1/sqrt(2),0],[1/sqrt(2),-(1/sqrt(2)),0],[0,0,1]]); - -/* Maps the gcd (greatest common divisor) function across a list */ -lgcd(ex):= block([ex_gcd,ii], - ex_gcd: first(ex), - for ii: 2 thru length(ex) do block( - ii: ev(ii,simp), - ex_gcd: gcd(ex_gcd,ex[ii]) - ), - return(ex_gcd) -); - -s_test_case(lgcd([9,12,27]),3); -s_test_case(lgcd([-9,-12,-27]),3); -s_test_case(lgcd([1/2,1/4,5/6]),1/12); - -/* Given a vector (or list) return the shortest possible parallel vector with integer entries. */ -integerify(v):= block([v_op], - v_op: "list", - if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), - tmp: ev(lgcd(v),simp), - if ev(is(tmp#0),simp) then v: ev(v/tmp,simp), - if ev(every(lambda([ex],is(signum(ex)=-1)),v),simp) then v: ev(-v,simp), - if is(v_op="matrix") then return(transpose(v)) else return(v) -); - -s_test_case(integerify([9,12,27]),[3,4,9]); -s_test_case(integerify(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); -s_test_case(integerify([1/2,1/4,-5/6]),[6,3,-10]); -s_test_case(integerify([0,0,0]),[0,0,0]); - -/* We have columnspace and nullspace functions already. The author keeps assuming that - rowspace must exist too, but it doesn't. The nullTspace function was added for - completeness' sake, and finds the nullspace of M^T. We could call it the cokernel - function, but since maxima uses nullspace rather than kernel this feels inappropriate. */ - -rowspace(M):= ev(columnspace(transpose(M)),simp); -nullTspace(M):= ev(nullspace(transpose(M)),simp); - -s_test_case(rowspace(ident(2)),span(matrix([1],[0]),matrix([0],[1]))); -s_test_case(rowspace(matrix([1,0],[0,1],[1,1])),span(matrix([1],[0]),matrix([0],[1]))); -s_test_case(nullTspace(matrix([1,0],[0,1],[1,1])),span(matrix([-1],[-1],[1]))); - -/* Computes the Rayleigh quotient */ -Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); - -s_test_case(Rayleigh(matrix([1,1],[1,1]),matrix([1],[1])),2); -s_test_case(Rayleigh(matrix([1,1],[0,1]),matrix([1],[1])),3/2); -s_test_case(Rayleigh(matrix([0,-1],[1,0]),matrix([%i],[2])),(4*%i)/5); - -/* Compute the algebraic and geometric multiplicity of an eigenvalue. */ -/* Returns 0 if L is not an eigenvalue of M. */ -alg_mult(M,L):= block([evals,ii], - if squarep(M) then block( - evals: ev(eigenvalues(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(second(evals)[ii]) - ) -); - -geo_mult(M,L):= block([evals,evects,ii], - if squarep(M) then block( - [evals, evects]: ev(eigenvectors(M),simp), - if not(member(L,first(evals))) then return(0), - ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), - return(length(evects[ii])) - ) -); - -s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),3); -s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,1]),1),2); -s_test_case(alg_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); -s_test_case(geo_mult(matrix([1,1,0],[0,1,0],[0,0,2]),2),1); -s_test_case(alg_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); -s_test_case(geo_mult(matrix([2,1,0],[0,2,0],[0,0,1]),1),1); - -/* Find the matrix that projects orthogonally onto the column space of M */ -projection_matrix(M):= block([reduced_M], - if ev(zeromatrixp(M),simp) then return(0), - reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), - return(ev(reduced_M . invert(mat_unblocker(matrix([transpose(reduced_M) . reduced_M]))) . transpose(reduced_M),simp)) -); - -s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,10])),ident(3)); -s_test_case(projection_matrix(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([5/6,1/3,-(1/6)],[1/3,1/3,1/3],[-(1/6),1/3,5/6])); - -/*********************************************************************************/ -/* Matrix factorisations */ -/*********************************************************************************/ - -/* Overall notes: - - These are in no way efficient functions, but seem to be fine for small - matrices with carefully deployed variants. - - I'm not convinced these add much to the package, but it felt wrong to not - include them in a linear algebra package. - - In most cases, teachers should begin with the factorisation, compute the - original matrix, and ask students to work backwards to your KNOWN answer. -*/ - -/* PM = LU */ -/* The built-in functions throw errors at annoying times and require two function calls. */ -/* TODO: Surely we can make a better function that works for singular and/or rectangular matrices? */ -/* get_PLU(M):= block( - if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) -); */ - -/* M = QR */ -QR(M):= block([cols,Q,R], - if is(rank(M)#second(matrix_size(M))) then return([]), - cols: ev(gramschmidt(transpose(M)),simp), - cols: ev(map(lambda([ex],ex/sqrt(ex.ex)),cols),simp), - Q: transpose(apply(matrix,cols)), - R: ev(transpose(Q).M,simp), - return([Q,R]) -); - -s_test_case(QR(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3])),[matrix([1/2,1/2,1/2],[1/2,-(1/2),-(1/2)],[1/2,-(1/2),1/2],[1/2,1/2,-(1/2)]),matrix([2,4,5],[0,2,3],[0,0,2])]); -s_test_case(QR(matrix([1,1],[2,2])),[]); - -/* M = P.J.P^^-1 */ -/* This really just calls existing functions in one go - and avoids annoying errors. */ -get_Jordan_form(M):= block([jordan_info,J,P], - if not(squarep(M)) then return([]), - jordan_info: ev(jordan(M),simp), - J: ev(dispJordan(jordan_info),simp), - P: ev(ModeMatrix(M,jordan_info),simp), - return([P,J]) -); - -s_test_case(get_Jordan_form(1),[]); -s_test_case(get_Jordan_form(matrix([1,2])),[]); -s_test_case(get_Jordan_form(matrix([1,1],[0,1])),[ident(2),matrix([1,1],[0,1])]); -s_test_case(get_Jordan_form(matrix([1,2],[2,3])),[matrix([1,1],[-((sqrt(5)-1)/2),(sqrt(5)+1)/2]),matrix([2-sqrt(5),0],[0,sqrt(5)+2])]); -s_test_case(get_Jordan_form(matrix([8,-3],[12,-4])),[matrix([6,1],[12,0]),matrix([2,1],[0,2])]); - -/* M = P.D.P^^-1 */ -/* If M is symmetric it will automatically orthogonally diagonalise */ -diagonalise(M):= block([P,D], - if not(squarep(M)) then return([]), - [P, D]: get_Jordan_form(M), - if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), - if diagp(D) then return([P,D]) else return([]) -); - -s_test_case(diagonalise(1),[]); -s_test_case(diagonalise(matrix([1,2])),[]); -s_test_case(diagonalise(matrix([8,-3],[12,-4])),[]); -s_test_case(diagonalise(matrix([1,2],[3,4])),[matrix([1,1],[-(sqrt(33)-3)/4,(sqrt(33)+3)/4]),matrix([-(sqrt(33)-5)/2,0],[0,(sqrt(33)+5)/2])]); -s_test_case(diagonalise(matrix([1,2],[2,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-1/sqrt(2)]),matrix([3,0],[0,-1])]); -s_test_case(diagonalise(matrix([1,2],[1,2])),[matrix([1,1],[-1/2,1]),matrix([0,0],[0,3])]); -s_test_case(diagonalise(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[-1/sqrt(2),1/sqrt(2)]),matrix([0,0],[0,2])]); - -/* Reduced SVD */ -/* Always produces minimum required diagonal Sigma and associated U and V. */ -SVD_red(M):= block([MTM,V,S2,components,n,S,U,ii], - if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), - MTM: ev(transpose(M).M,simp), - if atom(MTM) then MTM: matrix([MTM]), - [V, S2]: diagonalise(MTM), - /* TODO: does this work? */ - V: first(QR(V)), - components: ev(makelist([S2[ii,ii],col(V,ii)],ii,1,second(matrix_size(MTM))),simp), - components: ev(reverse(sort(components)),simp), - components: ev(sublist(components,lambda([ex],is(first(ex)#0))),simp), - n: length(components), - S: zeromatrix(n,n), - S[1,1]: ev(sqrt(first(first(components))),simp), - V: second(first(components)), - U: ev(M.V/S[1,1],simp), - if atom(U) then U: matrix([U]), - if is(n>1) then block( - for ii: 2 thru n do block( - ii: ev(ii,simp), - S[ii,ii]: ev(sqrt(first(components[ii])),simp), - V: addcol(V,second(components[ii])), - U: addcol(U,ev(M.second(components[ii])/S[ii,ii],simp)) - ) - ), - return([U,S,transpose(V)]) -); - -s_test_case(SVD_red(matrix([0,0],[0,0])),[matrix([]),matrix([]),matrix([])]); -s_test_case(SVD_red(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); -s_test_case(SVD_red(matrix([1,1],[1,1])),[matrix([1/sqrt(2)],[1/sqrt(2)]),matrix([2]),matrix([1/sqrt(2),1/sqrt(2)])]); -s_test_case(SVD_red(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0],[1/sqrt(6),1/sqrt(2)],[1/sqrt(6),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); -s_test_case(SVD_red(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0],[0,1]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)])]); - -/* M^+ = V.S^+.U^T */ -/* Moore-penrose pseudoinverse. I'm convinced this routine exists somewhere in a package, - because I've used it before in other maxima terminals, but I was unable to find it. */ -pinv(M):= block([U,S,VT], - if ev(zeromatrixp(M),simp) then return(M), - [U, S, VT]: SVD_red(M), - return(ev(transpose(VT) . invert(S) . transpose(U),simp)) -); - -s_test_case(pinv(matrix([0,0],[0,0])),matrix([0,0],[0,0])); -s_test_case(pinv(matrix([1,1],[1,1])),matrix([1/4,1/4],[1/4,1/4])); -s_test_case(pinv(matrix([1,0],[0,1],[1,1])),matrix([2/3,-(1/3),1/3],[-(1/3),2/3,1/3])); -s_test_case(pinv(matrix([1,0,1],[0,1,1])),matrix([2/3,-(1/3)],[-(1/3),2/3],[1/3,1/3])); - -/* Full SVD */ -SVD(M):= block([U,S,VT], - [U, S, VT]: SVD_red(M), - if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), - if is(VT=matrix([])) then VT: ident(second(matrix_size(M))) else VT: transpose(basisify(transpose(VT),true)), - S: diagmatrix_like(diag_entries(S),first(matrix_size(M)),second(matrix_size(M))), - return([U,S,VT]) -); - -s_test_case(SVD(matrix([0,0],[0,0])),[matrix([1,0],[0,1]),matrix([0,0],[0,0]),matrix([1,0],[0,1])]); -s_test_case(SVD(matrix([sqrt(3),2],[0,sqrt(3)])),[matrix([sqrt(3)/2,1/2],[1/2,-(sqrt(3)/2)]),matrix([3,0],[0,1]),matrix([1/2,sqrt(3)/2],[sqrt(3)/2,-(1/2)])]); -s_test_case(SVD(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([2,0],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); -s_test_case(SVD(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0,1/sqrt(3)],[1/sqrt(6),1/sqrt(2),-(1/sqrt(3))],[1/sqrt(6),-(1/sqrt(2)),-(1/sqrt(3))]),matrix([sqrt(3),0],[0,1],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); -s_test_case(SVD(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0,0],[0,1,0]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)],[1/sqrt(3),-(1/sqrt(3)),-(1/sqrt(3))])]); - -/*********************************************************************************/ -/* Automatically formats a system of linear equations */ -/*********************************************************************************/ - -/* TODO: - - Needs another pass to fix 0 = 0 equations - - Perhaps we want an extra function that takes A, x and b for matrix A, - symbolic vector x, and constant vector b and then runs this? - - Doesn't have s_test_case yet because the string output will be ridiculous -*/ - -/* disp_eqns helper functions for displaying minus signs and removing one coefficients etc */ -s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+"; /* returns the sign of a coefficient as a string, assuming 0 is positive */ -s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else ""; /* Altered version of above that doesn't return + for leading coefficient */ -one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp); /* scrubs out unwanted ones and zeros */ -delete_if_zero(ex,var):= if is(ex=0) then "" else var; /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ - -/* Give equations in standard form (i.e. constant on RHS), give variables in order you want them displayed */ -/* local variable p will be a gradually growing list of strings that eventually get stitched together */ -disp_eqns(eqns,vars):= block([m,n,p,pivot,ii,jj,v,a], - n: length(eqns), /* n = number of equations */ - m: length(vars), /* m = number of variables */ - p: ["\\begin{array}"], /* begin the LaTeX array that will house the system of equations */ - p: append(p,[" {r",simplode(ev(makelist("cr",ii,1,m),simp)),"}"]), /* define the column alignments */ - for ii: 1 thru n do block( - ii: ev(ii,simp), - pivot: false, /* each row will have a pivot, assume false until we find it */ - v: vars[1], /* v is the variable we are looking at in this column */ - a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ - if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ - /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ - if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), - for jj: 2 thru m do block( - jj: ev(jj,simp), - v: vars[jj], - a: ev(coeff(lhs(eqns[ii]),v),simp), - if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), - if is(a#0) and not(pivot) then pivot: true - ),/*TODO: what about 0=0? Currently displays as "=0"*/ - p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), - if is(ii#n) then p: append(p,["\\\\"]) - ), - p: append(p,["\\end{array}"]), - return(simplode(p)) -); From e47734f718637f0b4884d6911839879bfd67ba3a Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 9 May 2024 13:00:12 +1200 Subject: [PATCH 15/26] Rename linearalgebra_no_test.mac to linearalgebra.mac --- .../contrib/{linearalgebra_no_test.mac => linearalgebra.mac} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename stack/maxima/contrib/{linearalgebra_no_test.mac => linearalgebra.mac} (100%) diff --git a/stack/maxima/contrib/linearalgebra_no_test.mac b/stack/maxima/contrib/linearalgebra.mac similarity index 100% rename from stack/maxima/contrib/linearalgebra_no_test.mac rename to stack/maxima/contrib/linearalgebra.mac From 5727f79cc75441d433f90130593a69a46f939934 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 15 May 2024 14:25:07 +1200 Subject: [PATCH 16/26] Update linearalgebra.mac Mostly a documentation update. Also added checks in lin_indp and subspace_equiv so that they don't throw errors when given lists of lists of unequal length. --- stack/maxima/contrib/linearalgebra.mac | 500 ++++++++++++++++++++----- 1 file changed, 408 insertions(+), 92 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index cb70a0bbb8b..85df2f6221e 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -45,8 +45,14 @@ texput(r, declare([c,r],nonscalar); -/* Manually convert student answers to the appropriate vector form. */ -/* If vectors do not conform then the original expression is returned. */ +/** + * Converts c and r into matrices. + * Works on entire expressions. + * Returns expression unchanged if simp:true and matrices do not conform. + * + * @param[expression] ex An expression that may contain c or r + * @return[scalar expression] The expression with c and r replaced with matrices, or the original expression if matrices do not conform + */ vec_convert(ex):= block([ex2], ex2: errcatch(ev(ex,c = lambda([[ex]],transpose(matrix(ex))),r = lambda([[ex]],matrix(ex)))), if emptyp(ex2) then return(ex) else return(first(ex2)) @@ -56,38 +62,72 @@ vec_convert(ex):= block([ex2], /* Predicate functions for vectors */ /*******************************************************************************/ -/* A predicate to determine whether an expression has been converted to matrix form. */ +/** + * A predicate to determine whether an expression has been converted to matrix form. + * + * @param[expression] ex An expression that may contain c or r + * @return[boolean] Does the expression contain c or r? + */ vec_convertedp(ex):= block([ex_ops], ex_ops: get_ops(ex), if member(c,ex_ops) or member(r,ex_ops) then return(false) else return(true) ); -/* Predicates for determining whether a given object is an Mx1 or 1xN matrix (a vector) */ -/* Note: excludes c() and r() by design. Use vec_convert() before these. */ +/** + * Predicate for determining whether a given object is an Mx1 matrix (a column vector) + * Note: does not consider c a column vector. Use vec_convert before col_vecp. + * + * @param[expression] ex An object that may be a matrix + * @return[boolean] Is the object an Mx1 matrix? + */ col_vecp(ex):= block( if not(matrixp(ex)) then return(false) else return(is(second(matrix_size(ex))=1)) ); +/** + * Predicate for determining whether a given object is a 1xN matrix (a row vector) + * Note: does not consider r a row vector. Use vec_convert before row_vecp. + * + * @param[expression] ex An object that may be a matrix + * @return[boolean] Is the object a 1xN matrix? + */ row_vecp(ex):= block( if not(matrixp(ex)) then return(false) else return(is(first(matrix_size(ex))=1)) ); +/** + * Predicate for determining whether a given object is a vector + * Note: does not consider c or r a vector. Use vec_convert before vectorp. + * + * @param[expression] ex An object that may be a matrix + * @return[boolean] Is the object a 1xN or Mx1 matrix? + */ vectorp(ex):= col_vecp(ex) or row_vecp(ex); /* TODO write function to convert row/col vectors in matrix form to c or r form */ /* Should be useful for creating teacher answers */ -/* Predicate to determine whether a given object is a unit vector. */ +/** + * Predicate to determine whether a given object is a unit vector. + * Can handle complex vectors + * + * @param[matrix] ex A vector (Mx1 or 1xN matrix) + * @return[boolean] Does this vector have a 2-norm of 1? + */ unit_vecp(ex):= if vectorp(ex) then is(ev(ex.conjugate(ex),simp)=1) else false; /*********************************************************************************/ /* Functions to extract parts of matrices */ /*********************************************************************************/ -/* Take the upper triangular part of a matrix, leaving the remaining entries = 0 */ - +/** + * Take the upper triangular part of a matrix, leaving the remaining entries = 0 + * + * @param[matrix] M An mxn matrix + * @return[matrix] The same matrix with all entries below the diagonal set to 0 + */ triu(M):= block([Mupp,imax,jmax,ii,jj], Mupp: copymatrix(M), [imax, jmax]: ev(matrix_size(M),simp), @@ -101,53 +141,102 @@ triu(M):= block([Mupp,imax,jmax,ii,jj], return(Mupp) ); -/* Take the lower triangular part of a matrix, leaving the remaining entries = 0 */ - +/** + * Take the lower triangular part of a matrix, leaving the remaining entries = 0 + * + * @param[matrix] M An mxn matrix + * @return[matrix] The same matrix with all entries above the diagonal set to 0 + */ tril(M):= transpose(triu(transpose(M))); -/* Takes the diagonal of a matrix, leaving the remaining entries = 0 */ - +/** + * Take the diagonal of a matrix, leaving the remaining entries = 0 + * + * @param[matrix] M An mxn matrix + * @return[matrix] The same matrix with all off-diagonal entries set to 0 + */ get_diag(M):= tril(triu(M)); -/* Extracts the diagonal of a matrix as a list. */ - +/** + * Extracts the diagonal of a matrix as a list + * + * @param[matrix] M An mxn matrix + * @return[list] The diagonal entries of M as a list + */ diag_entries(M):= ev(makelist(M[ii,ii],ii,1,lmin(matrix_size(M))),simp); /*********************************************************************************/ /* Predicate functions for matrices */ /*********************************************************************************/ -/* Is the matrix upper triangular? */ +/** + * Predicate to determine whether a matrix is upper triangular + * i.e. Is every entry below the diagonal equal to 0? + * Does not check whether a matrix is in row echelon form + * + * @param[matrix] M An mxn matrix + * @return[boolean] Is this matrix upper triangular? + */ triup(M):= if matrixp(M) then is(M = triu(M)) else false; -/* Is the matrix lower triangular? */ +/** + * Predicate to determine whether a matrix is lower triangular + * i.e. Is every entry above the diagonal equal to 0? + * + * @param[matrix] M An mxn matrix + * @return[boolean] Is this matrix lower triangular? + */ trilp(M):= if matrixp(M) then is(M = tril(M)) else false; -/* Is the matrix diagonal? */ +/** + * Predicate to determine whether a matrix is diagonal + * i.e. Is every off-diagonal entry equal to 0? + * + * @param[matrix] M An mxn matrix + * @return[boolean] Is this matrix diagonal? + */ diagp(M):= triup(M) and trilp(M); +/** + * Predicate to determine whether a matrix is in row echelon form + * i.e. Is every zero-row below all non-zero rows and does the pivot in each row appear to the right of the previous pivot? + * Optionally checks whether each pivot is equal to 1 + * No RREFp function is given, as rref(M) is unique + * + * @param[matrix] M An mxn matrix + * @param[boolean] normalise_pivots Optional: If true is given here, then pivots are required to be equal to 1 + * @return[boolean] Is this matrix in row echelon form? + */ REFp(M,[normalise_pivots]):= block([isREF,pivot_row,m,n,jj,ii], if emptyp(normalise_pivots) then normalise_pivots: false else normalise_pivots: first(normalise_pivots), - isREF: true, - pivot_row: 0, - [m, n]: matrix_size(M), - for jj: 1 thru n do block( - jj: ev(jj,simp), - if is(pivot_row < m) then block( - if is(M[ev(pivot_row+1,simp),jj] # 0) then block( - pivot_row: ev(pivot_row + 1,simp), - if normalise_pivots and is(M[ev(pivot_row,simp),jj] # 1) then isREF: false - ), - for ii: ev(pivot_row+1,simp) thru m do block( - ii: ev(ii,simp), - if is(M[ii,jj] # 0) then isREF: false + isREF: matrixp(M), + if isREF then block( + pivot_row: 0, + [m, n]: matrix_size(M), + for jj: 1 thru n do block( + jj: ev(jj,simp), + if is(pivot_row < m) then block( + if is(M[ev(pivot_row+1,simp),jj] # 0) then block( + pivot_row: ev(pivot_row + 1,simp), + if normalise_pivots and is(M[ev(pivot_row,simp),jj] # 1) then isREF: false + ), + for ii: ev(pivot_row+1,simp) thru m do block( + ii: ev(ii,simp), + if is(M[ii,jj] # 0) then isREF: false + ) ) ) ), return(isREF) ); -/* Is a given object a square matrix? */ +/** + * Is a given object a square matrix? + * i.e. Does the matrix have the same number of rows as columns? + * + * @param[matrix] M a matrix + * @return[boolean] Is M a square matrix? + */ squarep(M):= block([isSquare], isSquare: false, if matrixp(M) then block( @@ -156,14 +245,32 @@ squarep(M):= block([isSquare], return(isSquare) ); -/* Is a given object a diagonalisable matrix? */ +/** + * Is a given object a diagonalisable matrix? + * i.e. Is there an invertible matrix P and diagonal matrix D such that P^^-1 . M . P = D? + * + * @param[matrix] M a matrix + * @return[boolean] Is M a diagonalisable matrix? + */ diagonalisablep(M):= if squarep(M) then ev(diagp(dispJordan(jordan(M))),simp) else false; -/* Is a given object a symmetric matrix? */ -/* NOTE: The native function symmetricp() does the same thing and more, but is currently banned. */ +/** + * Is a given object a symmetric matrix? + * i.e. Is M = M^T? + * NOTE: The native function symmetricp() does the same thing and more, but is currently banned. + * + * @param[matrix] M a matrix + * @return[boolean] Is M a symmetric matrix? + */ sym_p(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; -/* Is a given object an invertible matrix? */ +/** + * Is a given object an invertible matrix? + * i.e. Is there a matrix M^^-1 such that M^^-1 . M = M . M^^-1 = I? + * + * @param[matrix] M a matrix + * @return[boolean] Is M an invertible matrix? + */ invertiblep(M):= block([isInvertible], isInvertible: false, if squarep(M) then block( @@ -172,13 +279,32 @@ invertiblep(M):= block([isInvertible], return(isInvertible) ); -/* Is a given object a matrix with orthogonal columns? */ +/** + * Is a given object a matrix with orthogonal columns? + * i.e. for any two distinct columns v1 and v2, is v1 . v2 = 0? + * + * @param[matrix] M a matrix + * @return[boolean] Does M have orthogonal columns? + */ orthogonal_columnsp(M):= ev(diagp(transpose(M).M),simp); -/* Is a given object a matrix with orthonormal columns? */ +/** + * Is a given object a matrix with orthonormal columns? + * i.e. Is M^T . M = I? For columns v_i and v_j, is v_i . v_i = 1 and v_i . v_j = 0? + * Useful when analysing QR factorisation for rectangular matrices + * + * @param[matrix] M a matrix + * @return[boolean] Does M have orthonormal columns? + */ orthonormal_columnsp(M):= if matrixp(M) then is(ev(transpose(M).M,simp) = ident(second(matrix_size(M)))) else false; -/* Is a given object an orthogonal matrix? */ +/** + * Is a given object an orthogonal matrix? + * i.e. Is M^T . M = M . M^T = I? + * + * @param[matrix] M a matrix + * @return[boolean] Is M an orthogonal matrix? + */ orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)); /*********************************************************************************/ @@ -189,9 +315,20 @@ orth_matrixp(M):= orthonormal_columnsp(M) and orthonormal_columnsp(transpose(M)) /* linearalgebra.mac prefers to work with either lists of lists (not distinguishing between column and row vectors) or matrices whose columns are vectors of interest. */ -/* A function to convert any of the following to a list of lists: - - op may be a list, ntuple, set, span, or matrix (considering its columns) - - elements of the op may be lists, sets, ntuples, matrices, c, or r. */ +/** + * Takes collections of vectors and returns a list of lists. + * The vectors themselves may be different objects. Supported objects include: + * * 1xN or Mx1 matrices + * * Lists + * * Vectors using c or r notation + * * Sets, ntuples + * Other inert functions like sequence should work too, but + * The collection may be a list, set, ntuple, span, or matrix + * If given a matrix, then returns the columns as a list, with each column also being a list. + * + * @param[] ex A list, set, ntuple or span containing vectors as matrices, lists, c, r, sets or ntuples, or a matrix + * @return[list] A list of lists + */ make_list_of_lists(ex):= block([op1], op1: safe_op(ex), /* TODO: What if given a single vector? */ @@ -204,7 +341,15 @@ make_list_of_lists(ex):= block([op1], return(ex) ); -/* Given a list of lists, construct a matrix with the entries as columns. */ +/** + * Given a list of lists, return the matrix that has those sub-lists as columns. + * Naming convention from numpy + * If the sub-lists do not conform then returns the list of lists instead + * Note: row_stack is absent because the remaining functions that accept matrices assume that we are considering columns. + * + * @param[list] ex a list of lists. Each sub-list must be the same length + * @return[matrix] A matrix whose columns are the entries of ex + */ column_stack(ex):= block([ex2], ex2: errcatch(transpose(apply(matrix,args(ex)))), if emptyp(ex2) then return(ex2) else return(first(ex2)) @@ -216,7 +361,13 @@ column_stack(ex):= block([ex2], /* Comparison functions */ /*********************************************************************************/ -/* Given a list of lists or a matrix, determine whether the list elements or columns are linearly independent. */ +/** + * Given a list of lists or a matrix, determine whether the list elements or columns are linearly independent. + * If ex is a matrix, it checks for full column rank, not row rank. To check for full rank generally, use invertiblep. + * + * @param[list or matrix] ex Either a list of lists (use make_list_of_lists if needed) or a matrix + * @return[boolean] Is the collection of vectors linearly independent? + */ lin_indp(ex):= block( if matrixp(ex) then return(is(rank(ex) = ev(second(matrix_size(ex)),simp))) else ex: column_stack(ex), @@ -224,22 +375,44 @@ lin_indp(ex):= block( return(false) ); -/* Given a pair of matrices, check whether they are row or column equivalent. */ +/** + * Given a pair of matrices, check whether they are row equivalent. + * i.e. can one matrix be transformed into the other with elementary row operations? + * + * @param[matrix] ex a mxn matrix + * @param[matrix] ta a mxn matrix + * @return[boolean] Are ex and ta row equivalent? + */ row_equiv(ex,ta):= block( if matrixp(ex) and matrixp(ta) then ( return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) ) ); +/** + * Given a pair of matrices, check whether they are column equivalent. + * i.e. can one matrix be transformed into the other with elementary column operations? + * + * @param[matrix] ex a mxn matrix + * @param[matrix] ta a mxn matrix + * @return[boolean] Are ex and ta column equivalent? + */ col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); -/* Given two lists of lists, determine whether they span the same subspace. */ -/* Note: This does not check for redundancies. To check whether two bases are equivalent, - use this function in conjunction with lin_indp. */ - +/** + * Given two lists of lists, determine whether they span the same subspace. + * i.e. Is each element of ex linearly dependent on ta and vice versa? + * Note: This does not check for redundancies. To check whether two bases are equivalent, use this function in conjunction with lin_indp. + * + * @param[list] ex A list of lists. Each sub-list must be the same length + * @param[list] ta A list of lists. Each sub-list must be the same length + * @return[boolean] Do the two lists of vectors span the same subspace? + */ subspace_equiv(ex,ta):= block([ex_rref,ta_rref], - ex_rref: ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp), - ta_rref: ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp), + ex_rref: errcatch(ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp)), + if emptyp(ex_rref) then return(false) else ex_rref: first(ex_rref), + ta_rref: errcatch(ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp)), + if emptyp(ta_rref) then return(false) else ta_rref: first(ta_rref), return(is(ev(ex_rref,simp)=ev(ta_rref,simp))) ); @@ -263,7 +436,14 @@ eigenvectorp(v,M):= block( /* Some useful functions to perform routine tasks or extend existing functions */ /*********************************************************************************/ -/* Given a list of lists or a matrix, remove linearly dependent entries/columns. */ +/** + * Given a list of lists or a matrix, remove linearly dependent entries/columns. + * Intended to be used to "trim down" to a basis when redundancies exist. + * Works from left to right, so the first instance of redundancy is removed in each case + * + * @param[list or matrix] ex A list of lists or a matrix + * @return[list or matrix] ex but with dependent entries or columns removed + */ remove_dep(ex):= block([ex_op,n_max,jj,ii], ex_op: "list", if matrixp(ex) then block(ex: args(transpose(ex)), ex_op: "matrix"), @@ -281,11 +461,16 @@ remove_dep(ex):= block([ex_op,n_max,jj,ii], return(ex) ); -/* Map significantfigures over a matrix */ -/* Should this be core functionality? Surely when given a matrix the base sigfigsfun +/** + * Map significantfigures over a matrix + * Should this be core functionality? Surely when given a matrix the base sigfigsfun or significantfigures function could do this by mapping itself over the arguments - and re-constructing the matrix. */ - + and re-constructing the matrix. + * Explicitly only runs over a matrix, list, or number + * + * @param[matrix] ex A matrix of numbers (also accepts lists or numbers) + * @param[positive integer] n The number of significant figures desired. + */ sf_map(ex,n):= block([rows], if matrixp(ex) then block( return(apply(matrix,map(lambda([ex2],significantfigures(ex2,n)),args(ex)))) @@ -293,8 +478,19 @@ sf_map(ex,n):= block([rows], else return(ex) ); -/* Construct a diagonal matrix of size m by n with diagonal given as a list */ - +/** + * Construct a diagonal matrix of size m by n with diagonal given as a list + * Similar to native function diag which builds a block diagonal matrix, but instead + is intended for numerical diagonals of rectangular matrices. + * Intended use case is to extend a reduced SVD into a full SVD + * If the whole diagonal does not fit in an mxn matrix, then it truncates d. + * If d is not long enough to fill an mxn matrix, remaining diagonal entries are set to 0. + * + * @param[list] d A list of numbers to go on the diagonal + * @param[positive integer] m The number of rows in the desired matrix + * @param[positive integer] n The number of columns in the desired matrix + * @return[matrix] A mxn matrix with d as the diagonal + */ diagmatrix_like(d, m, n):= block([M,ii], M: zeromatrix(m, n), for ii: 1 thru ev(min(m, n, length(d)),simp) do block( @@ -304,12 +500,15 @@ diagmatrix_like(d, m, n):= block([M,ii], return(M) ); -/* Returns the 2-norm of a matrix and 2-condition number of an invertible matrix */ - -/* I don't know if this has a good use case in a CAS like Maxima. - I would happily remove this if this feels out of place, as I don't - anticipate using this in my course regularly. */ - +/** + * Returns the 2-norm of a matrix as a float + * i.e. returns the largest singular value as a float + * Note: I don't know if this has a good use case in STACK. I would happily remove this if this feels out of place, as I don't + anticipate using this in my course regularly. + * + * @param[matrix] M the matrix whose norm is desired + * @return[float] The 2-norm of M, or und if M is not a matrix. + */ mat_norm2(M):= block([svs], if matrixp(M) then block( svs: ev(float(map(lambda([ex],sqrt(cabs(ex))),first(eigenvalues(transpose(M).M)))),simp), @@ -317,6 +516,16 @@ mat_norm2(M):= block([svs], ) else return(und) ); +/** + * Returns the condition number of a matrix based on the 2-norm as a float + * i.e. returns the ratio of the largest singular value to the smallest singular value as a float + * If M is singular, then und is returned instead. + * Note: I don't know if this has a good use case in STACK. I would happily remove this if this feels out of place, as I don't + anticipate using this in my course regularly. + * + * @param[matrix] M the matrix whose condition number is desired + * @return[float] The 2-condition number of M, or und if M is not an invertible matrix. + */ mat_cond2(M):= block([svs,cond2], cond2: und, if invertiblep(M) then block( @@ -326,12 +535,17 @@ mat_cond2(M):= block([svs,cond2], return(cond2) ); -/* Solve the matrix equation Ax = b given matrix A and column vector (or list) b. */ -/* Optional extra argument: mat_solve(A,b,true) will find the least squares solution symbolically. */ -/* Note that the least squares solution may be non-unique (in the case of linearly dependent columns) */ -/* For minimal least squares solution, use pinv(A) . b (see below) */ -/* Always returns a matrix output. */ - +/** + * Solve the matrix equation Ax = b given matrix A and column vector (or list) b. + * Optionally will find a least squares solution + * Always returns a general solution if one exists, even in the least squares case + * If a single solution is required, use pseudoinverse(A) . b instead. + * + * @param[matrix] A An mxn matrix + * @param[matrix] b A mx1 matrix (or a list with m entries) + * @param[boolean] lstsq Optional: if given true then a least squares solution will be obtained. If false or omitted, only exact solutions obtained. + * @return[matrix] The general solution to Ax = b. If no solution exists and lstsq is not true, then matrix([]) is returned. + */ mat_solve(A,b,[lstsq]):= block([m,n,vars,eqns,sol], if emptyp(lstsq) then lstsq: false else lstsq:first(lstsq), if listp(b) then b: transpose(b), @@ -344,9 +558,16 @@ mat_solve(A,b,[lstsq]):= block([m,n,vars,eqns,sol], if emptyp(sol) then return(matrix(sol)) else return(transpose(matrix(sol))) ); -/* Given a list of lists or a matrix, make a basis for R^m where m = length of each vector. */ -/* If you don't want to expand to R^m, use remove_dep instead */ -/* Optional input: basisify(ex,true) will make it an orthonormal basis. */ +/** + * Given a list of lists or a matrix, make a basis for R^m where m = length of each vector. + * If you don't want to expand to R^m, use remove_dep instead (it is called here too) + * Optionally will make this basis orthonormal, mostly useful when the existing basis is orthogonal but not R^m + * Arguably "basisify" is a poor name - suggestions welcome before published + * + * @param[matrix or list] M A matrix or list of lists + * @param[boolean] orth Optional: if true then returned basis will be orthonormal. Note that this may remove some basis vectors if they are not already orthogonal. + * @return[matrix or list] A basis for R^m where m is the length of each vector in M + */ basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], if emptyp(orth) then orth: false else orth: first(orth), @@ -367,7 +588,12 @@ basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], if is(ex_op="matrix") then return(transpose(apply(matrix,vecs))) else return(vecs) ); -/* Maps the gcd (greatest common divisor) function across a list */ +/** + * Maps the gcd (greatest common divisor) function across a list iteratively + * + * @param[list] ex A list of numbers + * @return[number] The greatest common divisor of all elements in ex + */ lgcd(ex):= block([ex_gcd,ii], ex_gcd: first(ex), for ii: 2 thru length(ex) do block( @@ -377,7 +603,14 @@ lgcd(ex):= block([ex_gcd,ii], return(ex_gcd) ); -/* Given a vector (or list) return the shortest possible parallel vector with integer entries. */ +/** + * Given a vector (or list) return the shortest possible parallel vector with integer entries. + * Also multiplies by -1 if all entries are negative + * Very nice for eigenvector problems. + * + * @param[matrix or list] v a list or a Mx1 or 1xN matrix + * @return[matrix or list] v, but scaled by a constant such that all entries are the smallest possible integers + */ integerify(v):= block([v_op], v_op: "list", if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), @@ -391,15 +624,42 @@ integerify(v):= block([v_op], rowspace must exist too, but it doesn't. The nullTspace function was added for completeness' sake, and finds the nullspace of M^T. We could call it the cokernel function, but since maxima uses nullspace rather than kernel this feels inappropriate. */ - +/** + * Returns the row space of a matrix as a collection of column vectors. + * Output is the inert function span, the same as columnspace gives. + * + * @param[matrix] M a matrix + * @return[span] A span of column vectors + */ rowspace(M):= ev(columnspace(transpose(M)),simp); + +/** + * Returns the cokernel of a matrix (the null space of its transpose) as a collection of column vectors. + * Output is the inert function span, the same as nullspace gives. + * + * @param[matrix] M a matrix + * @return[span] A span of column vectors + */ nullTspace(M):= ev(nullspace(transpose(M)),simp); -/* Computes the Rayleigh quotient */ +/** + * Computes the Rayleigh quotient + * Defined as (Ax).x/(x.x) + * + * @param[matrix] M a mxn matrix + * @param[matrix] v a nx1 matrix + * @return[number] the Rayleigh quotient of M and v + */ Rayleigh(M,v):= ev((conjugate(transpose(v)) . M . v) / (conjugate(transpose(v)) . v),simp); -/* Compute the algebraic and geometric multiplicity of an eigenvalue. */ -/* Returns 0 if L is not an eigenvalue of M. */ +/** + * Compute the algebraic multiplicity of an eigenvalue. + * Returns 0 if L is not an eigenvalue of M. + * + * @param[matrix] M a square matrix + * @param[number] L an eigenvalue of M + * @return[non-negative integer] the algebraic multiplicity of L in M. 0 if L is not an eigenvalue of M + */ alg_mult(M,L):= block([evals,ii], if squarep(M) then block( evals: ev(eigenvalues(M),simp), @@ -409,6 +669,14 @@ alg_mult(M,L):= block([evals,ii], ) ); +/** + * Compute the geometric multiplicity of an eigenvalue. + * Returns 0 if L is not an eigenvalue of M. + * + * @param[matrix] M a square matrix + * @param[number] L an eigenvalue of M + * @return[non-negative integer] the geometric multiplicity of L in M. 0 if L is not an eigenvalue of M + */ geo_mult(M,L):= block([evals,evects,ii], if squarep(M) then block( [evals, evects]: ev(eigenvectors(M),simp), @@ -418,7 +686,13 @@ geo_mult(M,L):= block([evals,evects,ii], ) ); -/* Find the matrix that projects orthogonally onto the column space of M */ +/** + * Find the matrix that projects orthogonally onto the column space of M + * Computed by removing linearly dependent columns and then using M.(M^T.M)^^-1.M^T + * + * @param[matrix] M An mxn matrix + * @return[matrix] A symmetric, idempotent mxm matrix that projects mx1 vectors into the columnspace of M + */ projection_matrix(M):= block([reduced_M], if ev(zeromatrixp(M),simp) then return(0), reduced_M: mat_unblocker(matrix(args(ev(columnspace(M),simp)))), @@ -440,12 +714,19 @@ projection_matrix(M):= block([reduced_M], /* PM = LU */ /* The built-in functions throw errors at annoying times and require two function calls. */ -/* TODO: Surely we can make a better function that works for singular and/or rectangular matrices? */ +/* TODO: Surely we can make a better function that works for rectangular matrices? */ /* get_PLU(M):= block( if invertiblep(M) then return(ev(get_lu_factors(lu_factor(M)),simp)) else return([]) ); */ -/* M = QR */ +/** + * M = QR + * M must have full column rank + * Q has orthonormal columns that span the columnspace of M + * R is upper triangular + * + * @param[matrix] M a matrix with full column rank + */ QR(M):= block([cols,Q,R], if is(rank(M)#second(matrix_size(M))) then return([]), cols: ev(gramschmidt(transpose(M)),simp), @@ -455,9 +736,15 @@ QR(M):= block([cols,Q,R], return([Q,R]) ); -/* M = P.J.P^^-1 */ -/* This really just calls existing functions in one go - and avoids annoying errors. */ +/** + * M = P.J.P^^-1 + * J is in Jordan normal form + * P is invertible and made up of generalised eigenvectors of M + * This really just calls existing functions in one go and avoids annoying errors. + * + * @param[matrix] M a square matrix + * @return[list] A list of two matrices: [P, J] such that J is in Jordan form and M = P . J . P^^-1. Returns empty list if M is not a square matrix + */ get_Jordan_form(M):= block([jordan_info,J,P], if not(squarep(M)) then return([]), jordan_info: ev(jordan(M),simp), @@ -466,8 +753,16 @@ get_Jordan_form(M):= block([jordan_info,J,P], return([P,J]) ); -/* M = P.D.P^^-1 */ -/* If M is symmetric it will automatically orthogonally diagonalise */ +/** + * M = P.D.P^^-1 + * M must be diagonalisable (i.e. all eigenvalues must have matching geometric and algebraic multiplicities) + * P is invertible and contains the eigenvectors of M + * D is diagonal and contains the eigenvalues of M + * If M is symmetric it will automatically orthogonally diagonalise + * + * @param[matrix] M a diagonalisable matrix + * @return[list] A list of two matrices: [P, D] such that D is diagonal and M = P . D . P^^-1. Returns empty list if M is not diagonalisable + */ diagonalise(M):= block([P,D], if not(squarep(M)) then return([]), [P, D]: get_Jordan_form(M), @@ -475,8 +770,15 @@ diagonalise(M):= block([P,D], if diagp(D) then return([P,D]) else return([]) ); -/* Reduced SVD */ -/* Always produces minimum required diagonal Sigma and associated U and V. */ +/** + * Reduced SVD + * M = U.S.V^T with M as a rank r mxn matrix + * S is an rxr invertible diagonal matrix containing the sorted non-zero singular values of M + * V and U have orthonormal columns, with V nxr and U mxr + * + * @param[matrix] An mxn matrix + * @return[list] A list of 3 matrices [U,S,VT] such that U has orthonormal columns, VT has orthonormal rows, S is invertible diagonal, and M = U.S.VT + */ SVD_red(M):= block([MTM,V,S2,components,n,S,U,ii], if ev(zeromatrixp(M),simp) then return([matrix([]),matrix([]),matrix([])]), MTM: ev(transpose(M).M,simp), @@ -504,16 +806,30 @@ SVD_red(M):= block([MTM,V,S2,components,n,S,U,ii], return([U,S,transpose(V)]) ); -/* M^+ = V.S^+.U^T */ -/* Moore-penrose pseudoinverse. I'm convinced this routine exists somewhere in a package, - because I've used it before in other maxima terminals, but I was unable to find it. */ +/** + * M^+ = V.S^+.U^T + * Moore-penrose pseudoinverse. + * I'm convinced this routine exists somewhere in a package, because I've used it before in other maxima terminals, but I was unable to find it. + * Most commonly used to find minimal least squares solution to Ax = b using A^+ . b + * + * @param[matrix] M + * @return[matrix] The moore-penrose pseudoinverse of M + */ pinv(M):= block([U,S,VT], if ev(zeromatrixp(M),simp) then return(M), [U, S, VT]: SVD_red(M), return(ev(transpose(VT) . invert(S) . transpose(U),simp)) ); -/* Full SVD */ +/** + * Full SVD + * M = U.S.V^T with M as a rank r mxn matrix + * S is an mxn diagonal matrix containing the sorted singular values of M + * V and U are orthogonal matrices, with V nxn and U mxm + * + * @param[matrix] An mxn matrix + * @return[list] A list of 3 matrices [U,S,VT] such that U is mxm orthogonal, VT is nxn orthogonal, S is mxn diagonal, and M = U.S.VT + */ SVD(M):= block([U,S,VT], [U, S, VT]: SVD_red(M), if is(U=matrix([])) then U: ident(first(matrix_size(M))) else U: basisify(U,true), From 52af4329cf384a4e245f31aa9e9e1960b0cb3852 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Wed, 29 May 2024 17:11:55 +1200 Subject: [PATCH 17/26] Update linearalgebra.mac - Added support for displaying augmented matrices easily using an inert function and texput. Also added `aug` and `de_aug` to convert matrices in and out of this mode. - Reworked `triu`, `tril`, `get_diag`, `triup`, `trilp`, `diagp`, and `diag_entries`. These should be significantly more efficient now. Thanks for the `genmatrix` tip-off Georg Osang! - Added `un_vec_convert` to change matrices into `c` and `r` form. Mostly intended for making teachers' answers the format we expect students to use. - Added a line to `make_list_of_lists` that will take a single vector and make it a list of a list. e.g. `[1,2,k]` -> `[[1,2,k]]`. - Edited `orthogonal_columnsp` and associated functions to forcibly expand the matrix before comparing. Thanks Georg! - Added support for eigenproblems. This includes - `eigenvaluep` and `eigenvectorp` which check whether a given value or vector is "eigen". Optionally checks them against a given vector or value respectively. - `get_eigenvalue` and `get_eigenvector` to extract the corresponding one from a given. Much nicer than using `eigenvectors` when you only want one! Can also orthonormalise the basis if requested. - Moved `Rayleigh` up to be with these. - Added support for vector parametric equations. It's a bit sparse, but these functions can check whether a given expression is of the desired form, and if so extract the useful bits (linear offset, direction vectors, parameters) and then format this nicely for TeX display. This is the only remaining TODO: add support for other vector input options, notably lists and ntuples. This will likely not happen in 2024. - Finished off `disp_eqns` and added `mat_disp_eqns` to do the same given `A` and `b` instead of a list of equations. - I've given up on PLU for now and have thus removed this section. I think that `rref`, `triangularize`, `echelon` and `lu_factor` do a good enough job, though it's still baffling to me that none of them do partial pivoting, nor do they avoid scaling rows unnecessarily. --- stack/maxima/contrib/linearalgebra.mac | 344 ++++++++++++++++++++----- 1 file changed, 278 insertions(+), 66 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 85df2f6221e..fcd119faa59 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -16,7 +16,7 @@ /****************************************************************/ /* Linear algebra functions for STACK */ /* */ -/* V0.2.3 May 2024 */ +/* V0.2.4 May 2024 */ /* */ /****************************************************************/ @@ -58,6 +58,58 @@ vec_convert(ex):= block([ex2], if emptyp(ex2) then return(ex) else return(first(ex2)) ); +/** + * Given a row or column vector, convert it to c() or r() form. + * Intended to create model answers in instances where students + * are expected to use these convenience functions. + * Does not loop through an expression, will only work on vectors + * as individual objects. + * + * @param[matrix] ex A vector; i.e. a 1xN or Mx1 matrix + * @return[expression] That vector as a c() or r() vector + */ +un_vec_convert(ex):= block([], + if col_vecp(ex) then ex: apply(c,list_matrix_entries(ex)) else + if row_vecp(ex) then ex: apply(r,list_matrix_entries(ex)), + return(ex) +); + +/*******************************************************************************/ +/* A convenience function for displaying a matrix as an augmented matrix */ +/*******************************************************************************/ +texput(aug_matrix, lambda([ex], block([M,ll,rr,m,n,A,b,simp], + simp:true, + M: apply(matrix,args(ex)), + ll: lmxchar, + if is(ll="[") then rr: "]" + else if is(ll="(") then rr: ")" + else if is(ll="") then (ll: ".", rr: ".") + else if is(ll="{") then (ll: "\\{", rr: "\\}") + else if is(ll="|") then rr: "|", + [m, n]: matrix_size(M), + A: submatrix(M,n), + b: col(M,n), + sconcat("\\left",ll,block([lmxchar],lmxchar:"",tex1(A)),"\\right|\\left.",block([lmxchar],lmxchar:"",tex1(b)),"\\right",rr) +))); + +/** + * Converts a matrix to an aug_matrix + * aug_matrix is an inert function that is used for displaying a matrix as an augmented matrix + * To convert back, use de_aug + * + * @param[matrix] M The matrix you would like to display as an augmented matrix + * @return[aug_matrix] An augmented matrix + */ +aug(M):= apply(aug_matrix,args(M)); + +/** + * Converts an aug_matrix to a matrix + * aug_matrix is an inert function that is used for displaying a matrix as an augmented matrix + * + * @param[matrix] M The aug_matrix you would like to treat as a regular matrix + * @return[aug_matrix] A matrix + */ +de_aug(M):= apply(matrix,args(M)); /*******************************************************************************/ /* Predicate functions for vectors */ /*******************************************************************************/ @@ -128,17 +180,10 @@ unit_vecp(ex):= if vectorp(ex) then is(ev(ex.conjugate(ex),simp)=1) else false; * @param[matrix] M An mxn matrix * @return[matrix] The same matrix with all entries below the diagonal set to 0 */ -triu(M):= block([Mupp,imax,jmax,ii,jj], - Mupp: copymatrix(M), +triu(M):= block([imax,jmax], + if not(matrixp(M)) then return(M), [imax, jmax]: ev(matrix_size(M),simp), - for ii: 2 thru imax do block( - ii: ev(ii,simp), - for jj: 1 thru ev(min(ii-1, jmax),simp) do block( - jj: ev(jj,simp), - Mupp[ii,jj]: 0 - ) - ), - return(Mupp) + genmatrix(lambda ([ii, jj], if ii>jj then 0 else M[ii,jj]), imax, jmax) ); /** @@ -147,7 +192,11 @@ triu(M):= block([Mupp,imax,jmax,ii,jj], * @param[matrix] M An mxn matrix * @return[matrix] The same matrix with all entries above the diagonal set to 0 */ -tril(M):= transpose(triu(transpose(M))); +tril(M):= block([imax,jmax], + if not(matrixp(M)) then return(M), + [imax, jmax]: ev(matrix_size(M),simp), + genmatrix(lambda ([ii, jj], if ii Date: Mon, 10 Jun 2024 13:13:35 +1200 Subject: [PATCH 19/26] Update linearalgebra.mac Added - rowscale and columnscale, intended as complements to rowop, rowswap, columnop and columnswap. It is odd that the third elementary row/column operation is not included by default. - setrowmx, setcolmx, and setdiagmx, intended as complements to setelmx. Used to overwrite rows, columns or diagonals. --- stack/maxima/contrib/linearalgebra.mac | 108 +++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index fcd119faa59..5b21e9454e9 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -221,6 +221,80 @@ diag_entries(M):= block([], return(map(lambda([ex], M[ex,ex]),ev(makelist(ii,ii,1,lmin(matrix_size(M))),simp))) ); +/* We have setelmx by default to set M[i,j]: el, and we can use M[i]: r + to set a row of M, but columns and diagonals require a bit more thought. + To match setelmx, here are setrowmx, setcolmx, and setdiagmx. They + have the added advantage of allowing either a replacement list or a + number that is to be repeated in the relevant part of the matrix. */ + +/** + * Replace row i of matrix M with r. + * If r is a list or a matrix, replace the row exactly. Nothing will happen if r does not conform. + * If r is a number, fill row i with the value r. + * Companion to setelmx + * + * @param[number, list or matrix] r the replacement row (or value that will be repeated in the row) + * @param[integer] i the index of the row that will be replaced + * @param[matrix] M the matrix whose row is being replaced + * @return[matrix] The matrix M with row i replaced by r. + */ +setrowmx(r,i,M):= block([rows], + rows: args(copymatrix(M)), + if matrixp(r) then r: list_matrix_entries(r), + if numberp(r) then r: ev(makelist(r,ii,1,second(matrix_size(M))),simp), + if listp(r) then rows[i]: r, + errcatch(M: apply(matrix,rows)), + return(M) +); + +/** + * Replace column i of matrix M with c. + * If c is a list or a matrix, replace the column exactly. Nothing will happen if c does not conform. + * If c is a number, fill row i with the value c. + * Companion to setelmx + * + * @param[number, list or matrix] c the replacement column (or value that will be repeated in the column) + * @param[integer] i the index of the column that will be replaced + * @param[matrix] M the matrix whose column is being replaced + * @return[matrix] The matrix M with column i replaced by c. + */ +setcolmx(c,i,M):= block([cols], + cols: args(copymatrix(transpose(M))), + if matrixp(c) then c: list_matrix_entries(c), + if numberp(c) then c: ev(makelist(c,ii,1,first(matrix_size(M))),simp), + if listp(c) then cols[i]: c, + errcatch(M: transpose(apply(matrix,cols))), + return(M) +); + +/** + * Replace diagonal k of matrix M with L. + * If L is a list, replace the diagonal exactly. + * If L is too short to fill the diagonal, then any remaining diagonal entries are untouched + * If L is too long for the diagonal, then only the first l entries of L are used, where l is the length of the diagonal. + * If L is a number, fill the diagonal with the value L. + * If the optional argument k is given, then choose the kth diagonal. For example, setdiagmx(L,M,1) will adjust the values one entry above the primary diagonal. + * Companion to setelmx + * + * @param[number or list] L the replacement diagonal (or value that will be repeated in the diagonal) + * @param[matrix] M the matrix whose column is being replaced + * @param[integer] Optional: k the diagonal offset. + * @return[matrix] The matrix M with diagonal k replaced by L. + */ +setdiagmx(L,M,[k]):= block([m,n,ii,jj], + [m, n]: matrix_size(M), + if emptyp(k) then k: 0 else k: first(k), + if not(listp(L)) then L: ev(makelist(L,ii,1,max(m,n)),simp), + for ii: 1 thru m do block( + ii: ev(ii,simp), + for jj: 1 thru n do block( + jj: ev(jj,simp), + if ev(is(ii+k=jj),simp) then errcatch(M[ii,jj]: L[ev(min(ii,jj),simp)]) + ) + ), + return(M) +); + /*********************************************************************************/ /* Predicate functions for matrices */ /*********************************************************************************/ @@ -800,6 +874,40 @@ rowspace(M):= ev(columnspace(transpose(M)),simp); */ nullTspace(M):= ev(nullspace(transpose(M)),simp); +/* We have rowswap, rowop, columnswap, columnop, but no scaling versions. + I do acknowledge that you can recreate these with rowop, but this is + non-intuitive, so it's nice to have these functions lying around. */ +/** + * Scales row i of matrix A by alpha. + * A companion to rowop and rowswap. + * R_i <- alpha*R_i + * + * @param[matrix] M The matrix whose row you are scaling + * @param[integer] i The row you are scaling + * @param[number] alpha The amount you are scaling the row. + * @return[matrix] R_i <- alpha*R_i + */ +rowscale(M,i,alpha):= block([], + M[i]: map(lambda([ex],alpha*ex),M[i]), + return(M) +); + +/** + * Scales column i of matrix A by alpha. + * A companion to columnop and columnswap. + * C_i <- alpha*C_i + * + * @param[matrix] M The matrix whose column you are scaling + * @param[integer] i The column you are scaling + * @param[number] alpha The amount you are scaling the column. + * @return[matrix] C_i <- alpha*C_i + */ +columnscale(M,i,alpha):= block([MT], + MT: transpose(M), + MT[i]: map(lambda([ex],alpha*ex),MT[i]), + return(transpose(MT)) +); + /** * Compute the algebraic multiplicity of an eigenvalue. * Returns 0 if L is not an eigenvalue of M. From 3c6d10eafda87d46f8adba2cadf50347a3398755 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Mon, 10 Jun 2024 13:15:50 +1200 Subject: [PATCH 20/26] Update linearalgebra_test.mac Added tests for new functions in linearalgebra --- stack/maxima/contrib/linearalgebra_test.mac | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/stack/maxima/contrib/linearalgebra_test.mac b/stack/maxima/contrib/linearalgebra_test.mac index 0b1eb395af9..e9678aad73c 100644 --- a/stack/maxima/contrib/linearalgebra_test.mac +++ b/stack/maxima/contrib/linearalgebra_test.mac @@ -80,6 +80,9 @@ s_test_case(diag_entries(matrix([3,0,0,0],[0,2,0,0],[0,0,1,0])),[3,2,1]); s_test_case(diag_entries(matrix([1+2,0,0,0],[0,2,0,0],[0,0,1,0])),[1+2,2,1]); s_test_case(diag_entries(1),[1]); +s_test_case(rowscale(matrix([1,2,3],[4,5,6],[7,8,9]),2,100),matrix([1,2,3],[100*4,100*5,100*6],[7,8,9])); +s_test_case(columnscale(matrix([1,2,3],[4,5,6],[7,8,9]),2,100),matrix([1,100*2,3],[4,100*5,6],[7,100*8,9])); + s_test_case(triup(ident(5)),true); s_test_case(trilp(ident(5)),true); s_test_case(diagp(ident(5)),true); @@ -271,6 +274,19 @@ s_test_case(rowspace(ident(2)),span(matrix([1],[0]),matrix([0],[1]))); s_test_case(rowspace(matrix([1,0],[0,1],[1,1])),span(matrix([1],[0]),matrix([0],[1]))); s_test_case(nullTspace(matrix([1,0],[0,1],[1,1])),span(matrix([-1],[-1],[1]))); +s_test_case(setrowmx(1,2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[1,1,1],[7,8,9])); +s_test_case(setrowmx([%e,%pi,%i],2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[%e,%pi,%i],[7,8,9])); +s_test_case(setrowmx(transpose([%e,%pi,%i]),2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[%e,%pi,%i],[7,8,9])); + +s_test_case(setcolmx(1,2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,1,3],[4,1,6],[7,1,9])); +s_test_case(setcolmx([%e,%pi,%i],2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,%e,3],[4,%pi,6],[7,%i,9])); +s_test_case(setcolmx(transpose([%e,%pi,%i]),2,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,%e,3],[4,%pi,6],[7,%i,9])); + +s_test_case(setdiagmx(1,matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,2,3],[4,1,6],[7,8,1])); +s_test_case(setdiagmx(1,matrix([1,2,3],[4,5,6],[7,8,9]),1),matrix([1,1,3],[4,5,1],[7,8,9])); +s_test_case(setdiagmx(1,matrix([1,2,3],[4,5,6],[7,8,9]),-2),matrix([1,2,3],[4,5,6],[1,8,9])); +s_test_case(setdiagmx([10,20,30,40,50],matrix([1,2,3,4],[4,5,6,7],[7,8,9,10]),2),matrix([1,2,10,4],[4,5,6,20],[7,8,9,10])); + s_test_case(Rayleigh(matrix([1,1],[1,1]),matrix([1],[1])),2); s_test_case(Rayleigh(matrix([1,1],[0,1]),matrix([1],[1])),3/2); s_test_case(Rayleigh(matrix([0,-1],[1,0]),matrix([%i],[2])),(4*%i)/5); From 0dbcbc87b592acf10a65e51fd83dbc0c936ab553 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Mon, 17 Jun 2024 13:45:09 +1200 Subject: [PATCH 21/26] Update linearalgebra.mac Changed the names of some functions per suggestions from others; added two more vector parametric equation functions to test whether a given point is in a given affine subspace and whether a given vector is in a given vector subspace. --- stack/maxima/contrib/linearalgebra.mac | 62 +++++++++++++++++++------- 1 file changed, 47 insertions(+), 15 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 5b21e9454e9..5ffceab9705 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -204,7 +204,7 @@ tril(M):= block([imax,jmax], * @param[matrix] M An mxn matrix * @return[matrix] The same matrix with all off-diagonal entries set to 0 */ -get_diag(M):= block([imax,jmax], +diagonal(M):= block([imax,jmax], if not(matrixp(M)) then return(M), [imax, jmax]: ev(matrix_size(M),simp), return(genmatrix(lambda([ii, jj], if is(ii=jj) then M[ii,jj] else 0), imax, jmax)) @@ -430,7 +430,7 @@ diagonalisablep(M):= if squarep(M) then ev(diagp(dispJordan(jordan(M))),simp) el * @param[matrix] M a matrix * @return[boolean] Is M a symmetric matrix? */ -sym_p(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; +symp(M):= if squarep(M) then is(M = ev(transpose(M),simp)) else false; /** * Is a given object an invertible matrix? @@ -551,7 +551,7 @@ lin_indp(ex):= block( * @param[matrix] ta a mxn matrix * @return[boolean] Are ex and ta row equivalent? */ -row_equiv(ex,ta):= block( +row_equivp(ex,ta):= block( if matrixp(ex) and matrixp(ta) then ( return(is(ev(rref(ex),simp) = ev(rref(ta),simp))) ) @@ -565,7 +565,7 @@ row_equiv(ex,ta):= block( * @param[matrix] ta a mxn matrix * @return[boolean] Are ex and ta column equivalent? */ -col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); +col_equivp(ex,ta):= row_equivp(transpose(ex),transpose(ta)); /** * Given two lists of lists, determine whether they span the same subspace. @@ -576,7 +576,7 @@ col_equiv(ex,ta):= row_equiv(transpose(ex),transpose(ta)); * @param[list] ta A list of lists. Each sub-list must be the same length * @return[boolean] Do the two lists of vectors span the same subspace? */ -subspace_equiv(ex,ta):= block([ex_rref,ta_rref], +subspace_equivp(ex,ta):= block([ex_rref,ta_rref], ex_rref: errcatch(ev(sublist(args(rref(apply(matrix,ex))),lambda([ex2],not(every(lambda([ex3],is(ex3=0)),ex2)))),simp)), if emptyp(ex_rref) then return(false) else ex_rref: first(ex_rref), ta_rref: errcatch(ev(sublist(args(rref(apply(matrix,ta))),lambda([ta2],not(every(lambda([ta3],is(ta3=0)),ta2)))),simp)), @@ -660,7 +660,7 @@ get_eigenvector(L,M,[orthonormalise]):= block([evals,evects,ii], ii:ev(first(sublist_indices(first(evals),lambda([ex],is(ex=L)))),simp), vecs: evects[ii], if orthonormalise then vecs: ev(map(lambda([ex],ex/sqrt(ex.ex)),gramschmidt(vecs)),simp) - else vecs: map(integerify,vecs), + else vecs: map(scale_nicely,vecs), return( map(transpose,vecs) ) ); @@ -826,13 +826,8 @@ basisify(M,[orth]):= block([ex_op,m,n,vecs,new_vecs,ii], * @param[list] ex A list of numbers * @return[number] The greatest common divisor of all elements in ex */ -lgcd(ex):= block([ex_gcd,ii], - ex_gcd: first(ex), - for ii: 2 thru length(ex) do block( - ii: ev(ii,simp), - ex_gcd: gcd(ex_gcd,ex[ii]) - ), - return(ex_gcd) +lgcd(ex):= block([], + return(lreduce(lambda([ex1,ex2],gcd(ex1,ex2)),ex)) ); /** @@ -843,7 +838,7 @@ lgcd(ex):= block([ex_gcd,ii], * @param[matrix or list] v a list or a Mx1 or 1xN matrix * @return[matrix or list] v, but scaled by a constant such that all entries are the smallest possible integers */ -integerify(v):= block([v_op], +scale_nicely(v):= block([v_op], v_op: "list", if vectorp(v) then (v_op: "matrix", v: list_matrix_entries(v)), tmp: ev(lgcd(v),simp), @@ -1014,6 +1009,43 @@ vector_parametric_display(parts):= block([simp], return(sconcat(tex1(cons_vec),"+",tex1(apply("+", zip_with("*", vars, dir_vecs))))) ); +/** + * Is a given point in a given affine subspace (e.g. a line, plane, etc)? + * Intended for use with vector_parametric_parts function + * + * @param[matrix] p The point of interest + * @param[list] parts The output of vector_parametric_parts. This is a three-element list of the form [constant_vector, [list of direction vectors], [list of parameters]]. All vectors should be mx1 matrices. The third element can be omitted if building the list manually. + * @return[boolean] Is p in the affine subspace? + */ +point_in_affine_spacep(p,parts):= block([simp:true], + cons_vec: first(parts), + dir_vecs: second(parts), + if is(length(parts)>2) then vars: third(parts) else vars: rest(stack_var_makelist(tmp,length(dir_vecs))), + errcatch( + eqns: list_matrix_entries(cons_vec - p + apply("+", zip_with("*", vars, dir_vecs))), + soln: linsolve(eqns,vars) + ), + if listp(soln) then if is(length(soln)>0) then return(true) else return(false) +); + +/** + * Is a given vector in a given subspace? + * If v is a zero vector, returns false by default as the intended use case is determining whether a given DIRECTION vector is in a subspace. + * + * @param[matrix] v The vector of interest + * @param[list] dir_vecs A list of mx1 matrices that span the subspace. Does not need to be a basis. + * @param[boolean] allow_zero Optional: If given true, then the zero vector will return true, otherwise zero vectors will return false + * @return[boolean] Is v in the subspace? + */ +vector_in_spacep(v,dir_vecs,[allow_zero]):= block([simp:true,is_dep:false], + if emptyp(allow_zero) then allow_zero: false else allow_zero: first(allow_zero), + if zeromatrixp(v) then return(allow_zero), + errcatch( + is_dep: is(rank(mat_unblocker(matrix(dir_vecs)))=rank(mat_unblocker(matrix(append(dir_vecs,[v]))))) + ), + return(is_dep) +); + /*********************************************************************************/ /* Matrix factorisations */ /*********************************************************************************/ @@ -1074,7 +1106,7 @@ get_Jordan_form(M):= block([jordan_info,J,P], diagonalise(M):= block([P,D], if not(squarep(M)) then return([]), [P, D]: get_Jordan_form(M), - if sym_p(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), + if symp(M) then P: ev(transpose(apply(matrix,map(lambda([ex],ex/sqrt(ex.ex)),args(transpose(P))))),simp), if diagp(D) then return([P,D]) else return([]) ); From 5273336e6ea770aae322276b2cb06610b334d0b2 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Mon, 17 Jun 2024 13:48:00 +1200 Subject: [PATCH 22/26] Update linearalgebra_test.mac Adjusted test cases for recent commit to linearalgebra.mac --- stack/maxima/contrib/linearalgebra_test.mac | 74 ++++++++++++--------- 1 file changed, 43 insertions(+), 31 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra_test.mac b/stack/maxima/contrib/linearalgebra_test.mac index e9678aad73c..4ca04d19aae 100644 --- a/stack/maxima/contrib/linearalgebra_test.mac +++ b/stack/maxima/contrib/linearalgebra_test.mac @@ -68,11 +68,11 @@ s_test_case(tril(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[4,5,0 s_test_case(tril(matrix([1,2],[3,2+2])),matrix([1,0],[3,2+2])); s_test_case(tril(1),1); -s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0,0,9])); -s_test_case(get_diag(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); -s_test_case(get_diag(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); -s_test_case(get_diag(matrix([1,2],[3,2+2])),matrix([1,0],[0,2+2])); -s_test_case(get_diag(1),1); +s_test_case(diagonal(matrix([1,2,3],[4,5,6],[7,8,9])),matrix([1,0,0],[0,5,0],[0,0,9])); +s_test_case(diagonal(matrix([1,2,3],[4,5,6],[7,8,9],[10,11,12])),matrix([1,0,0],[0,5,0],[0,0,9],[0,0,0])); +s_test_case(diagonal(matrix([1,2,3,4],[4,5,6,7],[7,8,9,10])),matrix([1,0,0,0],[0,5,0,0],[0,0,9,0])); +s_test_case(diagonal(matrix([1,2],[3,2+2])),matrix([1,0],[0,2+2])); +s_test_case(diagonal(1),1); s_test_case(diag_entries(ident(3)),[1,1,1]); s_test_case(diag_entries(matrix([1,0,0],[0,2,0],[0,0,3],[0,0,0])),[1,2,3]); @@ -139,9 +139,9 @@ s_test_case(diagonalisablep(matrix([1,1],[0,1])),false); s_test_case(diagonalisablep(1),false); s_test_case(diagonalisablep(matrix([1,1],[1,1])),true); -s_test_case(sym_p(ident(3)),true); -s_test_case(sym_p(matrix([1,1],[0,1])),false); -s_test_case(sym_p(1),false); +s_test_case(symp(ident(3)),true); +s_test_case(symp(matrix([1,1],[0,1])),false); +s_test_case(symp(1),false); s_test_case(invertiblep(ident(2)),true); s_test_case(invertiblep(matrix([1,1],[0,1])),true); @@ -192,25 +192,25 @@ s_test_case(lin_indp(make_list_of_lists(span([1,4,7],[2,5,8]))),true); s_test_case(lin_indp(make_list_of_lists([transpose([1,4,7]),[2,5,8]])),true); s_test_case(lin_indp(make_list_of_lists({transpose([1,4,7]),matrix([2,5,8])})),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); -s_test_case(row_equiv(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); -s_test_case(row_equiv(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); - -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); -s_test_case(col_equiv(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); -s_test_case(col_equiv(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); - -s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0],[0,1]]),true); -s_test_case(subspace_equiv([[1,2],[2,4]],[[1,0],[0,1]]),false); -s_test_case(subspace_equiv([[1,2],[2,3],[3,4]],[[1,0],[0,1]]),true); -s_test_case(subspace_equiv([[1,2],[2,3]],[[1,0]]),false); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2],[0,0,0])),true); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,0,-1],[0,1,2])),false); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,2,3],[0,-3,-6],[0,-6,-12])),true); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),matrix([1,3,2],[4,6,5],[7,9,8])),false); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6]),matrix([1,0,-1],[0,1,2])),true); +s_test_case(row_equivp(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,1],[0,0])),true); +s_test_case(row_equivp(matrix([1,2,3],[4,5,6]),matrix([1,0,0],[0,1,0])),false); +s_test_case(row_equivp(matrix([1,2],[2,3],[1,1]),matrix([1,0],[0,0],[0,0])),false); + +s_test_case(col_equivp(matrix([1,2,3],[4,5,6],[7,8,9]),ident(3)),false); +s_test_case(col_equivp(matrix([1,2,3],[4,5,6],[7,8,10]),ident(3)),true); +s_test_case(col_equivp(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3]),matrix([1/2,1/2,1/2],[1/2,-1/2,-1/2],[1/2,-1/2,1/2],[1/2,1/2,-1/2])),true); + +s_test_case(subspace_equivp([[1,2],[2,3]],[[1,0],[0,1]]),true); +s_test_case(subspace_equivp([[1,2],[2,4]],[[1,0],[0,1]]),false); +s_test_case(subspace_equivp([[1,2],[2,3],[3,4]],[[1,0],[0,1]]),true); +s_test_case(subspace_equivp([[1,2],[2,3]],[[1,0]]),false); s_test_case(remove_dep(matrix([0,0])),[]); s_test_case(remove_dep([[1,0],[0,1],[1,1]]),[[1,0],[0,1]]); @@ -265,10 +265,10 @@ s_test_case(lgcd([9,12,27]),3); s_test_case(lgcd([-9,-12,-27]),3); s_test_case(lgcd([1/2,1/4,5/6]),1/12); -s_test_case(integerify([9,12,27]),[3,4,9]); -s_test_case(integerify(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); -s_test_case(integerify([1/2,1/4,-5/6]),[6,3,-10]); -s_test_case(integerify([0,0,0]),[0,0,0]); +s_test_case(scale_nicely([9,12,27]),[3,4,9]); +s_test_case(scale_nicely(matrix([-9],[-12],[-27])),matrix([3],[4],[9])); +s_test_case(scale_nicely([1/2,1/4,-5/6]),[6,3,-10]); +s_test_case(scale_nicely([0,0,0]),[0,0,0]); s_test_case(rowspace(ident(2)),span(matrix([1],[0]),matrix([0],[1]))); s_test_case(rowspace(matrix([1,0],[0,1],[1,1])),span(matrix([1],[0]),matrix([0],[1]))); @@ -345,6 +345,18 @@ s_test_case(vector_parametric_parts(matrix([1],[2],[3]) + t*matrix([1],[1],[1]) s_test_case(vector_parametric_display([matrix([1],[2],[3]),[matrix([1],[0],[1]),matrix([1],[1],[1])],[s,t]]),"\\left[\\begin{array}{c} 1 \\\\ 2 \\\\ 3 \\end{array}\\right]+s\\cdot \\left[\\begin{array}{c} 1 \\\\ 0 \\\\ 1 \\end{array}\\right]+t\\cdot \\left[\\begin{array}{c} 1 \\\\ 1 \\\\ 1 \\end{array}\\right]"); s_test_case(vector_parametric_display(vector_parametric_parts(matrix([1+t+s],[2+t],[3+t+s]))),"\\left[\\begin{array}{c} 1 \\\\ 2 \\\\ 3 \\end{array}\\right]+s\\cdot \\left[\\begin{array}{c} 1 \\\\ 0 \\\\ 1 \\end{array}\\right]+t\\cdot \\left[\\begin{array}{c} 1 \\\\ 1 \\\\ 1 \\end{array}\\right]"); +s_test_case(point_in_affine_spacep(matrix([1],[1]),[matrix([0],[1]),[matrix([1],[-1])]]),false); +s_test_case(point_in_affine_spacep(matrix([1],[1]),[matrix([0],[1]),[matrix([1],[-1])],[t]]),false); +s_test_case(point_in_affine_spacep(matrix([1/2],[1/2]),[matrix([0],[1]),[matrix([1],[-1])]]),true); +s_test_case(point_in_affine_spacep(matrix([1/2],[1/2]),[matrix([0],[1]),[matrix([1],[-1])],[t]]),true); +s_test_case(point_in_affine_spacep(matrix([1],[102],[3]),[matrix([0],[100],[0]),[matrix([4],[5],[6]),matrix([7],[8],[9])]]),true); + +s_test_case(vector_in_spacep(matrix([1],[2],[3]),[matrix([4],[5],[6]),matrix([7],[8],[9])]),true); +s_test_case(vector_in_spacep(matrix([1],[2],[3]),[matrix([4],[5],[6]),matrix([7],[8],[10])]),false); +s_test_case(vector_in_spacep(matrix([1],[2]),[matrix([4],[5],[6]),matrix([7],[8],[9])]),false); +s_test_case(vector_in_spacep(matrix([0],[0],[0]),[matrix([4],[5],[6]),matrix([7],[8],[9])]),false); +s_test_case(vector_in_spacep(matrix([0],[0],[0]),[matrix([4],[5],[6]),matrix([7],[8],[9])],true),true); + s_test_case(QR(matrix([1,3,5],[1,1,0],[1,1,2],[1,3,3])),[matrix([1/2,1/2,1/2],[1/2,-(1/2),-(1/2)],[1/2,-(1/2),1/2],[1/2,1/2,-(1/2)]),matrix([2,4,5],[0,2,3],[0,0,2])]); s_test_case(QR(matrix([1,1],[2,2])),[]); From 2fdd9c3bc6fbcc596f3b811598dfa1e80f9e1196 Mon Sep 17 00:00:00 2001 From: Georg Osang Date: Thu, 27 Jun 2024 10:19:48 +0200 Subject: [PATCH 23/26] Modify disp_eqns to support parameters --- stack/maxima/contrib/linearalgebra.mac | 29 ++++++++++++++------- stack/maxima/contrib/linearalgebra_test.mac | 11 ++++++++ 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 5ffceab9705..498feca0e4f 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -1182,6 +1182,16 @@ SVD(M):= block([U,S,VT], /* Automatically formats a system of linear equations */ /*********************************************************************************/ +/** + * Format expressions so that they can be printed as coefficients by wrapping sums + * and expressions with unary minus into brackets. + */ +format_as_coeff(expr):= block([ops, repr], + ops: errcatch(op(expr)), + repr: if emptyp(ops) or not elementp(first(ops), {"+", "-"}) then expr else simplode(["(", expr, ")"]), + return(repr) +); + /** * Given a list of equations and a list of variables, produce TeX output that displays them as a system of equations. * Everything will be appropriately vertically aligned with leading ones and zeros removed appropriately. @@ -1190,10 +1200,12 @@ SVD(M):= block([U,S,VT], * @param[list] vars A list of variables in the order that they should appear. * @return[string] TeX output for this system of equations */ -disp_eqns(eqns,vars):= block([s_in,s_first,one_zero_remover,delete_if_zero,m,n,p,pivot,ii,jj,v,a], - s_in(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "+", /* returns the sign of a coefficient as a string, assuming 0 is positive */ - s_first(ex):= if ev(is(signum(ex)=-1),simp) then "-" else "", /* Altered version of above that doesn't return + for leading coefficient */ - one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0),simp) then "" else if is(ex=-1) then "-" else ev(ex,simp), /* scrubs out unwanted ones and zeros */ +disp_eqns(eqns,vars):= block([is_neg,s_in,s_first,format_as_positive_coeff,one_zero_remover,delete_if_zero,m,n,p,pivot,ii,jj,v,a], + is_neg(ex) := ev(is(signum(ex)=-1),simp), /* return true if ex is numerical and negative, false otherwise */ + s_in(ex):= if is_neg(ex) then "-" else "+", /* returns the sign of a coefficient as a string, assuming 0 is positive */ + s_first(ex):= if is_neg(ex) then "-" else "", /* Altered version of above that doesn't return + for leading coefficient */ + format_as_positive_coeff(ex) := if is_neg(ex) then ev(abs(ex),simp) else format_as_coeff(ev(ex,simp)), + one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0) or is(ex=-1),simp) then "" else format_as_positive_coeff(ev(ex,simp)), /* scrubs out unwanted ones and zeros */ delete_if_zero(ex,var):= if is(ex=0) then "" else var, /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ n: length(eqns), /* n = number of equations */ m: length(vars), /* m = number of variables */ @@ -1205,16 +1217,15 @@ disp_eqns(eqns,vars):= block([s_in,s_first,one_zero_remover,delete_if_zero,m,n,p v: vars[1], /* v is the variable we are looking at in this column */ a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ - /* p: append(p,[simplode([if pivot then s_first(a) else "",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), If this is a pivot, display normally, otherwise do nothing */ - if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]), + if pivot then p: append(p, [simplode([s_first(a),one_zero_remover(a),tex1(delete_if_zero(a,v))])]), /* If this is a pivot, display normally, otherwise do nothing */ for jj: 2 thru m do block( jj: ev(jj,simp), v: vars[jj], a: ev(coeff(lhs(eqns[ii]),v),simp), - if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(abs(a)),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(a),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), if is(a#0) and not(pivot) then pivot: true - ),/*TODO: what about 0=0? Currently displays as "=0"*/ - if is(fullratsimp(lhs(eqns[ii]))=0) then p: append(p, ["0"]), + ), + if is(fullratsimp(lhs(eqns[ii]))=0) then p: append(p, ["0"]), /* Display "0=0" properly */ p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]), if is(ii#n) then p: append(p,["\\\\"]) ), diff --git a/stack/maxima/contrib/linearalgebra_test.mac b/stack/maxima/contrib/linearalgebra_test.mac index 4ca04d19aae..2eaa72d6ed7 100644 --- a/stack/maxima/contrib/linearalgebra_test.mac +++ b/stack/maxima/contrib/linearalgebra_test.mac @@ -391,5 +391,16 @@ s_test_case(SVD(matrix([1,1],[1,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-( s_test_case(SVD(matrix([1,1],[1,0],[0,1])),[matrix([sqrt(2)/sqrt(3),0,1/sqrt(3)],[1/sqrt(6),1/sqrt(2),-(1/sqrt(3))],[1/sqrt(6),-(1/sqrt(2)),-(1/sqrt(3))]),matrix([sqrt(3),0],[0,1],[0,0]),matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))])]); s_test_case(SVD(matrix([1,1,0],[1,0,1])),[matrix([1/sqrt(2),1/sqrt(2)],[1/sqrt(2),-(1/sqrt(2))]),matrix([sqrt(3),0,0],[0,1,0]),matrix([sqrt(2)/sqrt(3),1/sqrt(6),1/sqrt(6)],[0,1/sqrt(2),-1/sqrt(2)],[1/sqrt(3),-(1/sqrt(3)),-(1/sqrt(3))])]); +s_test_case(format_as_coeff(2), 2); +s_test_case(format_as_coeff(-2), "(-2)"); +s_test_case(format_as_coeff(g-h), "(g-h)"); +s_test_case(format_as_coeff(g(x)), g(x)); +s_test_case(format_as_coeff(-g(x)), "(-g(x))"); +s_test_case(format_as_coeff(2*h), 2*h); +s_test_case(format_as_coeff(-2*h), "(-2*h)"); +s_test_case(format_as_coeff(""), ""); +s_test_case(format_as_coeff("2"), "2"); +s_test_case(format_as_coeff(ev(2*k-2,simp)), "(2*k-2)"); s_test_case(disp_eqns([2*x+y-z+(-3)*w = 7,-x-2*y+(-7)*w = -1,3*z = 0,x+w = 0,0 = 0],[x,y,z,w]),"\\begin{array} {rcrcrcrcr}2x& + & y& - & z& - & 3w& = &7\\\\-x& - & 2y& & & - & 7w& = &-1\\\\& & & & 3z& & & = &0\\\\x& & & & & + & w& = &0\\\\& & & & & & 0& = &0\\end{array}"); s_test_case(mat_disp_eqns(matrix([2,1,-1,-3],[-1,-2,0,-7],[0,0,3,0],[1,0,0,1],[0,0,0,0]),matrix([7],[-1],[0],[0],[0]),[x,y,z,w]),"\\begin{array} {rcrcrcrcr}2x& + & y& - & z& - & 3w& = &7\\\\-x& - & 2y& & & - & 7w& = &-1\\\\& & & & 3z& & & = &0\\\\x& & & & & + & w& = &0\\\\& & & & & & 0& = &0\\end{array}"); +s_test_case(mat_disp_eqns(matrix([-2, k-1, -1],[0, 2*k+2, 0], [-1, k, -2]),matrix([k-1],[1],[-1]),[x,y,z]), "\begin{array} {rcrcrcr}-2x& + & (k-1)y& - & z& = &k-1\\& & (2*k+2)y& & & = &1\\-x& + & ky& - & 2z& = &-1\end{array}") From 47e92ea6a763d553966888cd418666ab6e4d8690 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Tue, 16 Jul 2024 13:55:07 +1200 Subject: [PATCH 24/26] Fix make_list_of_lists and vector parametric equations I didn't realise that vectors of constants were also considered constants, so one of the if-statements in make_list_of_lists wasn't behaving as intended. There may be a bug in point_in_affine_spacep; its 3rd test didn't work for me when running the whole bank of tests. I think that the problem is that I didn't declare local variables, so I have added that and I hope it fixes it. --- stack/maxima/contrib/linearalgebra.mac | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index 498feca0e4f..ae397ec644a 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -504,7 +504,7 @@ make_list_of_lists(ex):= block([op1], if vectorp(ex) then return([list_matrix_entries(ex)]), if is(op1="matrix") then return(args(transpose(ex))), ex: args(ex), - if ev(every(lambda([ex2],constantp(ex2) or atom(ex2)),ex),simp) then return([ex]), + if ev(not(some(lambda([ex2],nonscalarp(ex2)),ex)),simp) then return([ex]), ex: map(lambda([ex2],if vectorp(ex2) then list_matrix_entries(ex2) else args(ex2)),ex), return(ex) ); @@ -1003,8 +1003,7 @@ vector_parametric_parts(ex):= block([vars,cm,dir_vecs,cons_vecs], * @param[list] parts A list with three elements (see vector_parametric_parts) [mx1 matrix of constants, a list of mx1 matrices of constants, a list of variable names] * @return[string] TeX output of a vector parametric equation in a "standard" form. */ -vector_parametric_display(parts):= block([simp], - simp:false, +vector_parametric_display(parts):= block([simp:false,cons_vec,dir_vecs,vars], [cons_vec,dir_vecs,vars]: parts, return(sconcat(tex1(cons_vec),"+",tex1(apply("+", zip_with("*", vars, dir_vecs))))) ); @@ -1017,7 +1016,7 @@ vector_parametric_display(parts):= block([simp], * @param[list] parts The output of vector_parametric_parts. This is a three-element list of the form [constant_vector, [list of direction vectors], [list of parameters]]. All vectors should be mx1 matrices. The third element can be omitted if building the list manually. * @return[boolean] Is p in the affine subspace? */ -point_in_affine_spacep(p,parts):= block([simp:true], +point_in_affine_spacep(p,parts):= block([simp:true,cons_vec,dir_vecs,vars,eqns,soln], cons_vec: first(parts), dir_vecs: second(parts), if is(length(parts)>2) then vars: third(parts) else vars: rest(stack_var_makelist(tmp,length(dir_vecs))), From a8e417efaedf1a28ac6181f6f93f822de00e2a0b Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Tue, 16 Jul 2024 14:03:12 +1200 Subject: [PATCH 25/26] Add tests for make_list_of_lists edit and fix two broken tests %i is NOT the corresponding eigenvalue for matrix([0,-1],[1,0]) and c(1,%i), so the ta should be false. get_eigenvector returns an empty list rather than false when given an incorrect eigenvalue, so the ta should be [] instead of false. --- stack/maxima/contrib/linearalgebra_test.mac | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra_test.mac b/stack/maxima/contrib/linearalgebra_test.mac index 2eaa72d6ed7..598ad2a5d7b 100644 --- a/stack/maxima/contrib/linearalgebra_test.mac +++ b/stack/maxima/contrib/linearalgebra_test.mac @@ -173,6 +173,8 @@ s_test_case(make_list_of_lists(matrix([1,2],[3,4],[5,6])),[[1,3,5],[2,4,6]]); s_test_case(make_list_of_lists({c(1,2,3),[2,3,4],ntuple(3,4,5),{4,5,6}}),[[1,2,3],[2,3,4],[3,4,5],[4,5,6]]); s_test_case(make_list_of_lists([1,2,3,4]),[[1,2,3,4]]); s_test_case(make_list_of_lists([1,a,b,4]),[[1,a,b,4]]); +s_test_case(make_list_of_lists([[1,2,3],[2,3,4],[3,4,5]]),[[1,2,3],[2,3,4],[3,4,5]]); +s_test_case(make_list_of_lists([matrix([1],[2]),matrix([3],[4])]),[[1,2],[3,4]]); s_test_case(column_stack([[1,2,3],[4,5,6]]),matrix([1,4],[2,5],[3,6])); s_test_case(column_stack([[1,2,3]]),matrix([1],[2],[3])); @@ -318,14 +320,14 @@ s_test_case(eigenvaluep(1,matrix([1,0],[0,2]),c(2,0)),true); s_test_case(eigenvaluep(1,matrix([1,0],[0,2]),c(0,1)),false); s_test_case(eigenvaluep(%i,matrix([0,-1],[1,0])),true); s_test_case(eigenvaluep(%i,matrix([0,-1],[1,0]),matrix([%i],[1])),true); -s_test_case(eigenvaluep(%i,matrix([0,-1],[1,0]),matrix([1],[%i])),true); +s_test_case(eigenvaluep(%i,matrix([0,-1],[1,0]),matrix([1],[%i])),false); s_test_case(get_eigenvalue(matrix([0],[0]),ident(2)),false); s_test_case(get_eigenvalue(matrix([0],[1]),matrix([1,1],[0,1])),false); s_test_case(get_eigenvalue(matrix([1],[0]),matrix([2,1],[0,1])),2); s_test_case(get_eigenvalue(matrix([%i],[1]),matrix([0,-1],[1,0])),%i); -s_test_case(get_eigenvector(2,ident(2)),false); +s_test_case(get_eigenvector(2,ident(2)),[]); s_test_case(get_eigenvector(2,matrix([2,1],[0,1])),[matrix([1],[0])]); s_test_case(get_eigenvector(1,ident(2)),[matrix([1],[0]),matrix([0],[1])]); s_test_case(get_eigenvector(2*%i,matrix([0,-2],[2,0])),[matrix([1],[-%i])]); From dad2cc1eb536976c07c421a812eb1a9c356d0c43 Mon Sep 17 00:00:00 2001 From: Luke Longworth <34358809+LukeLongworth@users.noreply.github.com> Date: Thu, 15 Aug 2024 14:35:13 +1200 Subject: [PATCH 26/26] Fixing disp_eqns bugs - Fixed a bug in disp_eqns where negative pivots were missing their minus sign when the pivot was not in the first column. - Added tex1 into the format_as_coeff function as suggested by Georg Osang TODO: Unit tests need updating. --- stack/maxima/contrib/linearalgebra.mac | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/stack/maxima/contrib/linearalgebra.mac b/stack/maxima/contrib/linearalgebra.mac index ae397ec644a..5485af05a3d 100644 --- a/stack/maxima/contrib/linearalgebra.mac +++ b/stack/maxima/contrib/linearalgebra.mac @@ -1187,7 +1187,7 @@ SVD(M):= block([U,S,VT], */ format_as_coeff(expr):= block([ops, repr], ops: errcatch(op(expr)), - repr: if emptyp(ops) or not elementp(first(ops), {"+", "-"}) then expr else simplode(["(", expr, ")"]), + repr: if emptyp(ops) or not elementp(first(ops), {"+", "-"}) then expr else simplode(["\\left(", tex1(expr), "\\right)"]), return(repr) ); @@ -1199,10 +1199,10 @@ format_as_coeff(expr):= block([ops, repr], * @param[list] vars A list of variables in the order that they should appear. * @return[string] TeX output for this system of equations */ -disp_eqns(eqns,vars):= block([is_neg,s_in,s_first,format_as_positive_coeff,one_zero_remover,delete_if_zero,m,n,p,pivot,ii,jj,v,a], +disp_eqns(eqns,vars):= block([is_neg,s_in,s_first,format_as_positive_coeff,one_zero_remover,delete_if_zero,m,n,p,pivot,new_pivot,ii,jj,v,a], is_neg(ex) := ev(is(signum(ex)=-1),simp), /* return true if ex is numerical and negative, false otherwise */ - s_in(ex):= if is_neg(ex) then "-" else "+", /* returns the sign of a coefficient as a string, assuming 0 is positive */ - s_first(ex):= if is_neg(ex) then "-" else "", /* Altered version of above that doesn't return + for leading coefficient */ + s_in(ex):= if ev(is_neg(ex),simp) then "-" else "+", /* returns the sign of a coefficient as a string, assuming 0 is positive */ + s_first(ex):= if ev(is_neg(ex),simp) then "-" else "", /* Altered version of above that doesn't return + for leading coefficient */ format_as_positive_coeff(ex) := if is_neg(ex) then ev(abs(ex),simp) else format_as_coeff(ev(ex,simp)), one_zero_remover(ex):= if ev(is(ex=1) or is(ex=0) or is(ex=-1),simp) then "" else format_as_positive_coeff(ev(ex,simp)), /* scrubs out unwanted ones and zeros */ delete_if_zero(ex,var):= if is(ex=0) then "" else var, /* returns nothing if the coefficient is zero, otherwise returns the coefficient */ @@ -1213,6 +1213,7 @@ disp_eqns(eqns,vars):= block([is_neg,s_in,s_first,format_as_positive_coeff,one_z for ii: 1 thru n do block( ii: ev(ii,simp), pivot: false, /* each row will have a pivot, assume false until we find it */ + new_pivot: false, v: vars[1], /* v is the variable we are looking at in this column */ a: ev(coeff(lhs(eqns[ii]),v),simp), /* find coefficient of v */ if is(a#0) and not(pivot) then pivot: true, /* If the coefficient is non-zero, we have found our pivot! */ @@ -1221,8 +1222,9 @@ disp_eqns(eqns,vars):= block([is_neg,s_in,s_first,format_as_positive_coeff,one_z jj: ev(jj,simp), v: vars[jj], a: ev(coeff(lhs(eqns[ii]),v),simp), - if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",one_zero_remover(a),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), - if is(a#0) and not(pivot) then pivot: true + if is(a#0) and not(pivot) then new_pivot: true, + if is(a#0) then p: append(p,[simplode(["& ", if pivot then s_in(a) else ""," & ",if new_pivot then s_first(a) else "",one_zero_remover(a),tex1(delete_if_zero(a,v))])]) else p: append(p,["& & "]), + if new_pivot then [pivot, new_pivot]: [true, false] ), if is(fullratsimp(lhs(eqns[ii]))=0) then p: append(p, ["0"]), /* Display "0=0" properly */ p: append(p,[simplode(["& = &",tex1(rhs(eqns[ii]))])]),