R中handle函数的等价性

我将一些代码从Matlab迁移到R，在处理函数的特殊情况下，我面临一些困难。这是我的Matlab代码：

function Application_ChFun
clear;close all;clc;warning('off');
StepsYr = 10;

%% --parameters-- %%
S0 = 1;   
r  = 0.0; 
t0 = 0;   
T2 = 5;

gamma = 0.5; 
kappa = 0.3; 
rho   = -0.6; 
vBar  = 0.05; 
v0    = 0.04; 

NoOfPaths = 5e4; 
NoOfSteps = StepsYr*T2;
%% --Define model-- %%
cf = @(u,T)ChFun(u, T, kappa,vBar,gamma,rho, v0, r);
Vc = @(t,x)MktFun(cf,t,x,log(S0));

% Define bump size
bump_T  = 1e-4;
bump_K  = @(T)1e-4;

% Define derivatives
dC_dT   = @(T,K) (Vc(T + bump_T,K) - Vc(T ,K)) /  bump_T;
dC_dK   = @(T,K) (Vc(T,K + bump_K(T)) - Vc(T,K - bump_K(T))) / (2 * bump_K(T));
d2C_dK2 = @(T,K) (Vc(T,K + bump_K(T)) + Vc(T,K-bump_K(T)) - 2*Vc(T,K)) / bump_K(T)^2;

t   = t0;
S = S0+zeros(NoOfPaths,1);

for i = 1:NoOfSteps

    if i==1
        t_adj = 1/NoOfSteps;
        t     = t_adj; 
    end       

    % AAA perfectly matches with the R equivalent, but AAB and AAC do not.
    AAA = dC_dT(t,S);
    AAB = dC_dK(t,S);
    AAC = d2C_dK2(t,S);
end 

function value = MktFun(cf,T,x,x0)
value = CM_Proxy(cf,T,x,x0);

function value = CM_Proxy(ChF,T,K,x0)
K(K<1e-5)=1e-5;

alpha   = 0.75; 
c       = 3e2;
N_CM    = 2^12;

eta    = c/N_CM;
b      = pi/eta;
u      = [0:N_CM-1]*eta;
lambda = 2*pi/(N_CM*eta);
i      = complex(0,1);

u_new = u-(alpha+1)*i; 
cf    = exp(i*u_new*x0).*ChF(u_new,T);
psi   = cf./(alpha^2+alpha-u.^2+i*(2*alpha+1)*u);

SimpsonW         = 3+(-1).^[1:N_CM]-[1,zeros(1,N_CM-1)];
SimpsonW(N_CM)   = 0;
SimpsonW(N_CM-1) = 1;
FFTFun           = exp(i*b*u).*psi.*SimpsonW;
payoff           = real(eta*fft(FFTFun)/3);
strike           = exp(-b:lambda:b-lambda);
payoff_specific  = spline(strike,payoff,K);
value = exp(-log(K)*alpha).*payoff_specific/pi;

function cf=ChFun(u, tau, kappa,vBar,gamma,rho, v0, r)
i     = complex(0,1);

D_1  = sqrt(((kappa -i*rho*gamma.*u).^2+(u.^2+i*u)*gamma^2));
g    = (kappa- i*rho*gamma*u-D_1)./(kappa-i*rho*gamma*u+D_1);    

C = (1/gamma^2)*(1-exp(-D_1*tau))./(1-g.*exp(-D_1*tau)).*(kappa-gamma*rho*i*u-D_1);
A = i*u*r*tau + kappa*vBar*tau/gamma^2 * (kappa-gamma*rho*i*u-D_1)-2*kappa*vBar/gamma^2*log((1-g.*exp(-D_1*tau))./(1-g));

cf = exp(A + C * v0);

---

问题是在这种情况下，

g=dC_dK（t，S）

直接调用

Vc

，而不是先调用

bump_k（t）

。有人能提出一个解决方案吗？

函数的求值顺序不一定是由内而外的（正如您所期望的那样），而是需要的顺序。R试图懒散地做一些事情，因此，如果您包含一个从未实际引用过的昂贵操作，那么它就无法实现

举个例子：

---

f1函数的求值顺序不一定是由内而外的（正如您所期望的那样），而是需要的顺序。R试图懒散地做一些事情，因此，如果您包含一个从未实际引用过的昂贵操作，那么它就无法实现

举个例子：

