void rk4(double y[], double dydx[], int n, double x, double h, double yout[],
void (*derivs)(double, double [], double []))
{
int i;
double xh,hh,h6,*dym,*dyt,*yt;
dym=dvector(1,n);
dyt=dvector(1,n);
yt=dvector(1,n);
hh=h*0.5;
h6=h/6.0;
xh=x+hh;
for (i=1;i<=n;i++) yt[i]=y[i]+hh*dydx[i];
(*derivs)(xh,yt,dyt);
for (i=1;i<=n;i++) yt[i]=y[i]+hh*dyt[i];
(*derivs)(xh,yt,dym);
for (i=1;i<=n;i++) {
yt[i]=y[i]+h*dym[i];
dym[i] += dyt[i];
}
(*derivs)(x+h,yt,dyt);
for (i=1;i<=n;i++)
yout[i]=y[i]+h6*(dydx[i]+dyt[i]+2.0*dym[i]);
free_dvector(yt,1,n);
free_dvector(dyt,1,n);
free_dvector(dym,1,n);
}
/* Routine to predict position and uncertainty at any time, given
* a PBASIS fit and a sigma matrix.
*/
double
predict_posn(PBASIS *pin,
double **covar,
OBSERVATION *obs,
double **sigxy) /*this holds xy error matrix*/
{
int i,j,t;
double *dx,*dy, distance;
dx=dvector(1,6);
dy=dvector(1,6);
/*using input time & obscode, put xy position into OBSERVATION struct*/
distance = kbo2d(pin,obs,
&(obs->thetax),dx,&(obs->thetay),dy);
/* project the covariance matrix */
/* skip if not desired */
if (sigxy!=NULL && covar!=NULL) {
sigxy[1][1]=sigxy[1][2]=sigxy[2][2]=0;
for (i=1; i<=6; i++) {
for (j=1; j<=6; j++) {
sigxy[1][1] += dx[i]*covar[i][j]*dx[j];
sigxy[1][2] += dx[i]*covar[i][j]*dy[j];
sigxy[2][2] += dy[i]*covar[i][j]*dy[j];
}
}
sigxy[2][1]=sigxy[1][2];
}
free_dvector(dx,1,6);
free_dvector(dy,1,6);
return distance;
}
void linmin(double p[], double xi[], int n, double *fret, double (*func)(double []))
{
double brent(double ax, double bx, double cx,
double (*f)(double), double tol, double *xmin);
double f1dim(double x);
void mnbrak(double *ax, double *bx, double *cx, double *fa, double *fb,
double *fc, double (*func)(double));
int j;
double xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom=dvector(1,n);
xicom=dvector(1,n);
nrfunc=func;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin);
for (j=1;j<=n;j++) {
xi[j] *= xmin;
p[j] += xi[j];
}
free_dvector(xicom,1,n);
free_dvector(pcom,1,n);
}
int main(void)
{
int j,k,n;
float resid;
double b,d,fac,x,*c,*cc;
c=dvector(0,NMAX);
cc=dvector(0,NMAX);
for (;;) {
printf("Enter n for PADE routine:\n");
if (scanf("%d",&n) == EOF) break;
fac=1;
for (j=1;j<=2*n+1;j++) {
c[j-1]=fac/((double) j);
cc[j-1]=c[j-1];
fac = -fac;
}
pade(c,n,&resid);
printf("Norm of residual vector= %16.8e\n",resid);
printf("point, func. value, pade series, power series\n");
for (j=1;j<=21;j++) {
x=(j-1)*0.25;
for (b=0.0,k=2*n+1;k>=1;k--) {
b *= x;
b += cc[k-1];
}
d=ratval(x,c,n,n);
printf("%16.8f %16.8f %16.8f %16.8f\n",x,fn(x),d,b);
}
}
free_dvector(cc,0,NMAX);
free_dvector(c,0,NMAX);
return 0;
}
/* print the statistics about this floorplan.
* note that connects_file is NULL if wire
* information is already populated
*/
void print_flp_stats(flp_t *flp, RC_model_t *model,
char *l2_label, char *power_file,
char *connects_file)
{
double core, total, occupied; /* area */
double width, height, aspect, total_w, total_h;
double wire_metric;
double peak, avg; /* temperature */
double *power, *temp;
FILE *fp = NULL;
char str[STR_SIZE];
if (connects_file) {
fp = fopen(connects_file, "r");
if (!fp) {
sprintf(str, "error opening file %s\n", connects_file);
fatal(str);
}
flp_populate_connects(flp, fp);
}
power = hotspot_vector(model);
temp = hotspot_vector(model);
read_power(model, power, power_file);
core = get_core_area(flp, l2_label);
total = get_total_area(flp);
total_w = get_total_width(flp);
total_h = get_total_height(flp);
occupied = get_core_occupied_area(flp, l2_label);
width = get_core_width(flp, l2_label);
height = get_core_height(flp, l2_label);
aspect = (height > width) ? (height/width) : (width/height);
wire_metric = get_wire_metric(flp);
populate_R_model(model, flp);
steady_state_temp(model, power, temp);
peak = find_max_temp(model, temp);
avg = find_avg_temp(model, temp);
fprintf(stdout, "printing summary statistics about the floorplan\n");
fprintf(stdout, "total area:\t%g\n", total);
fprintf(stdout, "total width:\t%g\n", total_w);
fprintf(stdout, "total height:\t%g\n", total_h);
fprintf(stdout, "core area:\t%g\n", core);
fprintf(stdout, "occupied area:\t%g\n", occupied);
fprintf(stdout, "area utilization:\t%.3f\n", occupied / core * 100.0);
fprintf(stdout, "core width:\t%g\n", width);
fprintf(stdout, "core height:\t%g\n", height);
fprintf(stdout, "core aspect ratio:\t%.3f\n", aspect);
fprintf(stdout, "wire length metric:\t%.3f\n", wire_metric);
fprintf(stdout, "peak temperature:\t%.3f\n", peak);
fprintf(stdout, "avg temperature:\t%.3f\n", avg);
free_dvector(power);
free_dvector(temp);
if (fp)
fclose(fp);
}
void solve_chain(int nn,double *hh,double *jj,double y,double *hloc,double *hhext){
int iter;
double *uu,*vv,*mag,magtot,hext,epsilon=.0001; /* uu are the messages to the right, vv those to the left.
hext is the external magnetic field adapted to impose the
global constraint on the magnetization
*/
double hmax,hmin;
uu=dvector(1,nn); vv=dvector(1,nn); mag=dvector(1,nn);
if(fabs(y)>nn){printf("DESASTRE\n");exit(2);}
hext=0;
magtot=mag_chain(nn,hh,uu,vv,mag,jj,hloc,hext,epsilon);
if(magtot<y){
hmin=0;
hext=8.;
while(y-mag_chain(nn,hh,uu,vv,mag,jj,hloc,hext,epsilon)>epsilon){
hmin=hext;
hext=hext*2.;
if(hext>100000000) {printf("hext>100000000\n"); exit(2);}
}
hmax=hext;
}
else {
hmax=0;
hext=-8.;
while(mag_chain(nn,hh,uu,vv,mag,jj,hloc,hext,epsilon)-y>epsilon){
hmax=hext;
hext=hext*2.;
if(hext<-10000000000) {printf("hext<-10000000\n"); exit(2);}
}
hmin=hext;
}
magtot=2.*nn;
iter=0;
//hmax=4;
//hmin=-4;
while(fabs(magtot-y)>epsilon){
//while(hmax-hmin>epsilon){
iter++;
hext=.5*(hmax+hmin);
magtot=mag_chain(nn,hh,uu,vv,mag,jj,hloc,hext,epsilon);
if(magtot<y)hmin=hext;
else hmax=hext;
if(iter>200) {
printf("Unsolved after %i iterations, %i %f %f %f\n",iter, nn, y, magtot,hext);
return;
}
}
if(verbose>3){
printf("Chain nn=%i solved after niter=%i hext=%f magtot=%f y=%f mag and hloc:\n",nn,iter,hext,magtot,y);
}
*hhext=hext;
free_dvector(uu,1,nn); free_dvector(vv,1,nn); free_dvector(mag,1,nn);
return;
}
void poly_interp( double *xa, double *ya, int n, double x, double *y, double *dy ) {
int i, m, ns = 1;
double den, dif, dift, ho, hp, w;
double *c, *d;
c = dvector( 1, n );
d = dvector( 1, n );
dif = fabs(x - xa[1]);
/*
* Here we find the index of the closest table entry,
*/
for ( i = 1; i <= n; ++i ) {
if ( ( dift = fabs(x - xa[i]) ) < dif ) {
ns = i;
dif = dift;
}
/*
* And initialize the tableau of c's and d's.
*/
d[i] = c[i] = ya[i];
}
/*
* This is the initial approximation to y.
*/
*y = ya[ns--];
/*
* For each column of the tableau, loop over the current c's and d's and update them.
*/
for ( m = 1; m < n; ++m ) {
for ( i = 1; i <= n-m; ++i ) {
ho = xa[i] - x;
hp = xa[i+m] - x;
w = c[i+1] - d[i];
/*
* This error can occur if two input xa's are identical within roundoff error.
*/
if ( ( den = ho - hp ) == 0.0 ) nrerror( "Error in routine poly_interp." );
den = w/den;
/*
* Here, the c's and d's are updated.
*/
d[i] = hp*den;
c[i] = ho*den;
}
*y += ( *dy = ( 2*ns < (n - m) ? c[ns + 1] : d[ns--] ) );
}
free_dvector( d, 1, n );
free_dvector( c, 1, n );
return;
}
double GelmanRubin(double *vec, int numchains, int totrep)
/*
* Function GelmanRubin is used to calculate the the Gelman_Rubin statistics
* Based on an ANOVA idea for a single variable
* Asumme m chains, each of length n
* Can estimate the variance of a stationary distribution in two ways
* Ðvariance within a single chain, W
* Ðvariance over all chains, B/n
* If the chains have converged, both estimates are unbiased, i.e. B=W
* If the initial values are overdispersed and have not dispersed, then the Between term is an overestimate
* The statistic: R = B/W
* If R>1, it have not converged, we estimate R by (m+1)/m*((n-1)/n+B/W)-(n-1)/mn
*/
{
double *psii, psi, *S, W, B, V;
int i, j, repperchain;
psii = dvector(0,numchains-1);
S = dvector(0,numchains-1);
repperchain = totrep/numchains;
psi=0;
for (i=0; i<numchains; i++)
{
psii[i]=0;
for (j=0; j<repperchain; j++)
psii[i]+=vec[i*repperchain+j];
psii[i]=psii[i]/repperchain;
psi=psi+psii[i];
}
psi=psi/numchains;
W = 0;
for (i=0; i<numchains; i++)
{
S[i]=0;
for (j=0; j<repperchain; j++)
S[i]+=(vec[i*repperchain+j]-psii[i])*(vec[i*repperchain+j]-psii[i]);
S[i]=S[i]/(repperchain-1);
W+=S[i];
}
W=W/numchains;
B=0;
for (i=0; i<numchains; i++)
B+=(psii[i]-psi)*(psii[i]-psi);
B=(B*repperchain)/(numchains-1);
V=(W*(repperchain-1))/repperchain+B/repperchain;
// printf("B: %f. W: %f (%f %f)\n",B,W,(W*(repperchain-1))/repperchain,B/repperchain);
free_dvector(psii,0,numchains-1);
free_dvector(S,0,numchains-1);
return V/W;
}
double regularization_path(problem *prob, double epsilon, int nval)
{
int nr_folds = 5;
double llog, error, best_error = DBL_MAX, lambda, best_lambda;
double lmax, lmin, lstep;
double *y_hat = dvector(1, prob->n);
double *w = dvector(1, prob->dim);
/* compute maximum lambda for which all weights are 0 (Osborne et al. 1999)
* lambda_max = ||X'y||_inf. According to scikit-learn source code, you can
* divide by npatterns and it still works */
dmvtransmult(prob->X, prob->n, prob->dim, prob->y, prob->n, w);
lmax = dvnorm(w, prob->dim, INF) / prob->n;
lmin = epsilon*lmax;
lstep = (log2(lmax)-log2(lmin))/nval;
fprintf(stdout, "lmax=%g lmin=%g epsilon=%g nval=%d\n",
lmax, lmin, epsilon, nval);
/* warm-starts: weights are set to 0 only at the begining */
dvset(w, prob->dim, 0);
for(llog=log2(lmax); llog >= log2(lmin); llog -= lstep)
{
lambda = pow(2, llog);
/*cross_validation(prob, w, lambda, 0, nr_folds, y_hat);*/
/*******************************************************/
int iter = 1000; double tol = 0, fret;
fista(prob, w, lambda, 0, tol, 0, &iter, &fret);
fista_predict(prob, w, y_hat);
/*******************************************************/
error = mae(prob->y, prob->n, y_hat);
fprintf(stdout, " lambda %10.6lf MAE %7.6lf active weights %d/%d\n",
lambda, error, dvnotzero(w, prob->dim), prob->dim);
dvprint(stdout, w, prob->dim);
if (error < best_error)
{
best_error = error;
best_lambda = lambda;
}
}
free_dvector(y_hat, 1, prob->n);
free_dvector(w, 1, prob->dim);
print_line(60);
fprintf(stdout, "\nBest: lambda=%g MAE=%g active weights=%d/%d\n",
best_lambda, best_error, dvnotzero(w, prob->dim), prob->dim);
return best_lambda;
}
main()
{
/* test program for above utility routines */
double **a, **b, **c, **bT;
double *x, *y, *z;
FILE *infile, *outfile;
int a_rows, a_cols, b_rows, b_cols, errors, xn, yn;
infile = fopen("mat.in", "r");
outfile = fopen("mat.dat", "w");
a = dReadMatrix( infile, &a_rows, &a_cols, &errors);
b = dReadMatrix( infile, &b_rows, &b_cols, &errors);
x = dReadVector( infile, &xn, &errors);
y = dReadVector( infile, &yn, &errors);
getchar();
dmdump( stdout, "Matrix A", a, a_rows, a_cols, "%8.2lf");
dmdump( stdout, "Matrix B", b, b_rows, b_cols, "%8.2lf");
dvdump( stdout, "Vector x", x, xn, "%8.2lf");
dvdump( stdout, "Vector y", y, yn, "%8.2lf");
z = dvector( 1, xn );
dvadd( x, xn, y, z );
dvdump( stdout, "x + y", z, xn, "%8.2lf");
dvsub( x, xn, y, z );
dvdump( stdout, "x - y", z, xn, "%8.2lf");
dvsmy( x, xn, 2.0, z );
dvdump( stdout, "2x", z, xn, "%8.2lf");
printf("Magnitude of 2x: %7.2lf\n", dvmag( z, xn ));
printf("dot product x.y: %7.2lf\n", dvdot( x, xn, y));
dmvmult( a, a_rows, a_cols, x, xn, z );
dvdump( stdout, "Ax", z, xn, "%8.2lf");
c = dmatrix( 1, a_rows, 1, b_cols );
bT = dmatrix( 1, b_cols, 1, b_rows );
dmtranspose( b, b_rows, b_cols, bT);
dmdump( stdout, "Matrix B (transposed)", bT, b_cols, b_rows, "%8.2lf");
dmmult( a, a_rows, a_cols, bT, b_cols, b_rows, c);
dmdump( stdout, "Matrix AB", c, a_rows, b_rows, "%8.2lf");
/* dmfillUT( a, a_rows, a_cols );
dmdump( stdout, "Symmetrified matrix A", a, a_rows, a_cols, "%8.2lf"); */
free_dmatrix( a, 1, a_rows, 1, a_cols);
free_dmatrix( b, 1, b_rows, 1, b_cols);
free_dmatrix( c, 1, a_rows, 1, b_cols);
free_dvector( x, 1, xn );
free_dvector( y, 1, yn );
}
int
test(
int n, /* Dimensionality */
double **a, /* A[][] input matrix, returns LU decimposition of A */
double *b /* B[] input array, returns solution X[] */
) {
int i, j;
double rip; /* Row interchange parity */
int *pivx;
int rv = 0;
double **sa; /* save input matrix values */
double *sb; /* save input vector values */
pivx = ivector(0, n-1);
sa = dmatrix(0, n-1, 0, n-1);
sb = dvector(0, n-1);
/* Copy input matrix and vector values */
for (i = 0; i < n; i++) {
sb[i] = b[i];
for (j = 0; j < n; j++)
sa[i][j] = a[i][j];
}
if (lu_decomp(a, n, pivx, &rip)) {
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
free_ivector(pivx, 0, n-1);
return 1;
}
lu_backsub(a, n, pivx, b);
/* Check that the solution is correct */
for (i = 0; i < n; i++) {
double sum, temp;
sum = 0.0;
for (j = 0; j < n; j++)
sum += sa[i][j] * b[j];
//printf("~~ check %d = %f, against %f\n",i,sum,sb[i]);
temp = fabs(sum - sb[i]);
if (temp > 1e-6)
rv = 2;
}
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
free_ivector(pivx, 0, n-1);
return rv;
}
/*
* Given arrays xa[1..n] and ya[1..n], and given a value x, this routine returns
* a value of y and an accuracy estimate dy. The value returned is that of the
* diagonal rational function, evaluated at x, which passes through the
* n points (xa[i], ya[i]), i = 1..n.
*/
void rat_interp( double *xa, double *ya, int n, double x, double *y, double *dy ) {
int m, i, ns = 1;
double w, t, hh, h, dd, *c, *d;
const double TINY = 1.0e-25;
c = dvector( 1, n );
d = dvector( 1, n );
hh = fabs( x - xa[1] );
for ( i = 1; i <= n; ++i ) {
h = fabs( x - xa[i] );
if ( h == 0.0 ) {
*y = ya[i];
*dy = 0.0;
free_dvector( d, 1, n );
free_dvector( c, 1, n );
return;
} else if ( h < hh ) {
ns = i;
hh = h;
}
c[i] = ya[i];
/*
* The tiny part is needed to prevent a rare zero over zero condition.
*/
d[i] = ya[i] + TINY;
}
*y = ya[ns--];
for ( m = 1; m < n; ++m ) {
for ( i = 1; i <= n-m; ++i ) {
w = c[i+1] - d[i];
h = xa[i+m] - x;
t = ( xa[i] - x )*d[i]/h;
dd = t - c[i+1];
/*
* This error condition indicated that the interpolating function has a pole
* at the requested value of x.
*/
if ( dd == 0.0 ) nrerror( "Error in routine rat_interp." );
dd = w/dd;
d[i] = c[i+1]*dd;
c[i] = t*dd;
}
*y += ( *dy = ( 2*ns < (n-m) ? c[ns+1] : d[ns--] ) );
}
free_dvector( d, 1, n );
free_dvector( c, 1, n );
return;
}
/**********************************************
KOU DE MODEL FOR
DISCRETE ASIAN OPTIONS
**********************************************/
double Asian_DE_FusaiMeucci(double spot,
double strike,
double maturity,
double rf,
double dividend,
double sgDE, double lambdaDE, double pDE, double eta1DE, double eta2DE,
int nmonitoringdates,
double lowlim,
double uplim,
int nquadpoints, //n. of quadrature points
long nfft,
double price[],
double solution[],double *delta) //OUTPUT: Contains the solution
{
double asiade;
double dt=maturity/(nmonitoringdates);
double *DEParameters;
int maxnummoments=10;
double lowfactor=10;
double upfactor=10;
double *extremes;
// double *solution;
DEParameters=dvector(1, 5);
DEParameters[1]=sgDE;
DEParameters[2]=lambdaDE;
DEParameters[3]=pDE;
DEParameters[4]=eta1DE;
DEParameters[5]=eta2DE;
extremes=dvector(1, 2);
findlowuplimit(6, rf, dt, maxnummoments,
nmonitoringdates, lowfactor, upfactor,
DEParameters, extremes);
asiade=DiscreteAsian(6, spot, strike, rf, dt,
nmonitoringdates, extremes[1], extremes[2],
nquadpoints, nfft, //n. of points for the fft inversion
DEParameters, //the parameters of the model
price,
solution,delta);
free_dvector(extremes,1,2);
free_dvector(DEParameters,1,5);
return asiade;
}
/**********************************************
MERTON MODEL FOR
DISCRETE ASIAN OPTIONS
**********************************************/
double Asian_MERTON_FusaiMeucci(double spot,
double strike,
double maturity,
double rf,
double dividend,
double sgMerton, double alphaMerton, double lambdaMerton, double deltaMerton,
int nmonitoringdates,
double lowlim,
double uplim,
int nquadpoints, //n. of quadrature points
long nfft,
double price[],
double solution[],double *delta) //OUTPUT: Contains the solution
{
double asiamerton;
double dt=maturity/(nmonitoringdates);
double *MertonParameters;
int maxnummoments=10;
double lowfactor=10;
double upfactor=10;
double *extremes;
// double *solution;
MertonParameters=dvector(1, 4);
MertonParameters[1]=sgMerton;
MertonParameters[2]=alphaMerton;
MertonParameters[3]=lambdaMerton;
MertonParameters[4]=deltaMerton;
extremes=dvector(1, 2);
findlowuplimit(7, rf, dt, maxnummoments,
nmonitoringdates, lowfactor, upfactor,
MertonParameters, extremes);
asiamerton=DiscreteAsian(7, spot, strike, rf, dt,
nmonitoringdates, extremes[1], extremes[2],
nquadpoints, nfft, //n. of points for the fft inversion
MertonParameters, //the parameters of the model
price,
solution,delta);
free_dvector(extremes,1,2);
free_dvector(MertonParameters,1,4);
return asiamerton;
}
/**********************************************
NIG MODEL FOR
DISCRETE ASIAN OPTIONS
**********************************************/
double Asian_NIG_FusaiMeucci(double spot,
double strike,
double maturity,
double rf,
double dividend,
double alphaNIG, double betaNIG,double deltaNIG,
int nmonitoringdates,
double lowlim,
double uplim,
int nquadpoints, //n. of quadrature points
long nfft,
double price[],
double solution[],double *delta) //OUTPUT: Contains the solution
{
double asianig;
double dt=maturity/(nmonitoringdates);
double *NIGParameters;
int maxnummoments=10;
double lowfactor=10;
double upfactor=10;
double *extremes;
// double *solution;
NIGParameters=dvector(1, 3);
NIGParameters[1]=alphaNIG;
NIGParameters[2]=betaNIG;
NIGParameters[3]=deltaNIG;
extremes=dvector(1, 2);
findlowuplimit(2, rf, dt, maxnummoments,
nmonitoringdates, lowfactor, upfactor,
NIGParameters, extremes);
asianig=DiscreteAsian(2, spot, strike, rf, dt,
nmonitoringdates, extremes[1], extremes[2],
nquadpoints, nfft, //n. of points for the fft inversion
NIGParameters, //the parameters of the model
price,
solution,delta);
free_dvector(extremes,1,2);
free_dvector(NIGParameters,1,3);
return asianig;
}
void free_convg(CONVG *cvg)
/*
* free space for the array "convg" which stores updates for assessing convergence
*/
{
free_dvector(cvg->convg_ld,0,(cvg->n_chain*cvg->ckrep)-1);
}
/*
* Given a, b, and c as output from chebyshev_fit, and given m, the desired degree of
* approximation, this routine returns the array d[0..m-1], of coefficients of a polynomial
* expansion which is equivalent to the Chebyshev fit.
*/
void chebyshev_2_poly( double a, double b, double *c, double *d, int m ) {
int j, k;
double sv, *dd;
dd = dvector( 0, m-1 );
for ( j = 0; j < m; ++j ) d[j] = dd[j] = 0.0;
d[0] = c[m-1];
for ( j = m-2; j >= 1; --j ) {
for ( k = m-j; k >= 1; --k ) {
sv = d[k];
d[k] = 2.0*d[k-1] - dd[k];
dd[k] = sv;
}
sv = d[0];
d[0] = -dd[0] + c[j];
dd[0] = sv;
}
for ( j = m-1; j >= 1; --j ) d[j] = d[j-1] - dd[j];
d[0] = -dd[0] + 0.5*c[0];
free_dvector( dd, 0, m-1 );
/*
* Map the interval [-1,+1] to [a,b].
*/
poly_shift_coeff( a, b, d, m );
}
int main(int argc, char** argv) {
int n, dim;
double **a;
double *b;
if (argc < 2) {
fprintf(stderr, "Usage: %s n\n", argv[0]);
exit(1);
}
n = atoi(argv[1]);
dim = matrix_dimension(n);
a = alloc_dmatrix(dim, dim);
generate_dense(n, 1.0/n, a);
b = alloc_dvector(dim);
generate_rhs(n, 1.0/n, b);
printf("Matrix A:\n");
fprint_dmatrix(stdout, dim, dim, a);
printf("Vector B (transposed):\n");
fprint_dvector(stdout, dim, b);
free_dmatrix(a);
free_dvector(b);
}
NUMERICS_EXPORT BOOL inverse(double **a, int n)
{
double d;
int i, j;
BOOL ret = FALSE;
double** ai = dmatrix(0, n - 1, 0, n - 1);
double* col = dvector(0, n - 1);
int* indx = ivector(0, n - 1);
if(ludcmp(a, n, indx, &d)){
for(j = 0; j < n; j++){
for(i = 0; i < n; i++) col[i] = 0.0;
col[j] = 1.0;
lubksb(a, n, indx, col);
for(i = 0; i < n; i++) ai[i][j] = col[i];
}
for(i = 0; i < n; i++){
for(j = 0; j < n; j++){
a[i][j] = ai[i][j];
}
}
ret = TRUE;
}
free_dmatrix(ai, 0, n - 1, 0);
free_dvector(col, 0);
free_ivector(indx, 0);
return ret;
}
void Matrix_Inverse( double **invMat, double **Mat, int nn)
{
int i, j;
double ger;
int *p= ivector( 1, nn);
double **LU = dmatrix( 1, nn, 1, nn);
for( i=0; i<=nn-1; i++)
for( j=0; j<=nn-1; j++)
LU[i+1][j+1] = Mat[i][j];
double *col = dvector( 1, nn);
ludcmp( LU, nn, p, &ger);
for( j=1; j<=nn; j++) {
for( i=1; i<=nn; i++) col[i] = 0.0;
col[j] = 1.0;
lubksb( LU, nn, p, col );
for( i=1; i<=nn; i++) invMat[i-1][j-1] = (double) col[i];
};
free_dvector( col, 1, nn);
free_ivector( p, 1, nn);
free_dmatrix( LU, 1, nn, 1, nn);
}
void vander(double x[], double w[], double q[], int n)
{
int i,j,k,k1;
double b,s,t,xx;
double *c;
c=dvector(1,n);
if (n == 1) w[1]=q[1];
else {
for (i=1;i<=n;i++) c[i]=0.0;
c[n] = -x[1];
for (i=2;i<=n;i++) {
xx = -x[i];
for (j=(n+1-i);j<=(n-1);j++) c[j] += xx*c[j+1];
c[n] += xx;
}
for (i=1;i<=n;i++) {
xx=x[i];
t=b=1.0;
s=q[n];
k=n;
for (j=2;j<=n;j++) {
k1=k-1;
b=c[k]+xx*b;
s += q[k1]*b;
t=xx*t+b;
k=k1;
}
w[i]=s/t;
}
}
free_dvector(c,1,n);
}
int Discount_Factors_opt(FTYPE *pdDiscountFactors,
int iN,
FTYPE dYears,
FTYPE *pdRatePath)
{
int i,j; //looping variables
int iSuccess; //return variable
FTYPE ddelt; //HJM time-step length
ddelt = (FTYPE) (dYears/iN);
FTYPE *pdexpRes;
pdexpRes = dvector(0,iN-2);
//initializing the discount factor vector
for (i=0; i<=iN-1; ++i)
pdDiscountFactors[i] = 1.0;
//precompute the exponientials
for (j=0; j<=(i-2); ++j){ pdexpRes[j] = -pdRatePath[j]*ddelt; }
for (j=0; j<=(i-2); ++j){ pdexpRes[j] = exp(pdexpRes[j]); }
for (i=1; i<=iN-1; ++i)
for (j=0; j<=i-1; ++j)
pdDiscountFactors[i] *= pdexpRes[j];
free_dvector(pdexpRes, 0, iN-2);
iSuccess = 1;
return iSuccess;
}
void pzextr(int iest, double xest, double yest[], double yz[], double dy[], int nv)
{
int k1,j;
double q,f2,f1,delta,*c;
c=dvector(1,nv);
x[iest]=xest;
for (j=1;j<=nv;j++) dy[j]=yz[j]=yest[j];
if (iest == 1) {
for (j=1;j<=nv;j++) d[j][1]=yest[j];
} else {
for (j=1;j<=nv;j++) c[j]=yest[j];
for (k1=1;k1<iest;k1++) {
delta=1.0/(x[iest-k1]-xest);
f1=xest*delta;
f2=x[iest-k1]*delta;
for (j=1;j<=nv;j++) {
q=d[j][k1];
d[j][k1]=dy[j];
delta=c[j]-q;
dy[j]=f1*delta;
c[j]=f2*delta;
yz[j] += dy[j];
}
}
for (j=1;j<=nv;j++) d[j][iest]=dy[j];
}
free_dvector(c,1,nv);
}
/* Invert a double matrix, 1-indexed of size dim
* from Numerical Recipes. Input matrix is destroyed.
*/
int
invert_matrix(double **in, double **out,
int dim)
{
extern void ludcmp(double **a, int n, int *indx, double *d);
extern void ludcmp(double **a, int n, int *indx, double *d);
int *indx,i,j;
double *tvec,det;
tvec = dvector(1,dim);
indx = ivector(1,dim);
ludcmp(in,dim,indx,&det);
for (j=1; j<=dim; j++) {
for (i=1; i<=dim; i++) tvec[i]=0.;
tvec[j] = 1.0;
lubksb(in,dim,indx,tvec);
for (i=1; i<=dim; i++) out[i][j]=tvec[i];
}
free_ivector(indx,1,6);
free_dvector(tvec,1,6);
return(0);
}
/* compute the slope vector dy for the transient equation
* dy + cy = p. useful in the transient solver
*/
void slope_fn_block(block_model_t *model, double *y, double *p, double *dy)
{
/* shortcuts */
int n = model->n_nodes;
double **c = model->c;
/* for our equation, dy = p - cy */
#if (MATHACCEL == MA_INTEL || MATHACCEL == MA_APPLE)
/* dy = p */
cblas_dcopy(n, p, 1, dy, 1);
/* dy = dy - c*y = p - c*y */
cblas_dgemv(CblasRowMajor, CblasNoTrans, n, n, -1, c[0],
n, y, 1, 1, dy, 1);
#elif (MATHACCEL == MA_AMD || MATHACCEL == MA_SUN)
/* dy = p */
dcopy(n, p, 1, dy, 1);
/* dy = dy - c*y = p - c*y */
dgemv('T', n, n, -1, c[0], n, y, 1, 1, dy, 1);
#else
int i;
double *t = dvector(n);
matvectmult(t, c, y, n);
for (i = 0; i < n; i++)
dy[i] = p[i]-t[i];
free_dvector(t);
#endif
}
void svbksb(double **u, double *w, double **v, int m, int n, double *b, double *x)
{
int jj,j,i;
double s,*tmp,*dvector();
void free_dvector();
tmp=dvector(1,n);
for (j=1;j<=n;j++)
{ /* calculate U(transpose)B */
s=0.0;
if (w[j])
{
for (i=1;i<=m;i++) s += u[i][j]*b[i];
s /= w[j];
}
tmp[j]=s;
}
for (j=1;j<=n;j++)
{
s=0.0;
for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj];
x[j]=s;
}
free_dvector(tmp,1,n);
}
/*
* Given arrays xa[1..n] and ya[1..n], and given a value x,
* this routine returns a value y and an error estimate dy.
* If P(x) is the polynomial of degree N-1 such that
* P(xa_i) = ya_i, i = 1,...,n, then the returned value
* y = P(x).
*/
void dpolint(double xa[], double ya[], int n, double x, double *y, double *dy)
{
int i,m,ns=1;
double den,dif,dift,ho,hp,w;
double *c,*d;
dif=fabs(x-xa[1]);
c=dvector(1,n);
d=dvector(1,n);
for (i=1;i<=n;i++) { /* Here we find the index ns of the closest
table entry, */
if ( (dift=fabs(x-xa[i])) < dif) {
ns=i;
dif=dift;
}
c[i]=ya[i]; /* and initialize the tableau of c's and d's. */
d[i]=ya[i];
}
*y=ya[ns--]; /* This is the initial approximation to y. */
for (m=1;m<n;m++) { /* For each column of the tableau, */
for (i=1;i<=n-m;i++) { /* we loop over the current c's and d's and
update them. */
ho=xa[i]-x;
hp=xa[i+m]-x;
w=c[i+1]-d[i];
/* This error can occur only if two input xa's are (to
within roundoff) identical. */
if ( (den=ho-hp) == 0.0) nrerror("Error in routine polint");
den=w/den;
d[i]=hp*den; /* Here the c's and d's are updated. */
c[i]=ho*den;
}
*y += (*dy=(2*ns < (n-m) ? c[ns+1] : d[ns--]));
/*
* After each column in the tableau is completed, we decide which
* correction, c or d, we want to add to our accumulating value of y,
* i.e., which path to take through the tableau - forking up or down.
* We do this in such a way as to take the most "straight line"
* route through the tableau to its apex, updating ns accordingly to
* keep track of where we are. This route keeps the partial
* approximations centered (insofar as possible) on the target x.
* The last dy added is thus the error indication.
*/
}
free_dvector(d,1,n);
free_dvector(c,1,n);
}
static void getdistl(
double *d,
unsigned int nstart,
double stime[],
double sstart[],
double send[],
double cost
)
{
double *tli, *tlj;
double dist;
unsigned int i,j,itli,itlj;
unsigned int nspi,nspj;
double junk;
for (i=0; i<nstart; i++) {
nspi=(int)(send[i]-sstart[i]+1);
if (nspi>0) {
tli=dvector(0,nspi-1);
for (itli=0; itli<nspi; itli++) {
tli[itli]=stime[itli+(int)sstart[i]-1];
/*printf("\n%d %f",itli,tli[itli]);*/
}
}
for (j=i+1; j<nstart; j++) {
nspj=(int)(send[j]-sstart[j]+1);
/*printf("\nnspi=%d\tnspj=%d",nspi,nspj);*/
if (nspi>0 && nspj>0) {
tlj=dvector(0,nspj-1);
for (itlj=0; itlj<nspj; itlj++) {
tlj[itlj]=stime[itlj+(int)sstart[j]-1];
/*printf("\n%d %f",itlj,tlj[itlj]);*/
}
getdist(&dist,nspi,tli,nspj,tlj,cost);
/*printf("\t%f",dist);*/
free_dvector(tlj,0,nspj-1);
}
if (nspi==0 && nspj>0) dist=nspj;
else if (nspj==0 && nspi>0) dist=nspi;
else if (nspj==0 && nspi==0) dist=0;
/*printf("\n%d %d %d %f",i,j,i*nstart+j,dist);*/
d[i*nstart+j]=d[j*nstart+i]=dist;
}
if (nspi>0) free_dvector(tli,0,nspi-1);
}
return;
}
void ludcmp (double **a, int n, int *indx, double *d)
{
int i, j, k, imax = 0;
double big, dum, sum, temp;
double *vv;
void free_dvector();
vv = dvector(1,n);
*d = 1.0;
for (i=1; i<=n; i++) /* loop over rows to get the implicit scaling info*/
{
big = 0.0;
for (j=1; j<=n; j++)
if ((temp = fabs(a[i][j])) > big) big = temp;
if (big == 0.0) nrerror("Singular matrix in ludcmp");
vv[i] = 1.0/big; /* save the scaling*/
}
for (j=1; j<=n; j++) /* loop over columns of Crouts method(see Press) */
{
for (i=1; i<j; i++)
{
sum = a[i][j];
for (k=1; k<i; k++) sum -= a[i][k]*a[k][j];
a[i][j] = sum;
}
big = 0.0; /* init search for the largest pivot element */
for (i=j; i<=n; i++)
{
sum = a[i][j];
for (k=1; k<j; k++) sum -= a[i][k]*a[k][j];
a[i][j] = sum;
if ((dum = vv[i]*fabs(sum)) >= big) /* is the figure of merit */
{ /* for the pivot better */
big = dum; /* than the best so far */
imax = i;
}
}
if (j != imax) /* do we need interchange rows ? */
{
for (k=1; k<=n; k++) /* interchange rows */
{
dum = a[imax][k];
a[imax][k] = a[j][k];
a[j][k] = dum;
}
*d = -(*d); /* even/odd interchanges */
vv[imax] = vv[j]; /* interchange the scale factor */
}
indx[j] = imax;
if (a[j][j] == 0.0) a[j][j] = TINY;
/* if the pivot element is zero, the matrix is singular */
if ( j != n) /* now finally divide by the pivot element */
{
dum = 1.0/a[j][j];
for (i=j+1;i<=n; i++) a[i][j] *= dum;
}
} /* go back for the next column in the reduction */
free_dvector (vv,1,n);
}
/**********************************************
CGMY MODEL FOR
DISCRETE ASIAN OPTIONS
**********************************************/
double Asian_CGMY_FusaiMeucci(double spot,
double strike,
double maturity,
double rf,
double dividend,
double CCGMY, double GCGMY, double MCGMY, double YCGMY,
int nmonitoringdates,
double lowlim,
double uplim,
int nquadpoints, //n. of quadrature points
long nfft,
double price[],
double solution[],double *delta) //OUTPUT: Contains the solution
{
double asiacgmy;
double dt=maturity/(nmonitoringdates);
double *CGMYParameters;
int maxnummoments=10;
double lowfactor=10;
double upfactor=10;
double *extremes;
// double *solution;
CGMYParameters=dvector(1, 4);
CGMYParameters[1]=CCGMY; ///C
CGMYParameters[2]=GCGMY; ///G
CGMYParameters[3]=MCGMY; ///M
CGMYParameters[4]=YCGMY; ///Y
extremes=dvector(1, 2);
findlowuplimit(5, rf, dt, maxnummoments,
nmonitoringdates, lowfactor, upfactor,
CGMYParameters, extremes);
asiacgmy=DiscreteAsian(5, spot, strike, rf, dt,
nmonitoringdates, extremes[1], extremes[2],
nquadpoints, nfft, //n. of points for the fft inversion
CGMYParameters, //the parameters of the model
price,
solution,delta);
free_dvector(extremes,1,2);
free_dvector(CGMYParameters,1,4);
return asiacgmy;
}
