static VALUE rb_gsl_permutation_calloc(VALUE klass, VALUE nn)
{
gsl_permutation *p = NULL;
CHECK_FIXNUM(nn);
p = gsl_permutation_calloc(FIX2INT(nn));
return Data_Wrap_Struct(klass, 0, gsl_permutation_free, p);
}
static bool matrix_determinant(CMATRIX *m, COMPLEX_VALUE *det)
{
int sign = 0;
int size = WIDTH(m);
if (size != HEIGHT(m))
return TRUE;
gsl_permutation *p = gsl_permutation_calloc(size);
if (COMPLEX(m))
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, CMAT(m));
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
det->z = gsl_linalg_complex_LU_det(tmp, sign);
gsl_matrix_complex_free(tmp);
}
else
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, MAT(m));
gsl_linalg_LU_decomp(tmp, p, &sign);
det->x = gsl_linalg_LU_det(tmp, sign);
det->z.dat[1] = 0;
gsl_matrix_free(tmp);
}
gsl_permutation_free(p);
return FALSE;
}
static int
newton_alloc (void * vstate, size_t n)
{
newton_state_t * state = (newton_state_t *) vstate;
gsl_permutation * p;
gsl_matrix * m;
m = gsl_matrix_calloc (n,n);
if (m == 0)
{
GSL_ERROR ("failed to allocate space for lu", GSL_ENOMEM);
}
state->lu = m ;
p = gsl_permutation_calloc (n);
if (p == 0)
{
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for permutation", GSL_ENOMEM);
}
state->permutation = p ;
return GSL_SUCCESS;
}
static int
gnewton_alloc (void * vstate, size_t n)
{
gnewton_state_t * state = (gnewton_state_t *) vstate;
gsl_vector * d, * x_trial ;
gsl_permutation * p;
gsl_matrix * m;
m = gsl_matrix_calloc (n,n);
if (m == 0)
{
GSL_ERROR ("failed to allocate space for lu", GSL_ENOMEM);
}
state->lu = m ;
p = gsl_permutation_calloc (n);
if (p == 0)
{
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for permutation", GSL_ENOMEM);
}
state->permutation = p ;
d = gsl_vector_calloc (n);
if (d == 0)
{
gsl_permutation_free(p);
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for d", GSL_ENOMEM);
}
state->d = d;
x_trial = gsl_vector_calloc (n);
if (x_trial == 0)
{
gsl_vector_free(d);
gsl_permutation_free(p);
gsl_matrix_free(m);
GSL_ERROR ("failed to allocate space for x_trial", GSL_ENOMEM);
}
state->x_trial = x_trial;
return GSL_SUCCESS;
}
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray
*prhs[])
{
int i, j;
int N, Nperm;
int *d;
int subs[2];
double *ptr;
gsl_permutation *c;
if(nrhs != 1)
mexErrMsgTxt("1 input required");
if(nlhs != 1)
mexErrMsgTxt("Requires one output.");
if(mxGetM(prhs[0]) * mxGetN(prhs[0]) != 1)
mexErrMsgTxt("N must be scalar");
N = mxGetScalar(prhs[0]);
Nperm = (int) (gsl_sf_fact(N));
c = gsl_permutation_calloc (N);
gsl_permutation_init(c);
plhs[0] = mxCreateDoubleMatrix(Nperm, N, mxREAL);
ptr = mxGetPr(plhs[0]);
for(i = 0; i < Nperm; i++)
{
d = gsl_permutation_data(c);
for(j = 0; j < N; j++)
{
subs[0] = i;
subs[1] = j;
ptr[mxCalcSingleSubscript(plhs[0], 2, subs)] =
(double)d[j] + 1.;
}
gsl_permutation_next(c);
}
gsl_permutation_free(c);
}
void xmi_inverse_matrix(double x[3], double y[3], double z[3], double **inverseF) {
gsl_matrix *m = gsl_matrix_alloc(3,3);
gsl_matrix *inverse = gsl_matrix_alloc(3,3);
gsl_permutation *p = gsl_permutation_calloc(3);
int signum;
double *rv;
int i,j,k;
gsl_matrix_set(m,0,0, x[0]);
gsl_matrix_set(m,1,0, x[1]);
gsl_matrix_set(m,2,0, x[2]);
gsl_matrix_set(m,0,1, y[0]);
gsl_matrix_set(m,1,1, y[1]);
gsl_matrix_set(m,2,1, y[2]);
gsl_matrix_set(m,0,2, z[0]);
gsl_matrix_set(m,1,2, z[1]);
gsl_matrix_set(m,2,2, z[2]);
#if DEBUG == 2
fprintf(stdout,"input matrix\n");
gsl_matrix_fprintf(stdout,m , "%g");
#endif
//invert the sucker
gsl_linalg_LU_decomp(m,p,&signum);
gsl_linalg_LU_invert(m,p,inverse);
#if DEBUG == 2
fprintf(stdout,"inverted matrix\n");
gsl_matrix_fprintf(stdout,inverse , "%g");
#endif
gsl_matrix_transpose(inverse);
#if DEBUG == 2
fprintf(stdout,"transposed inverted matrix\n");
gsl_matrix_fprintf(stdout,inverse , "%g");
#endif
rv = (double *) malloc(9*sizeof(double));
k = 0;
for (i = 0 ; i < 3 ; i++)
for (j = 0 ; j < 3 ; j++)
rv[k++] = gsl_matrix_get(inverse, i,j);
gsl_matrix_free(m);
gsl_matrix_free(inverse);
gsl_permutation_free(p);
*inverseF = rv;
}
int matrix_inverse(long double **output,int row,int col,long double **input)
{
register int i,j;
gsl_matrix *m;
m=gsl_matrix_calloc (row,col);
for (i=0;i<row;i++)
{
for (j=0;j<col;j++)
{
gsl_matrix_set(m,i,j,input[i][j]);
}
}
gsl_matrix *inv;
gsl_permutation *p;
int *signum;
inv=gsl_matrix_calloc (row,col);
p=gsl_permutation_calloc(row);
signum=(int *)malloc( sizeof(int)*row);
gsl_linalg_LU_decomp(m,p,signum);
gsl_linalg_LU_invert(m,p,inv);
for (i=0;i<row;i++)
{
for (j=0;j<col;j++)
{
output[i][j]=(long double) gsl_matrix_get(inv,i,j);;
}
}
free(signum);
gsl_matrix_free (m);
gsl_matrix_free (inv);
gsl_permutation_free(p);
return OK;
}
void minima(double *array, int size, double *val, int *pos, int NMax)
{
size_t i=0, j=0, index=0;
gsl_vector *v = gsl_vector_calloc(size);
gsl_permutation *p = gsl_permutation_calloc(size);
for(i=0; i<size; i++)
gsl_vector_set(v, i, array[i]);
gsl_sort_vector_index(p, v);
for(j=0; j<NMax; j++)
{
index = gsl_permutation_get(p, j);
val[j] = array[index];
pos[j] = index;
}
}
static void *matrix_invert(void *m, bool complex)
{
int sign = 0;
int size = ((gsl_matrix *)m)->size1;
void *result;
if (size != ((gsl_matrix *)m)->size2)
return NULL;
gsl_permutation *p = gsl_permutation_calloc(size);
if (!complex)
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
result = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, (gsl_matrix *)m);
gsl_linalg_LU_decomp(tmp, p, &sign);
if (gsl_linalg_LU_invert(tmp, p, (gsl_matrix *)result) != GSL_SUCCESS)
{
gsl_matrix_free(result);
return NULL;
}
gsl_matrix_free(tmp);
}
else
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
result = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, (gsl_matrix_complex *)m);
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
if (gsl_linalg_complex_LU_invert(tmp, p, (gsl_matrix_complex *)result) != GSL_SUCCESS)
{
gsl_matrix_complex_free(result);
return NULL;
}
gsl_matrix_complex_free(tmp);
}
gsl_permutation_free(p);
return result;
}
static int
dnewton_alloc (void * vstate, size_t n)
{
dnewton_state_t * state = (dnewton_state_t *) vstate;
gsl_permutation * p;
gsl_matrix * m, * J;
m = gsl_matrix_calloc (n,n);
if (m == 0)
{
GSL_ERROR_VAL ("failed to allocate space for lu", GSL_ENOMEM, 0);
}
state->lu = m ;
p = gsl_permutation_calloc (n);
if (p == 0)
{
gsl_matrix_free(m);
GSL_ERROR_VAL ("failed to allocate space for permutation", GSL_ENOMEM, 0);
}
state->permutation = p ;
J = gsl_matrix_calloc (n,n);
if (J == 0)
{
gsl_permutation_free(p);
gsl_matrix_free(m);
GSL_ERROR_VAL ("failed to allocate space for d", GSL_ENOMEM, 0);
}
state->J = J;
return GSL_SUCCESS;
}
void maxima(double *array, int size, double *val, int *pos, int NMax)
{
INFO_MSG("Searching for func maxima...");
size_t i=0, j=0, index=0;
gsl_vector *v = gsl_vector_calloc(size);
gsl_permutation *p = gsl_permutation_calloc(size);
for(i=0; i<size; i++)
gsl_vector_set(v, i, array[i]);
gsl_sort_vector_index(p, v);
for(j=0; j<NMax; j++)
{
index = gsl_permutation_get(p, size-j-1);
val[j] = array[index];
pos[j] = index;
}
}
void xmi_determinant_matrix(double x[3], double y[3], double z[3]) {
gsl_matrix *m = gsl_matrix_alloc(3,3);
gsl_permutation *p = gsl_permutation_calloc(3);
int signum;
int i,j,k;
double det;
gsl_matrix_set(m,0,0, x[0]);
gsl_matrix_set(m,1,0, x[1]);
gsl_matrix_set(m,2,0, x[2]);
gsl_matrix_set(m,0,1, y[0]);
gsl_matrix_set(m,1,1, y[1]);
gsl_matrix_set(m,2,1, y[2]);
gsl_matrix_set(m,0,2, z[0]);
gsl_matrix_set(m,1,2, z[1]);
gsl_matrix_set(m,2,2, z[2]);
gsl_linalg_LU_decomp(m,p,&signum);
det=gsl_linalg_LU_det(m,signum);
fprintf(stdout,"Determinant is: %lf\n",det);
return;
}
Permutation::Permutation(size_t n, bool initVector)
{
if(initVector) permutation = gsl_permutation_calloc(n);
else permutation = gsl_permutation_alloc(n);
}
Permutation::Permutation(size_t n)
{
permutation = gsl_permutation_calloc(n);
}
int CalcRanksForReHo(float *IND, int idx, THD_3dim_dataset *T, int *NTIE,
int TDIM)
{
int m,mm;
int ISTIE = -1;
int LENTIE = 0;
float TIERANK;
int *toP=NULL; // to reset permuts
int *sorted=NULL; // hold sorted time course, assume has been turned into int
int val;
// GSL stuff
gsl_vector *Y = gsl_vector_calloc(TDIM); // will hold time points
gsl_permutation *P = gsl_permutation_calloc(TDIM); // will hold ranks
toP = (int *)calloc(TDIM,sizeof(int));
sorted = (int *)calloc(TDIM,sizeof(int));
if( (toP ==NULL) || (sorted ==NULL) ) {
fprintf(stderr, "\n\n MemAlloc failure.\n\n");
exit(122);
}
// define time series as gsl vector
for( m=0 ; m<TDIM ; m++)
gsl_vector_set(Y,m, THD_get_voxel(T,idx,m));
// perform permutation
val = gsl_sort_vector_index (P,Y);
// apply permut to get sorted array values
for( m=0 ; m<TDIM ; m++) {
sorted[m] = THD_get_voxel(T,idx,
gsl_permutation_get(P,m));
// information of where it was
toP[m]= (int) gsl_permutation_get(P,m);
// default: just convert perm ind to rank ind:
// series of rank vals
IND[gsl_permutation_get(P,m)]=m+1;
}
// ******** start tie rank adjustment *******
// find ties in sorted, record how many per time
// series, and fix in IND
for( m=1 ; m<TDIM ; m++)
if( (sorted[m]==sorted[m-1]) && LENTIE==0 ) {
ISTIE = m-1; //record where it starts
LENTIE = 2;
}
else if( (sorted[m]==sorted[m-1]) && LENTIE>0 ) {
LENTIE+= 1 ;
}
else if( (sorted[m]!=sorted[m-1]) && LENTIE>0 ) {
// end of tie: calc mean index
TIERANK = 1.0*ISTIE; // where tie started
TIERANK+= 0.5*(LENTIE-1); // make average rank
NTIE[idx]+= LENTIE*(LENTIE*LENTIE-1); // record
// record ave permut ind as rank ind
for( mm=0 ; mm<LENTIE ; mm++) {
IND[toP[ISTIE+mm]] = TIERANK+1;
}
ISTIE = -1; // reset, prob unnec
LENTIE = 0; // reset
} // ******* end of tie rank adjustment ***********
// FREE
gsl_vector_free(Y);
gsl_permutation_free(P);
free(toP);
free(sorted);
RETURN(1);
}
static int
lmder_alloc (void *vstate, size_t n, size_t p)
{
lmder_state_t *state = (lmder_state_t *) vstate;
gsl_matrix *r;
gsl_vector *tau, *diag, *qtf, *newton, *gradient, *x_trial, *f_trial,
*df, *sdiag, *rptdx, *w, *work1;
gsl_permutation *perm;
r = gsl_matrix_calloc (n, p);
if (r == 0)
{
GSL_ERROR ("failed to allocate space for r", GSL_ENOMEM);
}
state->r = r;
tau = gsl_vector_calloc (GSL_MIN(n, p));
if (tau == 0)
{
gsl_matrix_free (r);
GSL_ERROR ("failed to allocate space for tau", GSL_ENOMEM);
}
state->tau = tau;
diag = gsl_vector_calloc (p);
if (diag == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
GSL_ERROR ("failed to allocate space for diag", GSL_ENOMEM);
}
state->diag = diag;
qtf = gsl_vector_calloc (n);
if (qtf == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
GSL_ERROR ("failed to allocate space for qtf", GSL_ENOMEM);
}
state->qtf = qtf;
newton = gsl_vector_calloc (p);
if (newton == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
GSL_ERROR ("failed to allocate space for newton", GSL_ENOMEM);
}
state->newton = newton;
gradient = gsl_vector_calloc (p);
if (gradient == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
GSL_ERROR ("failed to allocate space for gradient", GSL_ENOMEM);
}
state->gradient = gradient;
x_trial = gsl_vector_calloc (p);
if (x_trial == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
GSL_ERROR ("failed to allocate space for x_trial", GSL_ENOMEM);
}
state->x_trial = x_trial;
f_trial = gsl_vector_calloc (n);
if (f_trial == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
GSL_ERROR ("failed to allocate space for f_trial", GSL_ENOMEM);
}
state->f_trial = f_trial;
df = gsl_vector_calloc (n);
if (df == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
GSL_ERROR ("failed to allocate space for df", GSL_ENOMEM);
}
state->df = df;
sdiag = gsl_vector_calloc (p);
if (sdiag == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
GSL_ERROR ("failed to allocate space for sdiag", GSL_ENOMEM);
}
state->sdiag = sdiag;
rptdx = gsl_vector_calloc (n);
if (rptdx == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
GSL_ERROR ("failed to allocate space for rptdx", GSL_ENOMEM);
}
state->rptdx = rptdx;
w = gsl_vector_calloc (n);
if (w == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
GSL_ERROR ("failed to allocate space for w", GSL_ENOMEM);
}
state->w = w;
work1 = gsl_vector_calloc (p);
if (work1 == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
gsl_vector_free (w);
GSL_ERROR ("failed to allocate space for work1", GSL_ENOMEM);
}
state->work1 = work1;
perm = gsl_permutation_calloc (p);
if (perm == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
gsl_vector_free (w);
gsl_vector_free (work1);
GSL_ERROR ("failed to allocate space for perm", GSL_ENOMEM);
}
state->perm = perm;
return GSL_SUCCESS;
}
void
make_spl(points_t * pts, spline_t * spl)
{
gsl_matrix *A;
gsl_permutation *p;
int signum;
double *x = pts->x;
double *y = pts->y;
double a = x[0];
double b = x[pts->n - 1];
int i, j, k;
int nb = pts->n - 3 > 10 ? 10 : pts->n - 3;
char *nbEnv= getenv( "APPROX_BASE_SIZE" );
if( nbEnv != NULL && atoi( nbEnv ) > 0 )
nb = atoi( nbEnv );
A = gsl_matrix_calloc(nb, nb+1);
p = gsl_permutation_calloc( nb );
#ifdef DEBUG
#define TESTBASE 500
{
FILE *tst = fopen("debug_base_plot.txt", "w");
double dx = (b - a) / (TESTBASE - 1);
for( j= 0; j < nb; j++ )
xfi( a, b, nb, j, tst );
for (i = 0; i < TESTBASE; i++) {
fprintf(tst, "%g", a + i * dx);
for (j = 0; j < nb; j++) {
fprintf(tst, " %g", fi (a, b, nb, j, a + i * dx));
fprintf(tst, " %g", dfi (a, b, nb, j, a + i * dx));
fprintf(tst, " %g", d2fi(a, b, nb, j, a + i * dx));
fprintf(tst, " %g", d3fi(a, b, nb, j, a + i * dx));
}
fprintf(tst, "\n");
}
fclose(tst);
}
#endif
for (j = 0; j < nb; j++) {
for (i = 0; i < nb; i++)
for (k = 0; k < pts->n; k++)
gsl_matrix_set(A, j, i, fi(a, b, nb, i, x[k]) * fi(a, b, nb, j, x[k]));
for (k = 0; k < pts->n; k++)
gsl_matrix_set(A, j, nb, y[k] * fi(a, b, nb, j, x[k]));
}
#ifdef DEBUG
write_matrix(A, stdout);
#endif
/*
if ( gsl_linalg_LU_decomp( A, p, &signum ) ){
spl->n = 0;
return;
}
*/
#ifdef DEBUG
write_matrix(A, stdout);
#endif
if (alloc_spl(spl, nb) == 0) {
for (i = 0; i < spl->n; i++) {
double xx = spl->x[i] = a + i*(b-a)/(spl->n-1);
xx+= 10.0*DBL_EPSILON; // zabezpieczenie przed ulokowaniem punktu w poprzednim przedziale
spl->f[i] = 0;
spl->f1[i] = 0;
spl->f2[i] = 0;
spl->f3[i] = 0;
for (k = 0; k < nb; k++) {
double ck = gsl_matrix_get(A, k, nb);
spl->f[i] += ck * fi (a, b, nb, k, xx);
spl->f1[i] += ck * dfi (a, b, nb, k, xx);
spl->f2[i] += ck * d2fi(a, b, nb, k, xx);
spl->f3[i] += ck * d3fi(a, b, nb, k, xx);
}
}
}
#ifdef DEBUG
{
FILE *tst = fopen("debug_spline_plot.txt", "w");
double dx = (b - a) / (TESTBASE - 1);
for (i = 0; i < TESTBASE; i++) {
double yi= 0;
double dyi= 0;
double d2yi= 0;
double d3yi= 0;
double xi= a + i * dx;
for( k= 0; k < nb; k++ ) {
yi += gsl_matrix_get(A, k, nb) * fi(a, b, nb, k, xi);
dyi += gsl_matrix_get(A, k, nb) * dfi(a, b, nb, k, xi);
d2yi += gsl_matrix_get(A, k, nb) * d2fi(a, b, nb, k, xi);
d3yi += gsl_matrix_get(A, k, nb) * d3fi(a, b, nb, k, xi);
}
fprintf(tst, "%g %g %g %g %g\n", xi, yi, dyi, d2yi, d3yi );
}
fclose(tst);
}
#endif
}
/*============================================================================*/
int ighmm_invert_det(double *sigmainv, double *det, int length, double *cov)
{
#define CUR_PROC "invert_det"
#ifdef DO_WITH_GSL
int i, j, s;
gsl_matrix *tmp;
gsl_matrix *inv;
tmp = gsl_matrix_alloc(length, length);
inv = gsl_matrix_alloc(length, length);
gsl_permutation *permutation = gsl_permutation_calloc(length);
for (i=0; i<length; ++i) {
for (j=0; j<length; ++j) {
#ifdef DO_WITH_GSL_DIAGONAL_HACK
if (i == j){
gsl_matrix_set(tmp, i, j, cov[i*length+j]);
}else{
gsl_matrix_set(tmp, i, j, 0.0);
}
#else
gsl_matrix_set(tmp, i, j, cov[i*length+j]);
#endif
}
}
gsl_linalg_LU_decomp(tmp, permutation, &s);
gsl_linalg_LU_invert(tmp, permutation, inv);
*det = gsl_linalg_LU_det(tmp, s);
gsl_matrix_free(tmp);
gsl_permutation_free(permutation);
for (i=0; i<length; ++i) {
for (j=0; j<length; ++j) {
sigmainv[i*length+j] = gsl_matrix_get(inv, i, j);
}
}
gsl_matrix_free(inv);
#elif defined HAVE_CLAPACK_DGETRF && HAVE_CLAPACK_DGETRI
char sign;
int info, i;
int *ipiv;
double det_tmp;
ipiv = malloc(length * sizeof *ipiv);
/* copy cov. matrix entries to result matrix, the rest is done in-place */
memcpy(sigmainv, cov, length * length * sizeof *cov);
/* perform in-place LU factorization of covariance matrix */
info = clapack_dgetrf(CblasRowMajor, length, length, sigmainv, length, ipiv);
/* determinant */
sign = 1;
for( i=0; i<length; ++i)
if( ipiv[i]!=i )
sign *= -1;
det_tmp = sigmainv[0];
for( i=length+1; i<(length*length); i+=length+1 )
det_tmp *= sigmainv[i];
*det = det_tmp * sign;
/* use the LU factorization to get inverse */
info = clapack_dgetri(CblasRowMajor, length, sigmainv, length, ipiv);
free(ipiv);
#else
*det = ighmm_determinant(cov, length);
ighmm_inverse(cov, length, *det, sigmainv);
#endif
return 0;
#undef CUR_PROC
}
int main(int argc, char **argv) {
const int MAX_ITER = 20;
const double TOL = 1e-12;
int rank;
int size;
int P = 8; // number of blocks to update P <= size
/* -----------------------------------
mode controls the selection schemes,
mode =0, fixed P
mode =1, dynamic update P
----------------------------------*/
int mode=1; // number of processors used to update each time
double lambda = 0.1;
srand (time(NULL));
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank); // Determine current running process
MPI_Comm_size(MPI_COMM_WORLD, &size); // Total number of processes
// data directory (you need to change the path to your own data directory)
char* dataCenterDir = "../Data/Gaussian";
char* big_dir;
if(argc==2)
big_dir = argv[1];
else
big_dir = "big1";
/* Read in local data */
FILE *f, *test;
int m, n, j;
int row, col;
double entry, startTime, endTime;
double total_start_time, total_end_time;
/*
* Subsystem n will look for files called An.dat and bn.dat
* in the current directory; these are its local data and do not need to be
* visible to any other processes. Note that
* m and n here refer to the dimensions of the *local* coefficient matrix.
*/
/* ------------
Read in A
------------*/
if(rank ==0){
printf("=============================\n");
printf("| Start to load data! |\n");
printf("=============================\n");
}
char s[100];
sprintf(s, "%s/%s/A%d.dat",dataCenterDir,big_dir, rank + 1);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_matrix *A = gsl_matrix_calloc(m, n);
for (int i = 0; i < m*n; i++) {
row = i % m;
col = floor(i/m);
fscanf(f, "%lf", &entry);
gsl_matrix_set(A, row, col, entry);
}
fclose(f);
/* ------------
Read in b
-------------*/
sprintf(s, "%s/%s/b.dat", dataCenterDir, big_dir);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_vector *b = gsl_vector_calloc(m);
for (int i = 0; i < m; i++) {
fscanf(f, "%lf", &entry);
gsl_vector_set(b, i, entry);
}
fclose(f);
/* ------------
Read in xs
------------*/
sprintf(s, "%s/%s/xs%d.dat", dataCenterDir, big_dir, rank + 1);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_vector *xs = gsl_vector_calloc(m);
for (int i = 0; i < m; i++) {
fscanf(f, "%lf", &entry);
gsl_vector_set(xs, i, entry);
}
fclose(f);
m = A->size1;
n = A->size2;
MPI_Barrier(MPI_COMM_WORLD);
/*----------------------------------------
* These are all variables related to GRock
----------------------------------------*/
struct value table[size];
gsl_vector *x = gsl_vector_calloc(n);
gsl_vector *As = gsl_vector_calloc(n);
gsl_vector *invAs = gsl_vector_calloc(n);
gsl_vector *local_b = gsl_vector_calloc(m);
gsl_vector *beta = gsl_vector_calloc(n);
gsl_vector *tmp = gsl_vector_calloc(n);
gsl_vector *d = gsl_vector_calloc(n);
gsl_vector *absd = gsl_vector_calloc(n);
gsl_vector *oldx = gsl_vector_calloc(n);
gsl_vector *tmpx = gsl_vector_calloc(n);
gsl_vector *z = gsl_vector_calloc(m);
gsl_vector *tmpz = gsl_vector_calloc(m);
gsl_vector *Ax = gsl_vector_calloc(m);
gsl_vector *Atmpx = gsl_vector_calloc(m);
gsl_vector *xdiff = gsl_vector_calloc(n);
gsl_permutation *idx = gsl_permutation_calloc(n);
double send[1];
double recv[1];
double err;
int num_upd = (int)(n*0.08);
double sigma = 0.01;
double xs_local_nrm[1], xs_nrm[1];
double local_old_obj, global_old_obj, local_new_obj, global_new_obj;
//calculate the 2 norm of xs
xs_local_nrm[0] = gsl_blas_dnrm2(xs);
xs_local_nrm[0] *=xs_local_nrm[0];
MPI_Allreduce(xs_local_nrm, xs_nrm, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
xs_nrm[0] = sqrt(xs_nrm[0]);
// evaluate the two norm of the columns of A
for(j=0;j<n;j++){
gsl_vector_view column = gsl_matrix_column(A, j);
double d;
d = gsl_blas_dnrm2(&column.vector);
gsl_vector_set(As, j, d*d);
gsl_vector_set(invAs, j, 1./(d*d));
}
if (rank == 0) {
printf("=============================\n");
printf("|GRock start to solve Lasso!|\n");
printf("|---------------------------|\n");
printf("|lambda=%1.2f, m=%d, n=%d |\n", lambda, m, n*size);
if(mode==1) printf("| Mode: dynamic update P. |\n");
else printf("| Mode: fixed update P |\n");
printf("=============================\n");
printf("%3s %8s %8s %5s\n", "iter", "rel_err", "obj", "P");
startTime = MPI_Wtime();
sprintf(s, "results/test%d.m", size);
test = fopen(s, "w");
fprintf(test,"res = [ \n");
}
/* Main BCD loop */
total_start_time = MPI_Wtime();
int iter = 0;
while (iter < MAX_ITER) {
startTime = MPI_Wtime();
/*---------- restore the old x ------------*/
gsl_vector_memcpy(oldx, x);
/*------- calculate local_b = b - sum_{j \neq i} Aj*xj--------- */
gsl_blas_dgemv(CblasNoTrans, 1, A, x, 0, Ax); // Ax = A * x
MPI_Allreduce(Ax->data, z->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(z, b); // z = Ax - b
gsl_vector_memcpy(local_b, Ax);
gsl_vector_sub(local_b, z);
/* -------calculate beta ------------------*/
gsl_blas_dgemv(CblasTrans, -1, A, z, 0, beta); // beta = A'(b - Ax) + ||A.s||^2 * xs
gsl_vector_memcpy(tmp, As);
pointwise(tmp, x, n);
gsl_vector_add(beta, tmp);
shrink(beta, lambda);
// x = 1/|xs|^2 * shrink(beta, lambda)
gsl_vector_memcpy(x, beta);
pointwise(x, invAs, n);
/* ------calcuate proposed decrease -------- */
gsl_vector_memcpy(d,x);
gsl_vector_sub(d, oldx);
if(mode ==1){
gsl_vector_memcpy(absd, d);
abs_vector(absd, n);
// sort the local array d
gsl_vector_scale(absd, -1.0);
gsl_sort_vector_index(idx, absd);
// printf("|d(0)| = %lf, |d(1)| = %lf \n", gsl_vector_get(absd,0), gsl_vector_get(absd, 3));
// calculate current objective value;
local_old_obj = objective(oldx, lambda, z, size);
MPI_Allreduce(&local_old_obj, &global_old_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
num_upd = fmin(num_upd+1, (int)(0.1*n));
gsl_vector_memcpy(tmpx, oldx);
int upd_idx;
double local_delta = 0, delta=0.0;
for(int i=0; i<num_upd; i++){
upd_idx = gsl_permutation_get(idx, i);
// printf("%d\n", upd_idx);
gsl_vector_set(tmpx, upd_idx, gsl_vector_get(x, upd_idx));
local_delta += gsl_vector_get(d, upd_idx) * gsl_vector_get(d, upd_idx);
}
MPI_Allreduce(&local_delta, &delta, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_blas_dgemv(CblasNoTrans, 1, A, tmpx, 0, Atmpx); // Ax = A * x
MPI_Allreduce(Atmpx->data, tmpz->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(tmpz, b); // z = Ax - b
local_new_obj = objective(tmpx, lambda, tmpz, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
while(global_new_obj - global_old_obj> -sigma * delta){
num_upd = fmax(num_upd-1, 1);
for(int i=0; i<num_upd; i++){
upd_idx = gsl_permutation_get(idx, i);
gsl_vector_set(tmpx, upd_idx, gsl_vector_get(x, upd_idx));
local_delta += gsl_vector_get(d, upd_idx) * gsl_vector_get(d, upd_idx);
}
MPI_Allreduce(&delta, &local_delta, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_blas_dgemv(CblasNoTrans, 1, A, tmpx, 0, Atmpx); // Ax = A * x
MPI_Allreduce(Atmpx->data, tmpz->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(tmpz, b); // z = Ax - b
local_new_obj = objective(tmpx, lambda, tmpz, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
if(num_upd==1)
break;
}
gsl_vector_memcpy(x, tmpx);
}
if(mode==0){
CBLAS_INDEX_t id = gsl_blas_idamax(d);
double *store = (double*)calloc(size, sizeof(double));
double foo[1];
foo[0] = gsl_vector_get(d,id);
MPI_Allgather(foo, 1, MPI_DOUBLE, store, 1, MPI_DOUBLE, MPI_COMM_WORLD);
for(int i=0;i<size;i++){
table[i].ID = i;
table[i].data = fabs(store[i]);
}
// quick sort to decide which block to update
qsort((void *) & table, size, sizeof(struct value), (compfn)compare );
gsl_vector_memcpy(x, oldx);
if(size>P){
for(int i=0;i<P;i++){
if(rank == table[i].ID)
gsl_vector_set(x, id, gsl_vector_get(oldx, id) + gsl_vector_get(d, id));
}
}else
gsl_vector_set(x, id, gsl_vector_get(oldx, id) + gsl_vector_get(d, id));
local_new_obj = objective(x, lambda, z, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
/*------------------------------
calculate the relative error
------------------------------*/
gsl_vector_memcpy(xdiff,xs);
gsl_vector_sub(xdiff, x);
err = gsl_blas_dnrm2(xdiff);
send[0] = err*err;
MPI_Allreduce(send, recv, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
recv[0] = sqrt(recv[0])/xs_nrm[0];
endTime = MPI_Wtime();
if(mode==1) P = num_upd*size;
if (rank == 0) {
if(iter%5 == 0)
printf("%3d %10.2e %10.4f %3d\n", iter,
recv[0], global_new_obj, P);
fprintf(test, "%e \n",recv[0]);
}
/* termination check */
if(recv[0] < TOL){
break;
}
iter++;
}
total_end_time = MPI_Wtime();
/* Have the master write out the results to disk */
if (rank == 0) {
printf("=============================\n");
printf("| GRock solved Lasso! |\n");
printf("|---------------------------|\n");
printf("|Summary: |\n");
printf("| # of iteration: %d |\n", iter);
printf("| relative error: %4.2e|\n", recv[0]);
printf("| objective value: %4.2f |\n", global_new_obj);
printf("| time: %4.1es|\n", total_end_time - total_start_time);
printf("=============================\n");
fprintf(test,"] \n");
fprintf(test,"semilogy(1:length(res),res); \n");
fprintf(test,"xlabel('# of iteration'); ylabel('||x - xs||');\n");
fclose(test);
f = fopen("results/solution.dat", "w");
fprintf(f,"x = [ \n");
gsl_vector_fprintf(f, x, "%lf");
fprintf(f,"] \n");
fclose(f);
endTime = MPI_Wtime();
}
MPI_Finalize(); /* Shut down the MPI execution environment */
/* Clear memory */
gsl_matrix_free(A);
gsl_vector_free(b);
gsl_vector_free(x);
gsl_vector_free(z);
gsl_vector_free(xdiff);
gsl_vector_free(Ax);
gsl_vector_free(As);
gsl_vector_free(invAs);
gsl_vector_free(tmpx);
gsl_vector_free(oldx);
gsl_vector_free(local_b);
gsl_vector_free(beta);
gsl_vector_free(tmpz);
gsl_vector_free(absd);
gsl_vector_free(Atmpx);
gsl_permutation_free(idx);
return 0;
}