f1它是否导致了问题？根据我的经验，这很正常。这会引起问题吗？根据我的经验，这很正常。谢谢你的解释！有没有更好的方法在R中转换Matlab的函数句柄？看起来Matlab中的顺序是相反的。我不太熟悉，但我读到的方式，它根本没有改变R的函数范式。你的R代码被破坏有什么原因吗？我看不出它有任何明显的语义或逻辑问题。。。虽然我不能复制，因为我没有原始的
MktFun
，也没有它的
cf
，但我添加了完整的代码。基本上，我为变量
AAA
获得了相同的值，但为
AAB
和
ABC
获得了不同的值，即使函数的输出值相同。感谢您的解释！有没有更好的方法在R中转换Matlab的函数句柄？看起来Matlab中的顺序是相反的。我不太熟悉，但我读到的方式，它根本没有改变R的函数范式。你的R代码被破坏有什么原因吗？我看不出它有任何明显的语义或逻辑问题。。。虽然我不能复制，因为我没有原始的
MktFun
，也没有它的
cf
，但我添加了完整的代码。基本上，我为变量
AAA
获得了相同的值，但为
AAB
和
ABC
获得了不同的值，即使函数的输出值相同。
Application_ChFun <- function(){

  StepsYr = 10

  ## --parameters-- ##
  S0 = 1  
  r  = 0.0 
  t0 = 0   
  T2 = 5

  gamma = 0.5 
  kappa = 0.3 
  rho   = -0.6   
  vBar  = 0.05  
  v0    = 0.04  

  NoOfPaths = 5e4 
  NoOfSteps = StepsYr*T2

  ## --Define model-- ##
  cf <- function(u,T) ChFun(u,T,kappa,vBar,gamma,rho, v0, r)
  Vc <- function(t,x) MktFun(cf,t,x,log(S0))

  # Define bump size
  bump_T = 1e-4
  bump_K <- function(T) 1e-4

  # Define derivatives
  dC_dT   <- function(T,K) (Vc(T + bump_T,K) - Vc(T ,K)) /  bump_T
  dC_dK   <- function(T,K) (Vc(T,K + bump_K(T)) - Vc(T,K - bump_K(T))) / (2 * bump_K(T))
  d2C_dK2 <- function(T,K) (Vc(T,K + bump_K(T)) + Vc(T,K - bump_K(T)) - 2*Vc(T,K)) / bump_K(T)^2

  t = t0
  S = S0+rep(0,NoOfPaths)

  for (i in 1:NoOfSteps){

    t_real = t

    if (i==1){
      t_adj = 1/NoOfSteps;
      t     = t_adj 
    }

    # AAA perfectly matches with the R's equivalent. But AAB and AAC do not.
    AAA = dC_dT(t,S) 
    AAB = dC_dK(t,S)
    AAC = d2C_dK2(t,S)

  }
}


MktFun <- function(cf,T,x,x0){
  return(CM_Proxy(cf,T,x,x0))
}

CM_Proxy <- function(ChF,T,K,x0){

  K[K<1e-5] = 1e-5

  alpha = 0.75 
  c = 3e2
  N_CM = 2^12

  eta = c/N_CM
  b = pi/eta
  u = (0:(N_CM-1))*eta
  lambda = 2*pi/(N_CM*eta)
  i = complex(real = 0, imaginary = 1)

  u_new = u - (alpha+1)*i # European call option.
  cf = exp(i*u_new*x0)*ChF(u_new,T)
  psi = cf/(alpha^2+alpha-u^2+i*(2*alpha+1)*u)

  SimpsonW  = 3+(-1)^(1:N_CM)-c(1,rep(0,N_CM-1))
  SimpsonW[N_CM] = 0
  SimpsonW[N_CM-1] = 1
  FFTFun = exp(i*b*u)*psi*SimpsonW
  payoff = Re(eta*fft(FFTFun)/3)
  strike = exp(seq(-b,b-lambda,lambda))
  K = as.vector(K)
  payoff_specific = stinepack::stinterp(strike,payoff,K)
  value = exp(-log(K)*alpha)*payoff_specific$y/pi

  return(value)
}

ChFun <- function(u, tau, kappa,vBar,gamma,rho, v0, r){

  i = complex(real = 0, imaginary = 1)

  D_1 = sqrt(((kappa - i*rho*gamma*u)^2 + (u^2+i*u)*gamma^2))
  g = (kappa - i*rho*gamma*u - D_1) / (kappa - i*rho*gamma*u + D_1)   

  C = (1/gamma^2)*(1-exp(-D_1*tau))/(1-g*exp(-D_1*tau))*(kappa-gamma*rho*i*u-D_1)
  A = i*u*r*tau + kappa*vBar*tau/gamma^2 * (kappa-gamma*rho*i*u-D_1) +
                                                      -2*kappa*vBar/gamma^2*log((1-g*exp(-D_1*tau))/(1-g))

  cf = exp(A + C * v0)

  return(cf)
}