spm_ddiff.m 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. function [varargout] = spm_ddiff(varargin)
  2. % matrix high-order numerical differentiation (double stencil)
  3. % FORMAT [dfdx] = spm_diff(f,x,...,n)
  4. % FORMAT [dfdx] = spm_diff(f,x,...,n,V)
  5. % FORMAT [dfdx] = spm_diff(f,x,...,n,'q')
  6. %
  7. % f - [inline] function f(x{1},...)
  8. % x - input argument[s]
  9. % n - arguments to differentiate w.r.t.
  10. %
  11. % V - cell array of matrices that allow for differentiation w.r.t.
  12. % to a linear transformation of the parameters: i.e., returns
  13. %
  14. % df/dy{i}; x = V{i}y{i}; V = dx(i)/dy(i)
  15. %
  16. % q - (char) flag to preclude default concatenation of dfdx
  17. %
  18. % dfdx - df/dx{i} ; n = i
  19. % dfdx{p}...{q} - df/dx{i}dx{j}(q)...dx{k}(p) ; n = [i j ... k]
  20. %
  21. %
  22. % This routine has the same functionality as spm_diff, however it
  23. % uses two sample points to provide more accurate numerical (finite)
  24. % differences that accommodate nonlinearities:
  25. %
  26. % dfdx = (4*f(x + dx) - f(x + 2*dx) - 3*f(x))/(2*dx)
  27. %__________________________________________________________________________
  28. % Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging
  29. % Karl Friston
  30. % $Id: spm_ddiff.m 7143 2017-07-29 18:50:38Z karl $
  31. % step size for numerical derivatives
  32. %--------------------------------------------------------------------------
  33. global GLOBAL_DX
  34. if ~isempty(GLOBAL_DX)
  35. dx = GLOBAL_DX;
  36. else
  37. dx = exp(-8);
  38. end
  39. % create inline object
  40. %--------------------------------------------------------------------------
  41. f = spm_funcheck(varargin{1});
  42. % parse input arguments
  43. %--------------------------------------------------------------------------
  44. if iscell(varargin{end})
  45. x = varargin(2:(end - 2));
  46. n = varargin{end - 1};
  47. V = varargin{end};
  48. q = 1;
  49. elseif isnumeric(varargin{end})
  50. x = varargin(2:(end - 1));
  51. n = varargin{end};
  52. V = cell(1,length(x));
  53. q = 1;
  54. elseif ischar(varargin{end})
  55. x = varargin(2:(end - 2));
  56. n = varargin{end - 1};
  57. V = cell(1,length(x));
  58. q = 0;
  59. else
  60. error('improper call')
  61. end
  62. % check transform matrices V = dxdy
  63. %--------------------------------------------------------------------------
  64. for i = 1:length(x)
  65. try
  66. V{i};
  67. catch
  68. V{i} = [];
  69. end
  70. if isempty(V{i}) && any(n == i);
  71. V{i} = speye(spm_length(x{i}));
  72. end
  73. end
  74. % initialise
  75. %--------------------------------------------------------------------------
  76. m = n(end);
  77. xm = spm_vec(x{m});
  78. J = cell(1,size(V{m},2));
  79. % proceed to derivatives
  80. %==========================================================================
  81. if length(n) == 1
  82. % dfdx
  83. %----------------------------------------------------------------------
  84. f0 = f(x{:});
  85. for i = 1:length(J)
  86. xi = x;
  87. xii = x;
  88. xi{m} = spm_unvec(xm + V{m}(:,i)*dx, x{m});
  89. xii{m} = spm_unvec(xm + V{m}(:,i)*2*dx,x{m});
  90. J{i} = spm_dfdx(f(xi{:}),f(xii{:}),f0,dx);
  91. end
  92. % return numeric array for first-order derivatives
  93. %======================================================================
  94. % vectorise f
  95. %----------------------------------------------------------------------
  96. f = spm_vec(f0);
  97. % if there are no arguments to differentiate w.r.t. ...
  98. %----------------------------------------------------------------------
  99. if isempty(xm)
  100. J = sparse(length(f),0);
  101. % or there are no arguments to differentiate
  102. %----------------------------------------------------------------------
  103. elseif isempty(f)
  104. J = sparse(0,length(xm));
  105. end
  106. % differentiation of a scalar or vector
  107. %----------------------------------------------------------------------
  108. if isnumeric(f0) && iscell(J) && q
  109. J = spm_dfdx_cat(J);
  110. end
  111. % assign output argument and return
  112. %----------------------------------------------------------------------
  113. varargout{1} = J;
  114. varargout{2} = f0;
  115. else
  116. % dfdxdxdx....
  117. %----------------------------------------------------------------------
  118. f0 = cell(1,length(n));
  119. [f0{:}] = spm_diff(f,x{:},n(1:end - 1),V);
  120. p = true;
  121. for i = 1:length(J)
  122. xi = x;
  123. xii = x;
  124. xmi = xm + V{m}(:,i)*dx;
  125. xmii = xm + V{m}(:,i)*2*dx;
  126. xi{m} = spm_unvec(xmi, x{m});
  127. xii{m} = spm_unvec(xmii,x{m});
  128. fi = spm_diff(f,xi{:}, n(1:end - 1),V);
  129. fii = spm_diff(f,xii{:},n(1:end - 1),V);
  130. J{i} = spm_dfdx(fi,fii,f0{1},dx);
  131. p = p & isnumeric(J{i});
  132. end
  133. % or differentiation of a scalar or vector
  134. %----------------------------------------------------------------------
  135. if p && q
  136. J = spm_dfdx_cat(J);
  137. end
  138. varargout = [{J} f0];
  139. end
  140. function dfdx = spm_dfdx(f,ff,f0,dx)
  141. % cell subtraction
  142. %__________________________________________________________________________
  143. if iscell(f)
  144. dfdx = f;
  145. for i = 1:length(f(:))
  146. dfdx{i} = spm_dfdx(f{i},ff{i},f0{i},dx);
  147. end
  148. elseif isstruct(f)
  149. dfdx = (4*spm_vec(f) - spm_vec(ff) - 3*spm_vec(f0))/(2*dx);
  150. else
  151. dfdx = (4*f - ff - 3*f0)/(2*dx);
  152. end
  153. return
  154. function J = spm_dfdx_cat(J)
  155. % concatenate into a matrix
  156. %--------------------------------------------------------------------------
  157. if isvector(J{1})
  158. if size(J{1},2) == 1
  159. J = spm_cat(J);
  160. else
  161. J = spm_cat(J')';
  162. end
  163. end