/*Use the Abate-Whitt for numerical inversion of the Laplace transform*/
static double SumAW(double expiry,
double sg, double r, double aa, int terms, int totterms, int nummoment)
{
int k;
double h=sg*sg*expiry/4.0;
double Eulero;
dcomplex term;
dcomplex sum;
double *sum_r;
sum_r = malloc((totterms-terms+2)*sizeof(double));
sum =Complex(0.0, 0.0);
Eulero = 0.0;
sum =RCmul(1.0/2.0,dermellin(Complex(aa/(2.0*h),0), sg, r,nummoment));
for (k=1;k<=totterms;k++)
{
term = RCmul(PNL_ALTERNATE(k) ,dermellin(Complex(aa/(2.0*h) , k*M_PI/h),sg, r,nummoment ));
sum = Cadd(term, sum);
if(terms<= k) sum_r[k-terms+1]= sum.r;
}
for (k=0;k<=totterms-terms;k++)
{
Eulero = Eulero + bico(totterms-terms,k) * pow( 2.0, -(totterms-terms) ) * sum_r[k+1];
}
free(sum_r);
return exp(aa/2.0)*Eulero/h;
}
const dcomplex Levy_process_times_sinus_card(double u,Levy_process * mod,double hx,int Dupire)
{
if(Dupire)
return RCmul(pow(sinus_cardinal(u/2),4)*hx,Levy_process_characteristic_exponent(Complex(-u/hx,-1.),mod));
return RCmul(pow(sinus_cardinal(u/2),4)*hx,Levy_process_characteristic_exponent(Complex(u/hx,0),mod));
}
/*We use the Cauchy Gourat theorem to compute the derivatives of the double(Mellin+Laplace) transform */
static dcomplex dermellin(dcomplex l, double sg, double r, int nummom)
{
dcomplex term, cv, mu;
int i;
double r0,sumr, sumi/*,x[NPOINTS_FUSAITAGL+1],w[NPOINTS_FUSAITAGL+1]*/;
double v;
double *x,*w;
x=malloc((NPOINTS_FUSAITAGL+1)*sizeof(double));
w=malloc((NPOINTS_FUSAITAGL+1)*sizeof(double));
sumr=0.0;
sumi=0.0;
gauleg(0, 2*M_PI, x, w,NPOINTS_FUSAITAGL);
v = 2*r/(sg*sg)-1.0;
cv = Complex(v,0.0);
mu = Csqrt(Cadd(Complex(v*v,0), RCmul(2.0,l)));
r0 = Creal(RCmul(0.5,Csub(mu,cv)));
if(r0>1.0) r0=0.25;
for (i=1;i<=NPOINTS_FUSAITAGL;i++)
{
term = RCmul(pow(r0,nummom), Cexp(Complex(0.0, nummom*x[i])));
sumr += w[i]*Creal(Cdiv(mellintransform(l, RCmul(r0, Cexp(Complex(0.0, x[i]))), sg, r), term));
sumi += w[i]*Cimag(Cdiv(mellintransform(l, RCmul(r0, Cexp(Complex(0.0, x[i]))), sg, r), term));
}
free(x);
free(w);
return Complex(exp(factln(nummom))*sumr/(2.0*M_PI),exp(factln(nummom))*sumi/(2.0*M_PI));
}
static double charact_funct1(double uu)
{
double a,b,rs,rsp,sig,tau,tpf1,tpf2, f10, c0, d0;
dcomplex g,z,w,tp1,tp2,DD,CN,ans,d,expo;
tau=T;
a=k*teta;
rs=rho*sigma;
rsp=rs*uu;
sig=sigma*sigma;
b=k+lambda-rs;
if(uu==0)
{
if(b==0)
{
c0=a*T*T/4.0;
d0=T/2.0;
}
else
{
c0=0.5*a*(exp(-b*T)+b*T - 1.0)/b/b;
d0=0.5*(1.0-exp(-b*T))/b;
}
f10=log(S/K)+(r-divid)*T+c0+d0*v;
return f10;
}
z=Complex(-b,rsp);
z=Cmul(z,z);
w=RCmul(sig,Complex(-uu*uu,uu));
d=Csqrt(Csub(z,w));
tp1=Complex(d.r+b,d.i-rsp);
tp2=Complex(-d.r+b,-d.i-rsp);
g=Cdiv(tp2,tp1);
expo=Cexp(RCmul(-tau,d));
DD=Csub(Complex(1,0),expo);
DD=Cdiv(DD,Csub(Complex(1,0),Cmul(g,expo)));
DD=Cmul(DD,RCmul(1.0/sig,tp2));
CN=Csub(Cmul(g,expo), Complex(1,0));
CN=Cdiv(CN,Csub(g, Complex(1,0) ));
tpf1=a*(tau*tp2.r-2.0*Clog(CN).r)/sig;
tpf2=a*(tau*tp2.i-2.0*Clog(CN).i)/sig;
tpf2+=(r-divid)*uu*tau;
ans=Complex(tpf1+v*DD.r,tpf2+v*DD.i+uu*log(S));
ans=Cmul(Cexp(ans),Cexp(Complex(0,-uu*log(K))));
ans=Cdiv(ans,Complex(0,uu));
return ans.r;
}
main()
{
int i,polish;
fcomplex roots[MP1];
static fcomplex a[MP1] = {{0.0,2.0},
{0.0,0.0},
{-1.0,-2.0},
{0.0,0.0},
{1.0,0.0} };
printf("\nRoots of the polynomial x^4-(1+2i)*x^2+2i\n");
polish=FALSE;
zroots(a,M,roots,polish);
printf("\nUnpolished roots:\n");
printf("%14s %13s %13s\n","root #","real","imag.");
for(i=1;i<=M;i++)
printf("%11d %18.6f %12.6f\n",i,roots[i].r,roots[i].i);
printf("\nCorrupted roots:\n");
for(i=1;i<=M;i++)
roots[i] = RCmul(1+0.01*i,roots[i]);
printf("%14s %13s %13s\n","root #","real","imag.");
for(i=1;i<=M;i++)
printf("%11d %18.6f %12.6f\n",i,roots[i].r,roots[i].i);
polish=TRUE;
zroots(a,M,roots,polish);
printf("\nPolished roots:\n");
printf("%14s %13s %13s\n","root #","real","imag.");
for(i=1;i<=M;i++)
printf("%11d %18.6f %12.6f \n",i,roots[i].r,roots[i].i);
}
void hypser(fcomplex a, fcomplex b, fcomplex c, fcomplex z, fcomplex *series,
fcomplex *deriv)
{
void nrerror(char error_text[]);
int n;
fcomplex aa,bb,cc,fac,temp;
deriv->r=0.0;
deriv->i=0.0;
fac=Complex(1.0,0.0);
temp=fac;
aa=a;
bb=b;
cc=c;
for (n=1;n<=1000;n++) {
fac=Cmul(fac,Cmul(aa,Cdiv(bb,cc)));
deriv->r+=fac.r;
deriv->i+=fac.i;
fac=Cmul(fac,RCmul(1.0/n,z));
*series=Cadd(temp,fac);
if (series->r == temp.r && series->i == temp.i) return;
temp= *series;
aa=Cadd(aa,ONE);
bb=Cadd(bb,ONE);
cc=Cadd(cc,ONE);
}
nrerror("convergence failure in hypser");
}
///******************* Gamma-OU 1d Model*******************///
void phi_psi_gou1d(PnlVect *ModelParams, double t, dcomplex u, dcomplex *phi_i, dcomplex *psi_i)
{
double lambda, alpha, beta;
double a_t;
dcomplex z0, z1, z2, z3;
lambda = GET(ModelParams, 1);
alpha = GET(ModelParams, 2);
beta = GET(ModelParams, 3);
a_t = exp(-lambda*t);
z0 = RCmul(a_t, u);
z1 = RCsub(alpha, z0);
z2 = RCsub(alpha, u);
z3 = RCmul(beta, Clog(Cdiv(z1, z2)));
*phi_i = z3;
*psi_i = z0;
}
/*Computation the double(Mellin+Laplace) transform of the density of arithmetic average */
static dcomplex mellintransform(dcomplex l, dcomplex n, double sg, double r)
{
dcomplex mu,nterm1, nterm2, nterm3, dterm1, dterm2;
dcomplex num, den, cv,cost;
double v;
v= 2*r/(sg*sg)-1.0;
cv =Complex(v,0.0);
mu = Csqrt(Cadd(Complex(v*v,0), RCmul(2.0,l)));
cost=RCmul(log(2.0/(sg*sg)), n);
nterm1 =Clgamma(Cadd(n,CONE));
nterm2 =Clgamma(Cadd(RCmul(0.5, Cadd(mu,cv)),CONE));
nterm3 =Clgamma(Csub(RCmul(0.5, Csub(mu,cv)),n));
num = Cadd(Cadd( nterm1,nterm2),nterm3);
dterm1 =Clgamma(RCmul(0.5, Csub(mu,cv)));
dterm2 =Clgamma(Cadd(Cadd(RCmul(0.5, Cadd(mu,cv)),CONE),n));
den = Cadd( dterm1,dterm2);
return Cdiv(Cexp(Cadd(Csub(num,den),cost)),l);
}
void phi_psi_cir1d(PnlVect *ModelParams, double t, dcomplex u, dcomplex *phi_i, dcomplex *psi_i)
{
double lambda, theta, eta, SQR_eta;
dcomplex z1, z2;
double b_t, a_t;
//x0 = GET(ModelParams, 0);
lambda = GET(ModelParams, 1);
theta = GET(ModelParams, 2);
eta = GET(ModelParams, 3);
SQR_eta = SQR(eta);
a_t = exp(-lambda*t);
if (lambda == 0.) b_t = t;
else b_t = (1.-a_t)/lambda;
z1 = RCsub(1., RCmul(2*SQR_eta*b_t, u));
*phi_i = RCmul(-lambda*theta/(2*SQR_eta), Clog(z1));
z1 = RCmul(a_t, u);
z2 = RCsub(1., RCmul(2*SQR_eta*b_t, u));
*psi_i = Cdiv(z1, z2);
}
void wigner20(complx* d20,double alpha,double beta)
{
double cosb,sinb,sin2b,sinof2b;
complx em2a,ema,epa,ep2a;
alpha *= DEG2RAD;
beta *= DEG2RAD;
cosb =cos(beta);
sinb =sin(beta);
sin2b =sinb*sinb;
sinof2b=sin(2.0*beta);
em2a =Cexpi(-2.0*alpha);
ema =Cexpi(-alpha);
epa =Conj(ema);
ep2a =Conj(em2a);
d20[4] = RCmul(SQRT3BY8*sin2b,em2a);
d20[3] = RCmul(-SQRT3BY8*sinof2b,ema);
d20[2] = Complx(0.5*(3.0*cosb*cosb-1.0),0.0);
d20[1] = RCmul(SQRT3BY8*sinof2b,epa);
d20[0] = RCmul(SQRT3BY8*sin2b,ep2a);
}
void hypdrv(float s, float yy[], float dyyds[])
{
fcomplex z,y[3],dyds[3];
y[1]=Complex(yy[1],yy[2]);
y[2]=Complex(yy[3],yy[4]);
z=Cadd(z0,RCmul(s,dz));
dyds[1]=Cmul(y[2],dz);
dyds[2]=Cmul(Csub(Cmul(Cmul(aa,bb),y[1]),Cmul(Csub(cc,
Cmul(Cadd(Cadd(aa,bb),ONE),z)),y[2])),
Cdiv(dz,Cmul(z,Csub(ONE,z))));
dyyds[1]=dyds[1].r;
dyyds[2]=dyds[1].i;
dyyds[3]=dyds[2].r;
dyyds[4]=dyds[2].i;
}
static int compute_price(double tt, double H, double K, double r_premia, double v0, double kappa, double theta, double sigma, double rho,
double L, int M, int Nt )
{
/*Variables*/
int j, n, k;
double r; /*continuous rate*/
double min_log_price, max_log_price;
double ds, dt; /*price and time discretization steps*/
double rho_hat; /*parameter after substitution*/
double q, factor, discount_factor; /*pde parameters*/
double treshold = 1e-9; /* when we assume probability to be zero and switch to a different equation*/
int k_d, k_u; /*n+1 vertice numbers, depending on [n][k]*/
double sigma_local, gamma; /*wh factors parameters*/
double beta_minus, beta_plus; /*wh-factors coefficients*/
double local_barrier; /*a barrier depending on [n][k], to check crossing on each step*/
//if (2.0 * kappa * theta < pow(sigma, 2))
// return 1; /*Novikov condition not satisfied, probability values could be incorrect*/
/*Body*/
r = log(1 + r_premia / 100);
/*building voltree*/
tree_v(tt, v0, kappa, theta, sigma, Nt);
/*spacial variable. Price space construction*/
min_log_price = L*log(0.5) - (rho / sigma)* V[Nt][Nt];
max_log_price = L*log(2);
ds = (max_log_price - min_log_price) / double(M);
for (j = 0; j < M; j++)
{
ba_log_prices[j] = min_log_price + j*ds;
ba_prices[j] = H*exp(ba_log_prices[j] + (rho / sigma)* V[0][0]);
}
dt = tt / double(Nt);
/*fft frequences we'll need in every vertice of a tree*/
fftfreq(M, ds);
rho_hat = sqrt(1.0 - pow(rho, 2.0));
q = 1.0 / dt + r;
factor = pow(q*dt, -1.0);
//discount_factor = exp(r*dt);
discount_factor = r - rho / sigma * kappa * theta;
/*filling F_next matrice by initial (in time T) conditions*/
for (j = 0; j < M; j++)
for (k = 0; k < Nt + 1; k++)
{
F_next[j][k] = Complex(G(H*exp(ba_log_prices[j] + (rho / sigma)* V[Nt][k]), K), 0);
}
/*here the main cycle starts - the backward induction procedure*/
for (n = Nt - 1; n >= 0; n--)
{
printf("Processing: %d of %d\n", n, Nt-1);
for (k = 0; k <= n; k++)
{
/*to calculate the binomial expectation we should use matrices from the tree method.
After (n,k) vertice one could either get to (n+1,k_u) or (n+1, k_d). The numbers k_u and k_d could be
read from f_up and f_down matrices, by the rule of addition, for example:
f_down[i][j] = -z;
Rd = V[i + 1][j - z]
f_up[i][j] = z;
Ru = V[i + 1][j + z];
*/
k_u = k + f_up[n][k];
k_d = k + f_down[n][k];
local_barrier = - (rho / sigma) * V[n][k];
/*initial conditions of a step*/
for (j = 0; j < M; j++)
{
//f_n_plus_1_k_u[j] = F[j][n+1][k_u];
//f_n_plus_1_k_d[j] = F[j][n+1][k_d];
f_n_plus_1_k_u[j] = F_next[j][k_u];
f_n_plus_1_k_d[j] = F_next[j][k_d];
}
/*applying indicator function*/
for (j = 0; j < M; j++)
{
if (ba_log_prices[j] < local_barrier)
{
f_n_plus_1_k_u[j].r = 0.0;
f_n_plus_1_k_u[j].i = 0.0;
f_n_plus_1_k_d[j].r = 0.0;
f_n_plus_1_k_d[j].i = 0.0;
}
}
if (V[n][k] >= treshold)
{
/*set up variance - dependent parameters for a given step*/
sigma_local = rho_hat * sqrt(V[n][k]);
gamma = r - 0.5 * V[n][k] - rho / sigma * kappa * (theta - V[n][k]); /*also local*/
/* beta_plus and beta_minus*/
/*beta_minus = -(gamma + sqrt(gamma^2 + 2 * sigma^2 * q)) / sigma^2
beta_plus = -(gamma - sqrt(gamma^2 + 2 * sigma^2 * q)) / sigma^2*/
beta_minus = -(gamma + sqrt(pow(gamma,2) + 2 * pow(sigma_local,2) * q)) / pow(sigma_local,2);
beta_plus = -(gamma - sqrt(pow(gamma,2) + 2 * pow(sigma_local,2) * q)) / pow(sigma_local,2);
for (j = 0; j < M; j++)
{
/* factor functions
phi_plus_array = ([beta_plus / (beta_plus - i * 2 * pi*xi) for xi in xi_space])
phi_minus_array = ([-beta_minus / (-beta_minus + i * 2 * pi*xi) for xi in xi_space]) */
phi_plus_array[j] = RCdiv(beta_plus, RCsub(beta_plus, RCmul((2.0 * PI * fftfreqs[j]), CI)));
phi_minus_array[j] = RCdiv(-beta_minus, RCadd(-beta_minus, RCmul((2.0 * PI * fftfreqs[j]), CI)));
}
/*factorization calculation*/
/*f_n_k_u = factor * fft.ifft(phi_minus_array * fft.fft(
indicator(original_prices_array, 0) * fft.ifft(phi_plus_array * fft.fft(f_n_plus_1_k_u))))*/
for (int j = 0; j < M; j++)
{
f_n_plus_1_k_u_re[j] = f_n_plus_1_k_u[j].r;
f_n_plus_1_k_u_im[j] = f_n_plus_1_k_u[j].i;
}
pnl_fft2(f_n_plus_1_k_u_re, f_n_plus_1_k_u_im, M);
for (j = 0; j < M; j++) {
/*putting complex and imaginary part together again*/
f_n_plus_1_k_u_fft_results[j] = Complex(f_n_plus_1_k_u_re[j], f_n_plus_1_k_u_im[j]);
/*multiplying by phi_plus*/
f_n_plus_1_k_u_fft_results[j] = Cmul(phi_plus_array[j], f_n_plus_1_k_u_fft_results[j]);
/*extracting imaginary and complex parts to use in further fft*/
f_n_plus_1_k_u_fft_results_re[j] = f_n_plus_1_k_u_fft_results[j].r;
f_n_plus_1_k_u_fft_results_im[j] = f_n_plus_1_k_u_fft_results[j].i;
}
pnl_ifft2(f_n_plus_1_k_u_fft_results_re, f_n_plus_1_k_u_fft_results_im, M);
/*applying indicator function, after ifft*/
for (j = 0; j < M; j++)
{
if (ba_log_prices[j] < local_barrier)
{
f_n_plus_1_k_u_fft_results_re[j] = 0.0;
f_n_plus_1_k_u_fft_results_im[j] = 0.0;
}
}
/*performing second fft */
pnl_fft2(f_n_plus_1_k_u_fft_results_re, f_n_plus_1_k_u_fft_results_im, M);
for (j = 0; j < M; j++) {
/*putting complex and imaginary part together again*/
f_n_plus_1_k_u_fft_results[j] = Complex(f_n_plus_1_k_u_fft_results_re[j], f_n_plus_1_k_u_fft_results_im[j]);
/*multiplying by phi_minus*/
f_n_plus_1_k_u_fft_results[j] = Cmul(phi_minus_array[j], f_n_plus_1_k_u_fft_results[j]);
/*extracting imaginary and complex parts to use in further fft*/
f_n_plus_1_k_u_fft_results_re[j] = f_n_plus_1_k_u_fft_results[j].r;
f_n_plus_1_k_u_fft_results_im[j] = f_n_plus_1_k_u_fft_results[j].i;
}
/*the very last ifft*/
pnl_ifft2(f_n_plus_1_k_u_fft_results_re, f_n_plus_1_k_u_fft_results_im, M);
/*multiplying by factor*/
for (j = 0; j < M; j++) {
f_n_k_u[j].r = factor * f_n_plus_1_k_u_fft_results_re[j];
f_n_k_u[j].i = factor * f_n_plus_1_k_u_fft_results_im[j];
}
/*f_n_k_d = factor * fft.ifft(phi_minus_array * fft.fft(
indicator(original_prices_array, 0) * fft.ifft(phi_plus_array * fft.fft(f_n_plus_1_k_d))))*/
for (int j = 0; j < M; j++)
{
f_n_plus_1_k_d_re[j] = f_n_plus_1_k_d[j].r;
f_n_plus_1_k_d_im[j] = f_n_plus_1_k_d[j].i;
}
pnl_fft2(f_n_plus_1_k_d_re, f_n_plus_1_k_d_im, M);
for (j = 0; j < M; j++) {
/*putting complex and imaginary part together again*/
f_n_plus_1_k_d_fft_results[j] = Complex(f_n_plus_1_k_d_re[j], f_n_plus_1_k_d_im[j]);
/*multiplying by phi_plus*/
f_n_plus_1_k_d_fft_results[j] = Cmul(phi_plus_array[j], f_n_plus_1_k_d_fft_results[j]);
/*extracting imaginary and complex parts to use in further fft*/
f_n_plus_1_k_d_fft_results_re[j] = f_n_plus_1_k_d_fft_results[j].r;
f_n_plus_1_k_d_fft_results_im[j] = f_n_plus_1_k_d_fft_results[j].i;
}
pnl_ifft2(f_n_plus_1_k_d_fft_results_re, f_n_plus_1_k_d_fft_results_im, M);
/*applying indicator function, after ifft*/
for (j = 0; j < M; j++)
{
if (ba_log_prices[j] < local_barrier)
{
f_n_plus_1_k_d_fft_results_re[j] = 0.0;
f_n_plus_1_k_d_fft_results_im[j] = 0.0;
}
}
/*performing second fft */
pnl_fft2(f_n_plus_1_k_d_fft_results_re, f_n_plus_1_k_d_fft_results_im, M);
for (j = 0; j < M; j++) {
/*putting complex and imaginary part together again*/
f_n_plus_1_k_d_fft_results[j] = Complex(f_n_plus_1_k_d_fft_results_re[j], f_n_plus_1_k_d_fft_results_im[j]);
/*multiplying by phi_minus*/
f_n_plus_1_k_d_fft_results[j] = Cmul(phi_minus_array[j], f_n_plus_1_k_d_fft_results[j]);
/*extracting imaginary and complex parts to use in further fft*/
f_n_plus_1_k_d_fft_results_re[j] = f_n_plus_1_k_d_fft_results[j].r;
f_n_plus_1_k_d_fft_results_im[j] = f_n_plus_1_k_d_fft_results[j].i;
}
/*the very last ifft*/
pnl_ifft2(f_n_plus_1_k_d_fft_results_re, f_n_plus_1_k_d_fft_results_im, M);
/*multiplying by factor*/
for (j = 0; j < M; j++) {
f_n_k_d[j].r = factor * f_n_plus_1_k_d_fft_results_re[j];
f_n_k_d[j].i = factor * f_n_plus_1_k_d_fft_results_im[j];
}
}
else if (V[n][k] < treshold)
{
/*applying indicator function*/
for (j = 0; j < M; j++)
{
if (ba_log_prices[j] < local_barrier)
{
f_n_plus_1_k_u[j].r = 0.0;
f_n_plus_1_k_u[j].i = 0.0;
f_n_plus_1_k_d[j].r = 0.0;
f_n_plus_1_k_d[j].i = 0.0;
}
}
for (j = 0; j < M; j++)
{
//f_n_plus_1_k_u[j] = F[j][n + 1][k_u];
f_n_plus_1_k_u[j] = F_next[j][k_u];
f_n_k_u[j] = CRsub(f_n_plus_1_k_u[j], discount_factor * dt);
f_n_k_d[j] = f_n_k_u[j];
}
}
/*
f_n_k = pd_f[n, k] * f_n_k_d + pu_f[n, k] * f_n_k_u
*/
for (j = 0; j < M; j++)
{
f_n_k[j] = Cadd(RCmul(pd_f[n][k], f_n_k_d[j]), RCmul(pu_f[n][k], f_n_k_u[j]));
F_prev[j][k] = f_n_k[j];
}
}
for (j = 0; j < M; j++)
{
for (int state = 0; state < Nt; state++)
{
F_next[j][state] = F_prev[j][state];
F_prev[j][state] = Complex(0,0);
}
}
}
/*Preprocessing F before showing out*/
for (j = 0; j < M; j++)
{
if (ba_prices[j] <= H)
{
F_next[j][0].r = 0;
}
if (F_next[j][0].r < 0.)
{
F_next[j][0].r = 0;
}
}
return OK;
}
void cisi(float x, float *ci, float *si)
{
void nrerror(char error_text[]);
int i,k,odd;
float a,err,fact,sign,sum,sumc,sums,t,term;
fcomplex h,b,c,d,del;
t=fabs(x);
if (t == 0.0) {
*si=0.0;
*ci = -1.0/FPMIN;
return;
}
if (t > TMIN) {
b=Complex(1.0,t);
c=Complex(1.0/FPMIN,0.0);
d=h=Cdiv(ONE,b);
for (i=2;i<=MAXIT;i++) {
a = -(i-1)*(i-1);
b=Cadd(b,Complex(2.0,0.0));
d=Cdiv(ONE,Cadd(RCmul(a,d),b));
c=Cadd(b,Cdiv(Complex(a,0.0),c));
del=Cmul(c,d);
h=Cmul(h,del);
if (fabs(del.r-1.0)+fabs(del.i) < EPS) break;
}
if (i > MAXIT) nrerror("cf failed in cisi");
h=Cmul(Complex(cos(t),-sin(t)),h);
*ci = -h.r;
*si=PIBY2+h.i;
} else {
if (t < sqrt(FPMIN)) {
sumc=0.0;
sums=t;
} else {
sum=sums=sumc=0.0;
sign=fact=1.0;
odd=TRUE;
for (k=1;k<=MAXIT;k++) {
fact *= t/k;
term=fact/k;
sum += sign*term;
err=term/fabs(sum);
if (odd) {
sign = -sign;
sums=sum;
sum=sumc;
} else {
sumc=sum;
sum=sums;
}
if (err < EPS) break;
odd=!odd;
}
if (k > MAXIT) nrerror("maxits exceeded in cisi");
}
*si=sums;
*ci=sumc+log(t)+EULER;
}
if (x < 0.0) *si = -(*si);
}
void frenel(float x, float *s, float *c)
{
void nrerror(char error_text[]);
int k,n,odd;
float a,ax,fact,pix2,sign,sum,sumc,sums,term,test;
fcomplex b,cc,d,h,del,cs;
ax=fabs(x);
if (ax < sqrt(FPMIN)) {
*s=0.0;
*c=ax;
} else if (ax <= XMIN) {
sum=sums=0.0;
sumc=ax;
sign=1.0;
fact=PIBY2*ax*ax;
odd=TRUE;
term=ax;
n=3;
for (k=1;k<=MAXIT;k++) {
term *= fact/k;
sum += sign*term/n;
test=fabs(sum)*EPS;
if (odd) {
sign = -sign;
sums=sum;
sum=sumc;
} else {
sumc=sum;
sum=sums;
}
if (term < test) break;
odd=!odd;
n += 2;
}
if (k > MAXIT) nrerror("series failed in frenel");
*s=sums;
*c=sumc;
} else {
pix2=PI*ax*ax;
b=Complex(1.0,-pix2);
cc=Complex(1.0/FPMIN,0.0);
d=h=Cdiv(ONE,b);
n = -1;
for (k=2;k<=MAXIT;k++) {
n += 2;
a = -n*(n+1);
b=Cadd(b,Complex(4.0,0.0));
d=Cdiv(ONE,Cadd(RCmul(a,d),b));
cc=Cadd(b,Cdiv(Complex(a,0.0),cc));
del=Cmul(cc,d);
h=Cmul(h,del);
if (fabs(del.r-1.0)+fabs(del.i) < EPS) break;
}
if (k > MAXIT) nrerror("cf failed in frenel");
h=Cmul(Complex(ax,-ax),h);
cs=Cmul(Complex(0.5,0.5),
Csub(ONE,Cmul(Complex(cos(0.5*pix2),sin(0.5*pix2)),h)));
*c=cs.r;
*s=cs.i;
}
if (x < 0.0) {
*c = -(*c);
*s = -(*s);
}
}
void wigner2(complx *d2,double alpha,double beta,double gamma)
{
double cosb,sinb,cos2b,sin2b,cplus,cminus,gamma2,alpha2;
double cplus2,cminus2,sinof2b,cplussinb,cminussinb,SQRT3BY8sinof2b,SQRT3BY8sin2b;
complx em2am2g,em2amg,em2a,em2apg,em2ap2g,emam2g,emamg,ema;
complx emapg,emap2g,em2g,emg,epg,ep2g,epam2g,epamg,epa;
complx epapg,epap2g,ep2am2g,ep2amg,ep2a,ep2apg,ep2ap2g;
alpha *= DEG2RAD;
beta *= DEG2RAD;
gamma *= DEG2RAD;
cosb=cos(beta);
sinb=sin(beta);
cos2b=cosb*cosb;
sin2b=sinb*sinb;
cplus=(1.0+cosb)*0.5;
cminus=(1.0-cosb)*0.5;
cplus2=cplus*cplus;
cminus2=cminus*cminus;
sinof2b=sin(2.0*beta);
alpha2=-2.0*alpha;
gamma2=2.0*gamma;
cplussinb=cplus*sinb;
cminussinb=cminus*sinb;
SQRT3BY8sinof2b=SQRT3BY8*sinof2b;
SQRT3BY8sin2b=SQRT3BY8*sin2b;
em2am2g=Cexpi(alpha2-gamma2);
em2amg =Cexpi(alpha2-gamma);
em2a =Cexpi(alpha2);
em2apg =Cexpi(alpha2+gamma);
em2ap2g=Cexpi(alpha2+gamma2);
emam2g =Cexpi(-alpha-gamma2);
emamg =Cexpi(-alpha-gamma);
ema =Cexpi(-alpha);
emapg =Cexpi(-alpha+gamma);
emap2g =Cexpi(-alpha+gamma2);
em2g =Cexpi(-gamma2);
emg =Cexpi(-gamma);
epg =Conj(emg);
ep2g =Conj(em2g);
epam2g =Conj(emap2g);
epamg =Conj(emapg);
epa =Conj(ema);
epapg =Conj(emamg);
epap2g =Conj(emam2g);
ep2am2g=Conj(em2ap2g);
ep2amg =Conj(em2apg);
ep2a =Conj(em2a);
ep2apg =Conj(em2amg);
ep2ap2g=Conj(em2am2g);
/* first column D_i-2 */
d2[ 0] = RCmul(cplus2 ,ep2ap2g);
d2[ 1] = RCmul(-cplussinb ,epap2g);
d2[ 2] = RCmul(SQRT3BY8sin2b ,ep2g );
d2[ 3] = RCmul(-cminussinb ,emap2g);
d2[ 4] = RCmul(cminus2 ,em2ap2g );
/* second column D_i-1 */
d2[ 5] = RCmul(cplussinb ,ep2apg );
d2[ 6] = RCmul((cos2b-cminus),epapg );
d2[ 7] = RCmul(-SQRT3BY8sinof2b,epg );
d2[ 8] = RCmul((cplus-cos2b) ,emapg );
d2[ 9] = RCmul(-cminussinb,em2apg );
/* third column D_i0 */
d2[10] = RCmul(SQRT3BY8sin2b ,ep2a );
d2[11] = RCmul(SQRT3BY8sinof2b ,epa );
d2[12] = Complx(0.5*(3.0*cos2b-1.0),0.0);
d2[13] = RCmul(-SQRT3BY8sinof2b,ema );
d2[14] = RCmul(SQRT3BY8sin2b ,em2a );
/* fourth column D_i+1 */
d2[15] = RCmul(cminussinb ,ep2amg );
d2[16] = RCmul((cplus-cos2b) ,epamg );
d2[17] = RCmul(SQRT3BY8sinof2b ,emg );
d2[18] = RCmul((cos2b-cminus),emamg );
d2[19] = RCmul(-cplussinb ,em2amg );
/* fifth column D_i+2 */
d2[20] = RCmul(cminus2 ,ep2am2g);
d2[21] = RCmul(cminussinb ,epam2g);
d2[22] = RCmul(SQRT3BY8sin2b ,em2g );
d2[23] = RCmul(cplussinb ,emam2g);
d2[24] = RCmul(cplus2 ,em2am2g );
return;
}
static double charact_func(double k)
{
double X,tau,roeps,u,b,I,eps,eps2;
dcomplex Ak,Bk,Ck,Dk,Lambdak,z1,z2,z3,zeta,psi_moins,psi_plus,expo,ans;
dcomplex dlk;
tau = T;
eps = sigma;
roeps = rho*eps;
X = log(S/K) + (r - divid)*tau;
eps2 = eps*eps;
if(func_type==1)
{
u = 1.;
b = kappa - roeps;
I = 1.;
}
else if(func_type==2)
{
u = -1.;
b = kappa;
I = 0.;
}
else
{
printf("erreur : dans charact_func il faut initialiser func_type a 1 ou 2.\n");
exit(-1);
}
if(heston==1)
{
z1 = Complex(k*k,-u*k);
z2 = Complex(b,-roeps*k);
z2 = Cmul(z2,z2);
zeta = Cadd(z2,RCmul(eps2,z1));
zeta = Csqrt(zeta);
psi_moins = Complex(b,-roeps*k);
psi_plus = RCmul(-1.,psi_moins);
psi_moins = Cadd(psi_moins,zeta);
psi_plus = Cadd(psi_plus,zeta);
expo = Cexp( RCmul(-tau,zeta) );
z3 = Cadd( psi_moins , Cmul(psi_plus,expo) );
Bk = RCmul(-1.,z1);
Bk = Cmul( Bk , Csub(Complex(1.,0),expo) );
Bk = Cdiv(Bk,z3);
Ak = Cdiv( z3 , RCmul(2.,zeta) );
Ak = Clog(Ak);
if(initlog>0)
{
dlk = Csub(Ak,lk_1);
if(dlk.i < -M_PI)
{
bk = bk + 1;
}
else if(dlk.i > M_PI)
{
bk = bk - 1;
}
initlog++;
lk_1 = Ak;
} else {
initlog++;
lk_1 = Ak;
}
Ak = Cadd(Ak, Complex(0.,2*M_PI*bk));
Ak = RCmul( 2. , Ak );
Ak = Cadd( RCmul(tau,psi_plus) , Ak);
Ak = RCmul( -kappa*teta/eps2 , Ak);
}
else
{
Ak = Complex(0.,0.);
Bk = Complex( -0.5*tau*k*k , 0.5*tau*u*k );
}
if(merton==1)
{
z1 = Complex( -0.5*v*v*k*k + I*(m0+0.5*v*v) , (m0+I*v*v)*k );
z1 = Cexp(z1);
z2 = Complex(I,k);
z2 = RCmul( exp(m0+0.5*v*v) -1, z2);
z2 = Cadd( Complex(1.,0.) , z2 );
Lambdak = Csub(z1,z2);
Ck = Complex(0.,0.);
Dk = RCmul(tau,Lambdak);
}
else
{
Ck = Complex(0.,0.);
Dk = Complex(0.,0.);
}
ans = Cadd( Ak , RCmul(V0,Bk) );
ans = Cadd( ans , Ck );
ans = Cadd( ans , RCmul(lambda0,Dk) );
ans = Cadd( ans , Complex(0.,k*X) );
ans = Cexp(ans);
ans = Cdiv(ans,Complex(0.,k));
return ans.r;
}
int CarrMethod_VectStrike(PnlVect *K,
PnlVect * Price,
double S0,
double T,
double B,
double CallPut,
double r,
double divid,
double sigma,
void * Model,
dcomplex (*ln_phi)(dcomplex u,double t,void * model))
{
int n;
dcomplex dzeta,dzetaBS;
double alpha=0.75;
int Nlimit = 4*2048;//2048;
//>> Should be even => use of real_fft
//number of integral discretization steps
double mone;//0.010;
double Kstep=B*2/(Nlimit); // strike domain is (-B,B)
double h = M_2PI/(Nlimit*Kstep);
//double B = 0.5*(Nlimit)*Kstep; // strike domain is (-B,B)
double vn = 0;
dcomplex vn_minus_alpha_plus_uno = Complex(0,-(alpha+1));
dcomplex i_vn_plus_alpha = Complex(alpha,0);
dcomplex uno_plus_alpha_plus_ivn =Complex(1+alpha,vn);
PnlVectComplex * y = pnl_vect_complex_create(Nlimit);
// Should become output
pnl_vect_resize(K,Nlimit);
pnl_vect_resize(Price,Nlimit);
//delta
mone=1;
//printf("limit integration %7.4f \n",A);
for(n=0; n<Nlimit; n++)
{
dzeta = Cadd(ln_phi(vn_minus_alpha_plus_uno,T,Model),Complex(0,vn*B));
dzetaBS = Cadd(ln_phi_BS(vn_minus_alpha_plus_uno,T,sigma),Complex(0,vn*B));
dzeta = Csub(Cexp(dzeta),Cexp(dzetaBS));
dzeta = Cdiv(dzeta,i_vn_plus_alpha);
dzeta = Cdiv(dzeta,uno_plus_alpha_plus_ivn);
//>> With Simson rules
pnl_vect_complex_set(y,n,RCmul(3+mone-((n==0)?1:0),Conj(dzeta)));
//>> Update value
vn += h;
vn_minus_alpha_plus_uno.r+=h;
i_vn_plus_alpha.i+=h;
uno_plus_alpha_plus_ivn.i+=h;
mone*=-1;
}
pnl_ifft_inplace(y);
for(n=0;n<Nlimit;n++)
{
LET(K,n)=exp(-B+n*Kstep+(r-divid)*T)*(S0);
pnl_cf_call_bs(S0,GET(K,n),T,r,divid,sigma,&LET(Price,n),&vn);
LET(Price,n)+=2./3* S0/(Kstep)*exp(alpha*(B-n*Kstep)-divid*T)*GET_REAL(y,n);
}
if (CallPut==2)
for(n=0;n<Nlimit;n++)
LET(Price,n)-=S0*exp(-divid*T)+GET(K,n)*exp(-r*T);
/*
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2-5),GET(Price,Nlimit/2-5));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2-4),GET(Price,Nlimit/2-4));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2-3),GET(Price,Nlimit/2-3));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2-2),GET(Price,Nlimit/2-2));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2-1),GET(Price,Nlimit/2-1));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+0),GET(Price,Nlimit/2+0));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+1),GET(Price,Nlimit/2+1));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+2),GET(Price,Nlimit/2+2));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+3),GET(Price,Nlimit/2+3));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+4),GET(Price,Nlimit/2+4));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+5),GET(Price,Nlimit/2+5));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+6),GET(Price,Nlimit/2+6));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+7),GET(Price,Nlimit/2+7));
printf("Price K= %7.4f P= %7.4f \n",GET(K,Nlimit/2+8),GET(Price,Nlimit/2+8));
pnl_vect_free(&K);
pnl_vect_free(&Price);
*/
return OK;
}
int CarrMethod_old_verison(double S0,
double T,
double K,
double CallPut,
double r,
double divid,
double sigma,
void * Model,
dcomplex (*ln_phi)(dcomplex u,double t,void * model),
double *ptprice,
double *ptdelta)
{
int n;
dcomplex dzeta,dzetaBS;
double alpha=0.0;
//taking account of dividends
int Nlimit = 2048;
//number of integral discretization steps
double logstrikestep = 0.01;
double k0 = log(K/(S0*exp(-divid*T)));
double h = M_2PI/Nlimit/logstrikestep; //integral discretization step
double A = (Nlimit-1)*h; // integration domain is (-A/2,A/2)
PnlVectComplex * z =pnl_vect_complex_create(Nlimit);
PnlVectComplex * y =pnl_vect_complex_create(Nlimit);
double vn = -A/2;
dcomplex vn_minus_alpha_plus_uno = Complex(-A/2,-(alpha+1));
dcomplex i_vn_plus_alpha = Complex(alpha,-A/2);
double weight = 1./3; //Simpson's rule weights
dcomplex uno_plus_alpha_plus_ivn=Complex(1+alpha,vn);
//delta
for(n=0; n<Nlimit; n++)
{
dzeta= Cadd(ln_phi(vn_minus_alpha_plus_uno,T,Model),Complex(0,vn*(r*T-k0)));
dzetaBS= Cadd(ln_phi_BS(vn_minus_alpha_plus_uno,T,sigma),Complex(0,vn*(r*T-k0)));
dzeta = Csub(Cexp(dzeta),Cexp(dzetaBS));
dzeta = Cdiv(dzeta,i_vn_plus_alpha);
dzeta = RCmul(weight,dzeta);
pnl_vect_complex_set(z,n,dzeta);
dzeta=Cdiv(dzeta,uno_plus_alpha_plus_ivn);
pnl_vect_complex_set(y,n,dzeta);
//>> Update value
vn += h;
vn_minus_alpha_plus_uno.r+=h;
i_vn_plus_alpha.i+=h;
uno_plus_alpha_plus_ivn.i+=h;
weight = (weight<1) ? 4./3 : 2./3; //Simpson's rule weights
weight = (n==(Nlimit-2)) ?2./3. :weight;
}
//pnl_vect_complex_print(z);
pnl_fft_inplace(z);
pnl_fft_inplace(y);
//pnl_vect_complex_print(z);
//Black-Scholes formula
pnl_cf_call_bs(S0,K,T,r,divid,sigma,ptprice,ptdelta);
S0 *= exp(-divid*T);
/*Call Case*/
*ptprice += S0*A/M_2PI/(Nlimit-1)*exp(-alpha*k0)*GET_REAL(y,0);
*ptdelta += exp(-divid*T)*(A/M_2PI/(Nlimit-1)*exp(-alpha*k0)*GET_REAL(z,0));
//Put Case via parity*/
if (CallPut==2)
{
*ptprice =*ptprice-S0+K*exp(-r*T);
*ptdelta =*ptdelta-exp(-divid*T);
}
//memory desallocation
pnl_vect_complex_free(&z);
pnl_vect_complex_free(&y);
return OK;
}
int CarrMethod(double S0,
double T,
double K,
double CallPut,
double r,
double divid,
double sigma,
void * Model,
dcomplex (*ln_phi)(dcomplex u,double t,void * model),
double *ptprice,
double *ptdelta)
{
int n;
dcomplex dzeta,dzetaBS;
double alpha=0.75;
//taking account of dividends
int Nlimit = 2048;//2048;
//number of integral discretization steps
double logstrikestep = 0.01;
double k0 = log(K/S0)-(r-divid)*T;
double h = M_PI/Nlimit/logstrikestep; //integral discretization step
double z,y;
double vn = 0;
dcomplex vn_minus_alpha_plus_uno = Complex(0,-(alpha+1));
dcomplex i_vn_plus_alpha = Complex(alpha,0);
double weight = 1./3; //Simpson's rule weights
dcomplex uno_plus_alpha_plus_ivn=Complex(1+alpha,vn);
//delta
z=0;y=0;
for(n=0; n<Nlimit; n++)
{
dzeta=Cadd(ln_phi(vn_minus_alpha_plus_uno,T,Model),Complex(0,-vn*k0));
// printf("%7.4f + i %7.4f \n",dzeta.r,dzeta.i);
dzetaBS= Cadd(ln_phi_BS(vn_minus_alpha_plus_uno,T,sigma),Complex(0,-vn*k0));
dzeta = Csub(Cexp(dzeta),Cexp(dzetaBS));
dzeta = Cdiv(dzeta,i_vn_plus_alpha);
dzeta = RCmul(weight,dzeta);
//printf(">>%7.4f + i %7.4f \n",dzeta.r,dzeta.i);
z+=dzeta.r;
dzeta=Cdiv(dzeta,uno_plus_alpha_plus_ivn);
y+=dzeta.r;
//>> Update value
vn += h;
vn_minus_alpha_plus_uno.r+=h;
i_vn_plus_alpha.i+=h;
uno_plus_alpha_plus_ivn.i+=h;
weight = (weight<1) ? 4./3 : 2./3; //Simpson's rule weights
weight = (n==(Nlimit-2)) ?2./3. :weight;
}
//Black-Scholes formula
pnl_cf_call_bs(S0,K,T,r,divid,sigma,ptprice,ptdelta);
S0 *= exp(-divid*T);
/*Call Case*/
*ptprice += S0/(Nlimit*logstrikestep)*exp(-alpha*k0)*y;
//*ptprice = y;
*ptdelta += exp(-divid*T)/(Nlimit*logstrikestep)*exp(-alpha*k0)*z;
//Put Case via parity*/
if (CallPut==2)
{
*ptprice =*ptprice-S0+K*exp(-r*T);
*ptdelta =*ptdelta-exp(-divid*T);
}
//memory desallocation
return OK;
}
dcomplex ln_phi_BS(dcomplex u,double t,double sigma)
{
dcomplex psi=RCmul(-sigma*sigma*t*0.5,C_op_apib(Cmul(u,u),u));
//printf( " **> %7.4f +i %7.4f \n",psi.r,psi.i);
return psi;
}
static double charact_func0(double k)
{
double X,tau,roeps,u,eps,eps2;
dcomplex Ak,Bk,Ck,Dk,Lambdak,z1,z2,z3,zeta,psi_moins,psi_plus,expo,ans;
dcomplex dlk;
tau = T;
eps = sigma;
roeps = rho*eps;
X = log(S/K) + (r - divid)*tau;
u = kappa - roeps/2.;
eps2 = eps*eps;
if(heston==1)
{
zeta.r = k*k*eps2*(1.-rho*rho) + u*u + eps2/4.;
zeta.i = 2.*k*roeps*u;
zeta = Csqrt(zeta);
psi_moins = Complex(u,roeps*k);
psi_plus = RCmul(-1.,psi_moins);
psi_moins = Cadd(psi_moins,zeta);
psi_plus = Cadd(psi_plus,zeta);
expo = Cexp( RCmul(-tau,zeta) );
z3 = Cadd( psi_moins , Cmul(psi_plus,expo) );
Bk = RCmul( -(k*k+0.25) , Csub(Complex(1.,0),expo) );
Bk = Cdiv(Bk,z3);
Ak = Cdiv( z3 , RCmul(2.,zeta) );
Ak = Clog(Ak);
if(initlog>0)
{
dlk = Csub(Ak,lk_1);
if(dlk.i < -M_PI)
{
bk = bk + 1;
}
else if(dlk.i > M_PI)
{
bk = bk - 1;
}
initlog++;
lk_1 = Ak;
} else {
initlog++;
lk_1 = Ak;
}
Ak = Cadd(Ak, Complex(0.,2*M_PI*bk));
Ak = RCmul( 2. , Ak );
Ak = Cadd( RCmul(tau,psi_plus) , Ak);
Ak = RCmul( -kappa*teta/eps2 , Ak);
}
else
{
Ak = Complex(0.,0.);
Bk = Complex( -0.5*tau*(k*k+0.25) ,0.);
}
if(merton==1)
{
z1 = Complex( 0.5*m0-0.5*v*v*(k*k-0.25) , -k*(m0+0.5*v*v) );
z1 = Cexp(z1);
z2 = Complex(0.5,-k);
z2 = RCmul( exp(m0+0.5*v*v) - 1. , z2);
z2 = Cadd( Complex(1.,0.) , z2 );
Lambdak = Csub(z1,z2);
Ck = Complex(0.,0.);
Dk = RCmul(tau,Lambdak);
}
else
{
Ck = Complex(0.,0.);
Dk = Complex(0.,0.);
}
ans = Cadd( Ak , RCmul(V0,Bk) );
ans = Cadd( ans , Ck );
ans = Cadd( ans , RCmul(lambda0,Dk) );
ans = Cadd( ans , RCmul(X,Complex(0.5,-k) ) );
ans = Cexp(ans);
ans = Cdiv(ans,Complex(k*k+0.25,0.));
if(probadelta == 1)
{
ans = Cmul( ans , Complex(0.5,-k) );
ans = RCmul( 1./S , ans );
}
return ans.r;
}
