semidef:= proc(A0::{matrix,Matrix},d::{identical(positive_semidef), identical(negative_semidef),identical(positive_def),identical(negative_def)}) local A,B,P,i,j,n,t,s,r,R,Q,Qu,Qi,S; options `Maple Advisor Database 1.01 for Maple 6`, `Copyright (c) 2000 by Robert B. Israel. All rights reserved`; # get the names, and assume they are real # indexed names must be converted to non-indexed Q:= indets(convert(A0,listlist),name); Q:= remove(t -> assigned(`property/object`[t]),Q); S:= map(proc(e) # return e=f where f is assumed real local f; assume(f,real); e=f end, Q); A:= map2(subs,S,A0); # prepare reverse subst S:= map(e -> (eval(rhs(e)) = lhs(e)), S); # check hermitian if type(A,matrix) then n:= linalg[rowdim](A); if n <> linalg[coldim](A) then error "Not a square matrix" fi; B:= evalm(linalg[htranspose](A)-A); else n:= LinearAlgebra:-RowDimension(A); if n <> LinearAlgebra:-ColumnDimension(A) then error "Not a square Matrix" fi; B:= LinearAlgebra:-HermitianTranspose(A)-A fi; B:= map(simplify,B); for i from 1 to n do for j from 1 to i do if B[i,j] <> 0 then return FAIL fi od od; # get characteristic polynomial P(t) or P(-t) if member(d, {'negative_semidef','negative_def'}) then if type(A,matrix) then P:= linalg[charpoly](A,t) else P:= LinearAlgebra:-CharacteristicPolynomial(A,t) fi elif type(A,matrix) then P:= (-1)^n*linalg[charpoly](A,-t) else P:= subs(s=-t,(-1)^n* LinearAlgebra:-CharacteristicPolynomial(A,s)) fi; R:= NULL; # positive/negative definite must have positive constant term if member(d, {'positive_def','negative_def'}) then s:= subs(t=0,P); P:= P - s; r:= is(s > 0); if r = false then if is(s <= 0) then RETURN(false) else R:= R, (s > 0); additionally(s > 0); fi elif r= FAIL then R:= R, (s > 0); additionally(s>0); fi; fi; # check all terms nonnegative for s in [coeffs(collect(P,t),t)] do s:= eval(s); r:= is(s >= 0); if r = false then if is(s < 0) then RETURN(false) else R:= R, (s >= 0) fi; additionally(s >= 0); elif r = FAIL then R:= R, (s >= 0); additionally(s >= 0); fi; od; # convert to list and substitute back indets if R=NULL then RETURN(true) fi; subs(S,{R}); end;