lars_type * lars_alloc2( matrix_type * X , matrix_type * Y , bool internal_copy ) {
lars_type * lars = lars_alloc__();
if (internal_copy) {
lars->X = matrix_alloc_copy( X );
lars->Y = matrix_alloc_copy( Y );
lars->data_owner = true;
} else {
lars->X = X;
lars->Y = Y;
lars->data_owner = false;
}
return lars;
}
matrix_type * matrix_realloc_copy(matrix_type * T , const matrix_type * src) {
if (T == NULL)
return matrix_alloc_copy( src );
else {
matrix_resize( T , src->rows , src->columns , false );
matrix_assign( T , src );
return T;
}
}
void rml_enkf_common_initA__( matrix_type * A ,
matrix_type * S ,
matrix_type * Cd ,
matrix_type * E ,
matrix_type * D ,
double truncation,
double lamda,
matrix_type * Udr,
double * Wdr,
matrix_type * VdTr) {
int nrobs = matrix_get_rows( S );
int ens_size = matrix_get_columns( S );
double a = lamda + 1;
matrix_type *tmp = matrix_alloc (nrobs, ens_size);
double nsc = 1/sqrt(ens_size-1);
printf("The lamda Value is %5.5f\n",lamda);
printf("The Value of Truncation is %4.2f \n",truncation);
matrix_subtract_row_mean( S ); /* Shift away the mean in the ensemble predictions*/
matrix_inplace_diag_sqrt(Cd);
matrix_dgemm(tmp, Cd, S,false, false, 1.0, 0.0);
matrix_scale(tmp, nsc);
printf("The Scaling of data matrix completed !\n ");
// SVD(S) = Ud * Wd * Vd(T)
int nsign = enkf_linalg_svd_truncation(tmp , truncation , -1 , DGESVD_MIN_RETURN , Wdr , Udr , VdTr);
/* After this we only work with the reduced dimension matrices */
printf("The number of siginificant ensembles are %d \n ",nsign);
matrix_type * X1 = matrix_alloc( nsign, ens_size);
matrix_type * X2 = matrix_alloc (nsign, ens_size );
matrix_type * X3 = matrix_alloc (ens_size, ens_size );
// Compute the matrices X1,X2,X3 and dA
enkf_linalg_rml_enkfX1(X1, Udr ,D ,Cd ); //X1 = Ud(T)*Cd(-1/2)*D -- D= -(dk-d0)
enkf_linalg_rml_enkfX2(X2, Wdr ,X1 ,a, nsign); //X2 = ((a*Ipd)+Wd^2)^-1 * X1
matrix_free(X1);
enkf_linalg_rml_enkfX3(X3, VdTr ,Wdr,X2, nsign); //X3 = Vd *Wd*X2
printf("The X3 matrix is computed !\n ");
matrix_type *dA1= matrix_alloc (matrix_get_rows(A), ens_size);
matrix_type * Dm = matrix_alloc_copy( A );
matrix_subtract_row_mean( Dm ); /* Remove the mean from the ensemble of model parameters*/
matrix_scale(Dm, nsc);
enkf_linalg_rml_enkfdA(dA1, Dm, X3); //dA = Dm * X3
matrix_inplace_add(A,dA1); //dA
matrix_free(X3);
matrix_free(Dm);
matrix_free(dA1);
}
void bootstrap_enkf_updateA(void * module_data ,
matrix_type * A ,
matrix_type * S ,
matrix_type * R ,
matrix_type * dObs ,
matrix_type * E ,
matrix_type * D ) {
bootstrap_enkf_data_type * bootstrap_data = bootstrap_enkf_data_safe_cast( module_data );
{
const int num_cpu_threads = 4;
int ens_size = matrix_get_columns( A );
matrix_type * X = matrix_alloc( ens_size , ens_size );
matrix_type * A0 = matrix_alloc_copy( A );
matrix_type * S_resampled = matrix_alloc_copy( S );
matrix_type * A_resampled = matrix_alloc( matrix_get_rows(A0) , matrix_get_columns( A0 ));
int ** iens_resample = alloc_iens_resample( bootstrap_data->rng , ens_size );
{
int ensemble_members_loop;
for ( ensemble_members_loop = 0; ensemble_members_loop < ens_size; ensemble_members_loop++) {
int unique_bootstrap_components;
int ensemble_counter;
/* Resample A and meas_data. Here we are careful to resample the working copy.*/
{
{
int_vector_type * bootstrap_components = int_vector_alloc( ens_size , 0);
for (ensemble_counter = 0; ensemble_counter < ens_size; ensemble_counter++) {
int random_column = iens_resample[ ensemble_members_loop][ensemble_counter];
int_vector_iset( bootstrap_components , ensemble_counter , random_column );
matrix_copy_column( A_resampled , A0 , ensemble_counter , random_column );
matrix_copy_column( S_resampled , S , ensemble_counter , random_column );
}
int_vector_select_unique( bootstrap_components );
unique_bootstrap_components = int_vector_size( bootstrap_components );
int_vector_free( bootstrap_components );
}
if (bootstrap_data->doCV) {
const bool_vector_type * ens_mask = NULL;
cv_enkf_init_update( bootstrap_data->cv_enkf_data , ens_mask , S_resampled , R , dObs , E , D);
cv_enkf_initX( bootstrap_data->cv_enkf_data , X , A_resampled , S_resampled , R , dObs , E , D);
} else
std_enkf_initX(bootstrap_data->std_enkf_data , X , NULL , S_resampled,R, dObs, E,D );
matrix_inplace_matmul_mt1( A_resampled , X , num_cpu_threads );
matrix_inplace_add( A_resampled , A0 );
matrix_copy_column( A , A_resampled, ensemble_members_loop, ensemble_members_loop);
}
}
}
free_iens_resample( iens_resample , ens_size);
matrix_free( X );
matrix_free( S_resampled );
matrix_free( A_resampled );
matrix_free( A0 );
}
}
static double stepwise_estimate__( stepwise_type * stepwise , bool_vector_type * active_rows) {
matrix_type * X;
matrix_type * E;
matrix_type * Y;
double y_mean = 0;
int nvar = matrix_get_columns( stepwise->X0 );
int nsample = matrix_get_rows( stepwise->X0 );
nsample = bool_vector_count_equal( active_rows , true );
nvar = bool_vector_count_equal( stepwise->active_set , true );
matrix_set( stepwise->beta , 0 ); // It is essential to make sure that old finite values in the beta0 vector do not hang around.
/*
Extracting the data used for regression, and storing them in the
temporary local matrices X and Y. Selecting data is based both on
which varibles are active (stepwise->active_set) and which rows
should be used for regression, versus which should be used for
validation (@active_rows).
*/
if ((nsample < matrix_get_rows( stepwise->X0 )) || (nvar < matrix_get_columns( stepwise->X0 ))) {
X = matrix_alloc( nsample , nvar );
E = matrix_alloc( nsample , nvar );
Y = matrix_alloc( nsample , 1);
{
int icol,irow; // Running over all values.
int arow,acol; // Running over active values.
arow = 0;
for (irow = 0; irow < matrix_get_rows( stepwise->X0 ); irow++) {
if (bool_vector_iget( active_rows , irow )) {
acol = 0;
for (icol = 0; icol < matrix_get_columns( stepwise->X0 ); icol++) {
if (bool_vector_iget( stepwise->active_set , icol )) {
matrix_iset( X , arow , acol , matrix_iget( stepwise->X0 , irow , icol ));
matrix_iset( E , arow , acol , matrix_iget( stepwise->E0 , irow , icol ));
acol++;
}
}
matrix_iset( Y , arow , 0 , matrix_iget( stepwise->Y0 , irow , 0 ));
arow++;
}
}
}
} else {
X = matrix_alloc_copy( stepwise->X0 );
E = matrix_alloc_copy( stepwise->E0 );
Y = matrix_alloc_copy( stepwise->Y0 );
}
{
if (stepwise->X_mean != NULL)
matrix_free( stepwise->X_mean);
stepwise->X_mean = matrix_alloc( 1 , nvar );
if (stepwise->X_norm != NULL)
matrix_free( stepwise->X_norm);
stepwise->X_norm = matrix_alloc( 1 , nvar );
matrix_type * beta = matrix_alloc( nvar , 1); /* This is the beta vector as estimated from the OLS estimator. */
regression_augmented_OLS( X , Y , E, beta );
/*
In this code block the beta/tmp_beta vector which is dense with
fewer elements than the full model is scattered into the beta0
vector which has full size and @nvar elements.
*/
{
int ivar,avar;
avar = 0;
for (ivar = 0; ivar < matrix_get_columns( stepwise->X0 ); ivar++) {
if (bool_vector_iget( stepwise->active_set , ivar )) {
matrix_iset( stepwise->beta , ivar , 0 , matrix_iget( beta , avar , 0));
avar++;
}
}
}
matrix_free( beta );
}
matrix_free( X );
matrix_free( E );
matrix_free( Y );
return y_mean;
}
void lars_estimate(lars_type * lars , int max_vars , double max_beta , bool verbose) {
int nvars = matrix_get_columns( lars->X );
int nsample = matrix_get_rows( lars->X );
matrix_type * X = matrix_alloc( nsample, nvars ); // Allocate local X and Y variables
matrix_type * Y = matrix_alloc( nsample, 1 ); // which will hold the normalized data
lars_estimate_init( lars , X , Y); // during the estimation process.
{
matrix_type * G = matrix_alloc_gram( X , true );
matrix_type * mu = matrix_alloc( nsample , 1 );
matrix_type * C = matrix_alloc( nvars , 1 );
matrix_type * Y_mu = matrix_alloc_copy( Y );
int_vector_type * active_set = int_vector_alloc(0,0);
int_vector_type * inactive_set = int_vector_alloc(0,0);
int active_size;
if ((max_vars <= 0) || (max_vars > nvars))
max_vars = nvars;
{
int i;
for (i=0; i < nvars; i++)
int_vector_iset( inactive_set , i , i );
}
matrix_set( mu , 0 );
while (true) {
double maxC = 0;
/*
The first step is to calculate the correlations between the
covariates, and the current residual. All the currently inactive
covariates are searched; the covariate with the greatest
correlation with (Y - mu) is selected and added to the active set.
*/
matrix_sub( Y_mu , Y , mu ); // Y_mu = Y - mu
matrix_dgemm( C , X , Y_mu , true , false , 1.0 , 0); // C = X' * Y_mu
{
int i;
int max_set_index = 0;
for (i=0; i < int_vector_size( inactive_set ); i++) {
int set_index = i;
int var_index = int_vector_iget( inactive_set , set_index );
double value = fabs( matrix_iget(C , var_index , 0) );
if (value > maxC) {
maxC = value;
max_set_index = set_index;
}
}
/*
Remove element corresponding to max_set_index from the
inactive set and add it to the active set:
*/
int_vector_append( active_set , int_vector_idel( inactive_set , max_set_index ));
}
active_size = int_vector_size( active_set );
/*
Now we have calculated the correlations between all the
covariates and the current residual @Y_mu. The correlations are
stored in the matrix @C. The value of the maximum correlation is
stored in @maxC.
Based on the value of @maxC we have added one new covariate to
the model, technically by moving the index from @inactive_set to
@active_set.
*/
/*****************************************************************/
{
matrix_type * weights = matrix_alloc( active_size , 1);
double scale;
/*****************************************************************/
/* This scope should compute and initialize the variables
@weights and @scale. */
{
matrix_type * subG = matrix_alloc( active_size , active_size );
matrix_type * STS = matrix_alloc( active_size , active_size );
matrix_type * sign_vector = matrix_alloc( active_size , 1);
int i , j;
/*
STS = S' o S where 'o' is the Schur product and S is given
by:
[ s1 s2 s3 s4 ]
S = [ s1 s2 s3 s4 ]
[ s1 s2 s3 s4 ]
[ s1 s2 s3 s4 ]
Where si is the sign of the correlation between (active)
variable 'i' and Y_mu.
*/
for (i=0; i < active_size ; i++) {
int vari = int_vector_iget( active_set , i );
double signi = sgn( matrix_iget( C , vari , 0));
matrix_iset( sign_vector , i , 0 , signi );
for (j=0; j < active_size; j++) {
int varj = int_vector_iget( active_set , j );
double signj = sgn( matrix_iget( C , varj , 0));
matrix_iset( STS , i , j , signi * signj );
}
}
// Extract the elements from G corresponding to active indices and
// copy to the matrix subG:
for (i=0; i < active_size ; i++) {
int ii = int_vector_iget( active_set , i );
for (j=0; j < active_size; j++) {
int jj = int_vector_iget( active_set , j );
matrix_iset( subG , i , j , matrix_iget(G , ii , jj));
}
}
// Weights
matrix_inplace_mul( subG , STS );
matrix_inv( subG );
{
matrix_type * ones = matrix_alloc( active_size , 1 );
matrix_type * GA1 = matrix_alloc( active_size , 1 );
matrix_set( ones , 1.0 );
matrix_matmul( GA1 , subG , ones );
scale = 1.0 / sqrt( matrix_get_column_sum( GA1 , 0 ));
matrix_mul( weights , GA1 , sign_vector );
matrix_scale( weights , scale );
matrix_free( GA1 );
matrix_free( ones );
}
matrix_free( sign_vector );
matrix_free( subG );
matrix_free( STS );
}
/******************************************************************/
/* The variables weight and scale have been calculated, proceed
to calculate the step length @gamma. */
{
int i;
double gamma;
{
matrix_type * u = matrix_alloc( nsample , 1 );
int j;
for (i=0; i < nsample; i++) {
double row_sum = 0;
for (j =0; j < active_size; j++)
row_sum += matrix_iget( X , i , int_vector_iget( active_set , j)) * matrix_iget(weights , j , 0 );
matrix_iset( u , i , 0 , row_sum );
}
gamma = maxC / scale;
if (active_size < matrix_get_columns( X )) {
matrix_type * equi_corr = matrix_alloc( nvars , 1 );
matrix_dgemm( equi_corr , X , u , true , false , 1.0 , 0); // equi_corr = X'·u
for (i=0; i < (nvars - active_size); i++) {
int var_index = int_vector_iget( inactive_set , i );
double gamma1 = (maxC - matrix_iget(C , var_index , 0 )) / ( scale - matrix_iget( equi_corr , var_index , 0));
double gamma2 = (maxC + matrix_iget(C , var_index , 0 )) / ( scale + matrix_iget( equi_corr , var_index , 0));
if ((gamma1 > 0) && (gamma1 < gamma))
gamma = gamma1;
if ((gamma2 > 0) && (gamma2 < gamma))
gamma = gamma2;
}
matrix_free( equi_corr );
}
/* Update the current estimated 'location' mu. */
matrix_scale( u , gamma );
matrix_inplace_add( mu , u );
matrix_free( u );
}
/*
We have calculated the step length @gamma, and the @weights. Update the @beta matrix.
*/
for (i=0; i < active_size; i++)
matrix_iset( lars->beta , int_vector_iget( active_set , i ) , active_size - 1 , gamma * matrix_iget( weights , i , 0));
if (active_size > 1)
for (i=0; i < nvars; i++)
matrix_iadd( lars->beta , i , active_size - 1 , matrix_iget( lars->beta , i , active_size - 2));
matrix_free( weights );
}
}
if (active_size == max_vars)
break;
if (max_beta > 0) {
double beta_norm2 = matrix_get_column_abssum( lars->beta , active_size - 1 );
if (beta_norm2 > max_beta) {
// We stop - we will use an interpolation between this beta estimate and
// the previous, to ensure that the |beta| = max_beta criteria is satisfied.
if (active_size >= 2) {
double beta_norm1 = matrix_get_column_abssum( lars->beta , active_size - 2 );
double s = (max_beta - beta_norm1)/(beta_norm2 - beta_norm1);
{
int j;
for (j=0; j < nvars; j++) {
double beta1 = matrix_iget( lars->beta , j , active_size - 2 );
double beta2 = matrix_iget( lars->beta , j , active_size - 1 );
matrix_iset( lars->beta , j , active_size - 1 , beta1 + s*(beta2 - beta1));
}
}
}
break;
}
}
}
matrix_free( G );
matrix_free( mu );
matrix_free( C );
matrix_free( Y_mu );
int_vector_free( active_set );
int_vector_free( inactive_set );
matrix_resize( lars->beta , nvars , active_size , true );
if (verbose)
matrix_pretty_fprint( lars->beta , "beta" , "%12.5f" , stdout );
lars_select_beta( lars , active_size - 1);
}
matrix_free( X );
matrix_free( Y );
}
