Mercurial > matrix-functions
view funm_files/myfunm.m @ 0:8f23314345f4 draft
Create local repository for matrix toolboxes. Step #0 done.
author | Antonio Pino Robles <data.script93@gmail.com> |
---|---|
date | Wed, 06 May 2015 14:56:53 +0200 |
parents | |
children |
line wrap: on
line source
function [F,n_swaps,n_calls,terms,ind,T] = myfunm(A,fun,delta,tol,prnt,m) %MYFUNM Evaluate general matrix function. % F = FUNM(A,FUN), for a square matrix argument A, evaluates the % function FUN at the square matrix A. % FUN(X,K) must return the K'th derivative of % the function represented by FUN evaluated at the vector X. % The MATLAB functions COS, SIN, EXP, LOG can be passed as FUN, % i.e. FUNM(A,@COS), FUNM(A,@SIN), FUNM(@EXP), FUNM(A,@LOG). % For matrix square roots use SQRTM(A) instead. % For matrix exponentials, either of EXPM(A) and FUNM(A,@EXPM) % may be the faster or the more accurate, depending on A. % % F = FUNM(A,FUN,DELTA,TOL,PRNT,M) specifies a tolerance % DELTA used in determining the blocking (default 0.1), % and a tolerance TOL used in a convergence test for evaluating the % Taylor series (default EPS). % If PRNT is nonzero then information describing the % behaviour of the algorithm is printed. % M, if supplied, defines a blocking. % % [F,N_SWAPS,N_CALLS,TERMS,IND,T] = FUNM(A,FUN,...) also returns % N_SWAPS: the total number of swaps in the Schur re-ordering. % N_CALLS: the total number of calls to ZTREXC for the re-ordering. % TERMS(I): the number of Taylor series terms used when evaluating % the I'th atomic triangular block. % IND: a cell array specifying the blocking: the (I,J) block of % the re-ordered Schur factor T is T(IND{I},IND{j}), % T: the re-ordered Schur form. if isequal(fun,@cos) || isequal(fun,'cos'), fun = @fun_cos; end if isequal(fun,@sin) || isequal(fun,'sin'), fun = @fun_sin; end if isequal(fun,@exp) || isequal(fun,'exp'), fun = @fun_exp; end if nargin < 3 || isempty(delta), delta = 0.1; end if nargin < 4 || isempty(tol), tol = eps; end if nargin < 5 || isempty(prnt), prnt = 0; end if nargin < 6, m = []; end n = length(A); % First form complex Schur form (if A not already upper triangular). if isequal(A,triu(A)) T = A; U = eye(n); else [U,T] = schur(A,'complex'); end if isequal(T,tril(T)) % Handle special case of diagonal T. F = U*diag(feval(fun,diag(T)))*U'; n_swaps = 0; n_calls = 0; terms = 0; ind = {1:n}; return end % Determine reordering of Schur form into block form. if isempty(m), m = blocking(T,delta,abs(prnt)>=3); end if prnt, fprintf('delta (blocking) = %9.2e, tol (TS) = %9.2e\n', delta, tol), end [M,ind,n_swaps] = swapping(m); n_calls = size(M,1); if n_calls > 0 % If there are swaps to do... [U,T] = swap(U,T,M); % MEX file end m = length(ind); % Calculate F(T) F = zeros(n); for col=1:m j = ind{col}; [F(j,j), n_terms] = funm_atom(T(j,j),fun,tol,abs(prnt)*(prnt ~= 1)); terms(col) = n_terms; for row=col-1:-1:1 i = ind{row}; if length(i) == 1 && length(j) == 1 % Scalar case. k = i+1:j-1; temp = T(i,j)*(F(i,i) - F(j,j)) + F(i,k)*T(k,j) - T(i,k)*F(k,j); F(i,j) = temp/(T(i,i)-T(j,j)); else k = cat(2,ind{row+1:col-1}); rhs = F(i,i)*T(i,j) - T(i,j)*F(j,j) + F(i,k)*T(k,j) - T(i,k)*F(k,j); F(i,j) = sylv_tri(T(i,i),-T(j,j),rhs); end end end F = U*F*U'; % As in FUNM: if isreal(A) && norm(imag(F),1) <= 10*n*eps*norm(F,1) F = real(F); end