void freeMcmcInternals(mcmcInternals *MCMCSettings) { gsl_matrix_free(MCMCSettings->Sigma_beta); free(MCMCSettings); }
int main (int argc, char *argv[]) { /* Local variables */ int i, j, k, l; /* Indices and counters */ int nr; /* Matrix dimensions, rows */ int nc; /* Matrix dimensions, columns */ int s; /* Sign of the permutation */ if(argc==2) { /* Declare FILE variable */ FILE* inputFile; /* Attempt to open file provided in cmdline arg */ inputFile=fopen(argv[1],"r"); if(inputFile==NULL) { /* Alert user file was not opened properly */ fprintf(stdout,"\nFile was not opened properly\n"); return 2; } /* Scan in nr and nc */ fscanf(inputFile,"%d %d", &nr,&nc); /* Declare and allocate matrix and vector variables */ gsl_matrix *A = gsl_matrix_calloc (nr,nc) ; /* Coefficient Matrix */ gsl_vector *b = gsl_vector_calloc (nr) ; /* Coefficient Vector */ gsl_vector *x = gsl_vector_calloc (nc); /* Solution Vector */ gsl_permutation *p = gsl_permutation_alloc (nr); /* Permutation Vector for LU */ double a_data[nr*nc]; double b_data[nr]; for(i=0; i<nr; i++) { double coefValue; for(j=0; j<nc; j++) { // scan, add to a //index is i*j + j double matValue; fscanf(inputFile, " %lf ", &matValue); a_data[(i*j)+j]=matValue; } //scan, add to b //index is i fscanf(inputFile, " %lf ", &coefValue); b_data[i]=coefValue; } /* double a_data[nr*nc]; a_data[0]=2.0; a_data[1]=3.0; a_data[2]=4.0; a_data[3]=-6.0; double b_data[nr]; b_data[0]=5.0; b_data[1]=-3.0; */ /* Initialize coefficient matrix (A) and vector (b) */ k = 0 ; l = 0 ; /* set counters to zero */ for (i=0; i<nr; i++) { for (j=0; j<nc; j++) { gsl_matrix_set(A,i,j,a_data[k]) ; k++ ; } /* for j */ gsl_vector_set(b,i,b_data[l]) ; l++ ; } /* for i */ /* Print entries of A */ /* do not use gsl_matrix_fprintf */ printf("Solution of the system Ax=b via PLU factorizations\n"); printf("Matrix A:\n"); for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) printf ("%7.2g ", gsl_matrix_get (A, i, j)); putchar('\n'); } /* for i */ /* Print entries of vector b */ printf("Vector b:\n"); gsl_vector_fprintf (stdout, b,"%7.2g") ; /* Perform (inplace) PLU factorization: overwrites A */ gsl_linalg_LU_decomp (A, p, &s); /* A is overwritten */ /* Now solve using the data in A and p found above and b */ gsl_linalg_LU_solve (A, p, b, x); /* x returns retuls */ /* Print solution x */ printf("Solution x:\n"); gsl_vector_fprintf (stdout, x, "%7.2g"); /* free up memory dynamically allocated */ gsl_matrix_free (A); gsl_vector_free (b); gsl_permutation_free (p); gsl_vector_free (x); } return 0; } /* main */
/* Populate field variables by SPR */ void _SnacRemesher_RecoverNode( void* _context, unsigned node_lI ) { Snac_Context* context = (Snac_Context*)_context; Mesh* mesh = context->mesh; MeshLayout* layout = (MeshLayout*)mesh->layout; HexaMD* decomp = (HexaMD*)layout->decomp; NodeLayout* nLayout = layout->nodeLayout; Snac_Node* node = Snac_Node_At( context, node_lI ); Coord* coord = Snac_NodeCoord_P( context, node_lI ); Index nodeElementCount = context->mesh->nodeElementCountTbl[node_lI]; Index nodeElement_I; Element_DomainIndex* elements; gsl_matrix* matA; gsl_vector* vecaStrain[6]; gsl_vector* vecaStress[6]; gsl_vector* vecaMaterial_I; gsl_vector* vecaDensity; gsl_vector* vecbStrain[6]; gsl_vector* vecbStress[6]; gsl_vector* vecbMaterial_I; gsl_vector* vecbDensity; Index i,j; IJK ijk; Node_GlobalIndex node_gI = _MeshDecomp_Node_LocalToGlobal1D( decomp, node_lI ); Node_GlobalIndex gNodeI = decomp->nodeGlobal3DCounts[0]; Node_GlobalIndex gNodeJ = decomp->nodeGlobal3DCounts[1]; Node_GlobalIndex gNodeK = decomp->nodeGlobal3DCounts[2]; Node_GlobalIndex intNode_gI; Node_DomainIndex intNode_lI; unsigned int isBoundaryNode=0, patchCenterNum=1, patchCenterI, patchCenterList[2]; RegularMeshUtils_Node_1DTo3D( decomp, node_gI, &ijk[0], &ijk[1], &ijk[2] ); /* If boundary node, find a (topologically?) nearest interior node. Loosely following Khoei and Gharehbaghi, 2007, The superconvergent patch recovery techinique and data transfer operators in 3D plasticity problems, Finite Elements in Analysis and Design 43 (2007) 630-- 648. */ if( (gNodeI>2) && (ijk[0]==0) ) { ijk[0] += 1; isBoundaryNode = 1; } if( (gNodeI>2) && (ijk[0]==decomp->nodeGlobal3DCounts[0]-1) ) { ijk[0] -= 1; isBoundaryNode = 1; } if( (gNodeJ>2) && (ijk[1]==0) ) { ijk[1] += 1; isBoundaryNode = 1; } if( (gNodeJ>2) && (ijk[1]==decomp->nodeGlobal3DCounts[1]-1) ) { ijk[1] -= 1; isBoundaryNode = 1; } if( (gNodeK>2) && (ijk[2]==0) ) { ijk[2] += 1; isBoundaryNode = 1; } if( (gNodeK>2) && (ijk[2]==decomp->nodeGlobal3DCounts[2]-1) ) { ijk[2] -= 1; isBoundaryNode = 1; } /* node_lI itself always becomes a patch center, and if the current node is a boundary node, find an interior node and add it to the patch center list. */ patchCenterList[0] = node_lI; if( isBoundaryNode ) { patchCenterNum=2; intNode_gI = ijk[0]+gNodeI*ijk[1]+gNodeI*gNodeJ*ijk[2]; patchCenterList[1] = Mesh_NodeMapGlobalToLocal( mesh, intNode_gI ); } /* initialize gsl vectors and matrix. */ matA = gsl_matrix_alloc(4,4); gsl_matrix_set_zero( matA ); vecaMaterial_I = gsl_vector_alloc(4); gsl_vector_set_zero( vecaMaterial_I ); vecbMaterial_I = gsl_vector_alloc(4); gsl_vector_set_zero( vecbMaterial_I ); vecaDensity = gsl_vector_alloc(4); gsl_vector_set_zero( vecaDensity ); vecbDensity = gsl_vector_alloc(4); gsl_vector_set_zero( vecbDensity ); for(i=0;i<6;i++) { vecaStrain[i] = gsl_vector_alloc(4); gsl_vector_set_zero( vecaStrain[i] ); vecaStress[i] = gsl_vector_alloc(4); gsl_vector_set_zero( vecaStress[i] ); vecbStrain[i] = gsl_vector_alloc(4); gsl_vector_set_zero( vecbStrain[i] ); vecbStress[i] = gsl_vector_alloc(4); gsl_vector_set_zero( vecbStress[i] ); } /* For each patch center */ for( patchCenterI=0; patchCenterI < patchCenterNum; patchCenterI++ ) { /* For each incident element, find inicident tets. */ for( nodeElement_I = 0; nodeElement_I < nodeElementCount; nodeElement_I++ ) { Element_DomainIndex element_dI = context->mesh->nodeElementTbl[patchCenterList[patchCenterI]][nodeElement_I]; if( element_dI < mesh->elementDomainCount ) { Index elementTetra_I; Snac_Element* element = Snac_Element_At( context, element_dI ); /* Extract the element's node indices. Note that there should always be eight of these. */ { Element_GlobalIndex element_gI; elements = Memory_Alloc_Array( Node_DomainIndex, nodeElementCount, "SnacRemesher" ); element_gI = Mesh_ElementMapDomainToGlobal( mesh, element_dI ); nLayout->buildElementNodes( nLayout, element_gI, elements ); } /* Convert global node indices to domain. */ { unsigned eltNode_i; for( eltNode_i = 0; eltNode_i < nodeElementCount; eltNode_i++ ) { elements[eltNode_i] = Mesh_NodeMapGlobalToDomain( mesh, elements[eltNode_i] ); } } /* For each incident tetrahedron in the incident element, add up contributions to P, A, and b as in Zienkiewicz and Zhu (1992), p. 1336 */ for( elementTetra_I = 0; elementTetra_I < Node_Element_Tetrahedra_Count;elementTetra_I++ ) { Tetrahedra_Index tetra_I = NodeToTetra[nodeElement_I][elementTetra_I]; Coord tCrds[4]; double positionP[4] = {1.0,0.0,0.0,0.0}; Index ii,jj; /* Extract the tetrahedron's coordinates. */ Vector_Set( tCrds[0], mesh->nodeCoord[elements[TetraToNode[tetra_I][0]]] ); Vector_Set( tCrds[1], mesh->nodeCoord[elements[TetraToNode[tetra_I][1]]] ); Vector_Set( tCrds[2], mesh->nodeCoord[elements[TetraToNode[tetra_I][2]]] ); Vector_Set( tCrds[3], mesh->nodeCoord[elements[TetraToNode[tetra_I][3]]] ); for(ii=1;ii<4;ii++) for(jj=0;jj<4;jj++) positionP[ii] += (0.25f * tCrds[jj][ii-1]); for(ii=0;ii<4;ii++) { double tmp; tmp = gsl_vector_get(vecbStrain[0],ii) + positionP[ii]*element->tetra[tetra_I].strain[0][0]; gsl_vector_set(vecbStrain[0],ii,tmp); tmp = gsl_vector_get(vecbStrain[1],ii) + positionP[ii]*element->tetra[tetra_I].strain[1][1]; gsl_vector_set(vecbStrain[1],ii,tmp); tmp = gsl_vector_get(vecbStrain[2],ii) + positionP[ii]*element->tetra[tetra_I].strain[2][2]; gsl_vector_set(vecbStrain[2],ii,tmp); tmp = gsl_vector_get(vecbStrain[3],ii) + positionP[ii]*element->tetra[tetra_I].strain[0][1]; gsl_vector_set(vecbStrain[3],ii,tmp); tmp = gsl_vector_get(vecbStrain[4],ii) + positionP[ii]*element->tetra[tetra_I].strain[0][2]; gsl_vector_set(vecbStrain[4],ii,tmp); tmp = gsl_vector_get(vecbStrain[5],ii) + positionP[ii]*element->tetra[tetra_I].strain[1][2]; gsl_vector_set(vecbStrain[5],ii,tmp); tmp = gsl_vector_get(vecbStress[0],ii) + positionP[ii]*element->tetra[tetra_I].stress[0][0]; gsl_vector_set(vecbStress[0],ii,tmp); tmp = gsl_vector_get(vecbStress[1],ii) + positionP[ii]*element->tetra[tetra_I].stress[1][1]; gsl_vector_set(vecbStress[1],ii,tmp); tmp = gsl_vector_get(vecbStress[2],ii) + positionP[ii]*element->tetra[tetra_I].stress[2][2]; gsl_vector_set(vecbStress[2],ii,tmp); tmp = gsl_vector_get(vecbStress[3],ii) + positionP[ii]*element->tetra[tetra_I].stress[0][1]; gsl_vector_set(vecbStress[3],ii,tmp); tmp = gsl_vector_get(vecbStress[4],ii) + positionP[ii]*element->tetra[tetra_I].stress[0][2]; gsl_vector_set(vecbStress[4],ii,tmp); tmp = gsl_vector_get(vecbStress[5],ii) + positionP[ii]*element->tetra[tetra_I].stress[1][2]; gsl_vector_set(vecbStress[5],ii,tmp); /* tmp = gsl_vector_get(vecbMaterial_I,ii) + positionP[ii]*((double)(element->tetra[tetra_I].material_I)+0.5); */ tmp = gsl_vector_get(vecbMaterial_I,ii) + positionP[ii]*pow(10.0,(double)(element->tetra[tetra_I].material_I)); gsl_vector_set(vecbMaterial_I,ii,tmp); tmp = gsl_vector_get(vecbDensity,ii) + positionP[ii]*element->tetra[tetra_I].density; gsl_vector_set(vecbDensity,ii,tmp); for(jj=0;jj<4;jj++) { tmp = gsl_matrix_get(matA,ii,jj) + positionP[ii]*positionP[jj]; gsl_matrix_set(matA,ii,jj,tmp); } } /* end of verteces of a tet. */ } /* end of incident tets. */ } /* if within my domain */ } /* end of incident elements. */ } /* end of patchCenterI */ /* compute parameter vectors. */ { int s; gsl_permutation * p = gsl_permutation_alloc (4); gsl_linalg_LU_decomp (matA, p, &s); for(i=0;i<6;i++) { gsl_linalg_LU_solve (matA, p, vecbStrain[i], vecaStrain[i]); gsl_linalg_LU_solve (matA, p, vecbStress[i], vecaStress[i]); } gsl_linalg_LU_solve (matA, p, vecbMaterial_I, vecaMaterial_I); gsl_linalg_LU_solve (matA, p, vecbDensity, vecaDensity); /* printf ("x = \n"); */ /* gsl_vector_fprintf (stdout, x, "%g"); */ gsl_permutation_free (p); } /* zero the arrays to store recovered field. */ /* probably not necessary. */ /* for(i=0;i<6;i++) { */ /* node->strainSPR[i] = 0.0f; */ /* node->stressSPR[i] = 0.0f; */ /* } */ /* Recover using the parameter vectors. */ for(j=0;j<6;j++) { node->strainSPR[j] = gsl_vector_get(vecaStrain[j],0); node->stressSPR[j] = gsl_vector_get(vecaStress[j],0); for(i=0;i<3;i++) { node->strainSPR[j] += gsl_vector_get(vecaStrain[j],i+1)*(*coord)[i]; node->stressSPR[j] += gsl_vector_get(vecaStress[j],i+1)*(*coord)[i]; } } node->material_ISPR = gsl_vector_get(vecaMaterial_I,0); for(i=0;i<3;i++) node->material_ISPR += gsl_vector_get(vecaMaterial_I,i+1)*(*coord)[i]; node->densitySPR = gsl_vector_get(vecaDensity,0); for(i=0;i<3;i++) node->densitySPR += gsl_vector_get(vecaDensity,i+1)*(*coord)[i]; /* free gsl vectors and matrix. */ gsl_matrix_free( matA ); gsl_vector_free( vecaMaterial_I ); gsl_vector_free( vecbMaterial_I ); gsl_vector_free( vecaDensity ); gsl_vector_free( vecbDensity ); for(i=0;i<6;i++) { gsl_vector_free( vecaStrain[i] ); gsl_vector_free( vecaStress[i] ); gsl_vector_free( vecbStrain[i] ); gsl_vector_free( vecbStress[i] ); } /* Free the element node array. */ FreeArray( elements ); /* end of recovery. */ }
static int hybrid_alloc (void *vstate, size_t n) { hybrid_state_t *state = (hybrid_state_t *) vstate; gsl_matrix *J, *q, *r; gsl_vector *tau, *diag, *qtf, *newton, *gradient, *x_trial, *f_trial, *df, *qtdf, *rdx, *w, *v; J = gsl_matrix_calloc (n, n); if (J == 0) { GSL_ERROR_VAL ("failed to allocate space for J", GSL_ENOMEM, 0); } state->J = J; q = gsl_matrix_calloc (n, n); if (q == 0) { gsl_matrix_free (J); GSL_ERROR_VAL ("failed to allocate space for q", GSL_ENOMEM, 0); } state->q = q; r = gsl_matrix_calloc (n, n); if (r == 0) { gsl_matrix_free (J); gsl_matrix_free (q); GSL_ERROR_VAL ("failed to allocate space for r", GSL_ENOMEM, 0); } state->r = r; tau = gsl_vector_calloc (n); if (tau == 0) { gsl_matrix_free (J); gsl_matrix_free (q); gsl_matrix_free (r); GSL_ERROR_VAL ("failed to allocate space for tau", GSL_ENOMEM, 0); } state->tau = tau; diag = gsl_vector_calloc (n); if (diag == 0) { gsl_matrix_free (J); gsl_matrix_free (q); gsl_matrix_free (r); gsl_vector_free (tau); GSL_ERROR_VAL ("failed to allocate space for diag", GSL_ENOMEM, 0); } state->diag = diag; qtf = gsl_vector_calloc (n); if (qtf == 0) { gsl_matrix_free (J); gsl_matrix_free (q); gsl_matrix_free (r); gsl_vector_free (tau); gsl_vector_free (diag); GSL_ERROR_VAL ("failed to allocate space for qtf", GSL_ENOMEM, 0); } state->qtf = qtf; newton = gsl_vector_calloc (n); if (newton == 0) { gsl_matrix_free (J); gsl_matrix_free (q); gsl_matrix_free (r); gsl_vector_free (tau); gsl_vector_free (diag); gsl_vector_free (qtf); GSL_ERROR_VAL ("failed to allocate space for newton", GSL_ENOMEM, 0); } state->newton = newton; gradient = gsl_vector_calloc (n); if (gradient == 0) { gsl_matrix_free (J); gsl_matrix_free (q); gsl_matrix_free (r); gsl_vector_free (tau); gsl_vector_free (diag); gsl_vector_free (qtf); gsl_vector_free (newton); GSL_ERROR_VAL ("failed to allocate space for gradient", GSL_ENOMEM, 0); } state->gradient = gradient; x_trial = gsl_vector_calloc (n); if (x_trial == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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_VAL ("failed to allocate space for x_trial", GSL_ENOMEM, 0); } state->x_trial = x_trial; f_trial = gsl_vector_calloc (n); if (f_trial == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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_VAL ("failed to allocate space for f_trial", GSL_ENOMEM, 0); } state->f_trial = f_trial; df = gsl_vector_calloc (n); if (df == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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_VAL ("failed to allocate space for df", GSL_ENOMEM, 0); } state->df = df; qtdf = gsl_vector_calloc (n); if (qtdf == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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_VAL ("failed to allocate space for qtdf", GSL_ENOMEM, 0); } state->qtdf = qtdf; rdx = gsl_vector_calloc (n); if (rdx == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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 (qtdf); GSL_ERROR_VAL ("failed to allocate space for rdx", GSL_ENOMEM, 0); } state->rdx = rdx; w = gsl_vector_calloc (n); if (w == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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 (qtdf); gsl_vector_free (rdx); GSL_ERROR_VAL ("failed to allocate space for w", GSL_ENOMEM, 0); } state->w = w; v = gsl_vector_calloc (n); if (v == 0) { gsl_matrix_free (J); gsl_matrix_free (q); 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 (qtdf); gsl_vector_free (rdx); gsl_vector_free (w); GSL_ERROR_VAL ("failed to allocate space for v", GSL_ENOMEM, 0); } state->v = v; return GSL_SUCCESS; }
int w_update( gsl_matrix *weights, gsl_matrix *x_white, gsl_matrix *bias, gsl_matrix *shuffled_x_white, //work space for shuffled x_white gsl_permutation *p, // random permutation gsl_rng *r, // random stream from gsl double lrate){ int error = 0; size_t i; const size_t NVOX = x_white->size2; const size_t NCOMP = x_white->size1; size_t block = (size_t)floor(sqrt(NVOX/3.0)); gsl_matrix *ib = gsl_matrix_alloc(1,block); gsl_matrix_set_all( ib, 1.0); gsl_ran_shuffle (r, p->data, NVOX, sizeof(size_t)); // gsl_matrix *shuffled_x_white = gsl_matrix_alloc(NCOMP,NVOX); // gsl_matrix_memcpy(shuffled_x_white, x_white); gsl_vector_view arow; #pragma omp parallel for private(i,arow) for (i = 0; i < x_white->size1; i++) { arow = gsl_matrix_row(shuffled_x_white,i); gsl_permute_vector (p, &arow.vector); } size_t start; gsl_matrix *unmixed = gsl_matrix_alloc(NCOMP,block); gsl_matrix *unm_logit = gsl_matrix_alloc(NCOMP,block); gsl_matrix *temp_I = gsl_matrix_alloc(NCOMP,NCOMP); gsl_matrix *ones = gsl_matrix_alloc(block,1); gsl_matrix_set_all(ones, 1.0); double max; gsl_matrix_view sub_x_white_view; // gsl_matrix *d_unmixer = gsl_matrix_alloc(NCOMP,NCOMP); for (start = 0; start < NVOX; start = start + block) { if (start + block > NVOX-1){ block = NVOX-start; gsl_matrix_free(ib); ib = gsl_matrix_alloc(1,block); gsl_matrix_set_all( ib, 1.0); gsl_matrix_free(unmixed); unmixed = gsl_matrix_alloc(NCOMP,block); gsl_matrix_free(unm_logit); unm_logit = gsl_matrix_alloc(NCOMP,block); gsl_matrix_free(ones); ones = gsl_matrix_alloc(block,1); gsl_matrix_set_all(ones, 1.0); } // sub_x_white = xwhite[:, permute[start:start+block]] sub_x_white_view = gsl_matrix_submatrix(shuffled_x_white, 0,start, NCOMP, block ); // Compute unmixed = weights . sub_x_white + bias . ib matrix_mmul(weights, &sub_x_white_view.matrix, unmixed); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, bias, ib, 1.0, unmixed); // Compute 1-2*logit gsl_matrix_memcpy(unm_logit, unmixed); matrix_apply_all(unm_logit, logit); // weights = weights + lrate*(block*I+(unm_logit*unmixed.T))*weights gsl_matrix_set_identity(temp_I); // temp_I = I // (1) temp_I = block*temp_I +unm_logit*unmixed.T gsl_blas_dgemm( CblasNoTrans,CblasTrans, 1.0, unm_logit, unmixed, (double)block , temp_I); // BE CAREFUL with aliasing here! use d_unmixer if problems arise // gsl_matrix_memcpy(d_unmixer, weights); // (2) weights = weights + lrate*temp_I*weights gsl_blas_dgemm( CblasNoTrans,CblasNoTrans, lrate, temp_I, weights, 1.0, weights); // Update the bias gsl_blas_dgemm( CblasNoTrans, CblasNoTrans, lrate, unm_logit, ones, 1.0, bias); // check if blows up max = gsl_matrix_max(weights); if (max > MAX_W){ if (lrate<1e-6) { printf("\nERROR: Weight matrix may not be invertible\n"); error = 2; break; } error = 1; break; } } // set number of threads back to normal // openblas_set_num _threads(MAX_THREAD); //clean up // gsl_rng_free (r); // gsl_permutation_free (p); // gsl_matrix_free(d_unmixer); gsl_matrix_free(ib); gsl_matrix_free(unmixed); gsl_matrix_free(temp_I); gsl_matrix_free(ones); gsl_matrix_free(unm_logit); // gsl_matrix_free(shuffled_x_white); return(error); }
int main(int argc, char **argv) { gsl_matrix *Original; gsl_matrix *Mtr_Cov; FILE *input; int num_lineas; int i,j,k; double var; /*--------------------------------------------------------- Verifica cuales archivos fueron usados como input y se asegura de que solo haya cargado uno. -----------------------------------------------------------*/ printf("Este programa se ejecutó con %d argumento(s):\n",argc-1); for(i=1;i<argc;i++){ printf("%s\n", argv[i]); } if(argc!=2){ printf("se necesita 1 argumento además del nombre del ejecutable!,\n EXIT!\n"); exit(1); } else{ printf("El archivo a usar es %s\n", argv[1]); } //-------------------------------------------------------- input=fopen(argv[1],"r"); if(!input){ printf("surgió un problema abriendo el archivo\n"); exit(1); } /*--------------------------------------------------------- toma como archivo base el primer argumento y cuenta sus lineas -----------------------------------------------------------*/ num_lineas=0; while ((var = fgetc(input)) != EOF){ if (var =='\n') ++num_lineas; } //printf("Número de lineas del archivo:\n -->%d\n",num_lineas); /*--------------------------------------------------------- Data allocation -----------------------------------------------------------*/ rewind(input); Original=gsl_matrix_alloc((num_lineas),24); // printf("\nOriginal\n"); gsl_matrix_fscanf(input,Original); //gsl_matrix_fprintf (stdout, Original, "%g"); //CheckPoint //printf("matriz escaneada\n"); /*--------------------------------------------------------- Promedio -----------------------------------------------------------*/ float *prom; int y; prom=malloc((num_lineas) * sizeof(float)); //printf("...\n"); for(k=0;k<num_lineas;k++){ float suma=0.0; for(y=0;y<24;y++){ suma+=gsl_matrix_get(Original,k,y); } prom[k]=suma/24.0; } printf("Checkpoint... Promedios\n"); /*--------------------------------------------------------- Efectos en la matriz -----------------------------------------------------------*/ Mtr_Cov=gsl_matrix_alloc(num_lineas,num_lineas); //printf("...\n"); int l,n,m; double sprite=0; for(l=0;l<num_lineas;l++){ for(m=0;m<num_lineas;m++){ for(n=1;n<24;n++){ double flan=gsl_matrix_get(Original,m,n); double agua=prom[m]; double frutino=gsl_matrix_get(Original,l,n); double tang=prom[l]; double jarra1=(flan-agua); double jarra2=(frutino-tang); //printf("%g %g\n",jarra1,jarra2); sprite=sprite+(jarra1*jarra2)/24; } gsl_matrix_set(Mtr_Cov,m,l,sprite); sprite=0; }} /*--------------------------------------------------------- Matriz de covarianza creada; sacar vectores y valores propios de la matriz. -----------------------------------------------------------*/ /* int pa,po; double can; for(pa=0;pa<num_lineas;pa++){ for(po=0;po<num_lineas;po++){ can=gsl_matrix_get(Mtr_Cov,po,pa); printf("%f ",can); } printf("\n"); } */ gsl_eigen_symmv_workspace * w = gsl_eigen_symmv_alloc (num_lineas); gsl_vector *eval = gsl_vector_alloc (num_lineas); gsl_matrix *evec = gsl_matrix_alloc (num_lineas,num_lineas); gsl_eigen_symmv (Mtr_Cov, eval, evec, w); gsl_eigen_symmv_sort (eval, evec,GSL_EIGEN_SORT_ABS_ASC); /*--------------------------------------------------------- PON ESA COSA HORROROSA AHI O VERAS!!! -----------------------------------------------------------*/ FILE *Out1; FILE *Out2; Out1 = fopen("JorgeHayek_eigenvalues.dat", "w"); Out2 = fopen("JorgeHayek_eigenvectors.dat", "w"); fprintf(Out1,"EigenValues:\n"); fprintf(Out2,"EigenVectors:\n"); for (i = 0; i < num_lineas; i++) { double eval_i = gsl_vector_get (eval, i); fprintf (Out1,"%g\n", eval_i); } for (i = 0; i < 11; i++) {fprintf(Out2,"--------------------------------------------\nVector %d\n--------------------------------------------\n",i); gsl_vector_view evec_i = gsl_matrix_column (evec, i); gsl_vector_fprintf (Out2, &evec_i.vector, "%g"); } /*--------------------------------------------------------- FIN -----------------------------------------------------------*/ gsl_vector_free (eval); gsl_matrix_free (evec); gsl_matrix_free(Original); fclose(input); return 0; }
int DPMHC_xi_smplr(struct str_DPMHC *ptr_DPMHC_data, int i_J, struct str_firm_data *a_firm_data) { int j,i; int i_K = ptr_DPMHC_data->i_K; int i_n = ptr_DPMHC_data->v_y->size; // is this the same as i_J??? if (i_n != i_J){ fprintf(stderr,"Error in DPMN_xi_smplr(): DPMHC.v_y length does not equal i_J\n"); exit(1); } double d_sumT_si; gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S; gsl_matrix *m_theta = ptr_DPMHC_data->m_DPtheta; double d_A = ptr_DPMHC_data->d_A; double d_mu_si, d_tau_si, d_ei; double d_mean_j, d_var_j; double d_xi_j; int i_Ti; int i_factors = (a_firm_data[0].v_beta)->size; gsl_vector *v_ret; gsl_matrix *m_factors; gsl_vector *v_betai; gsl_vector *v_rstar_i; gsl_matrix *m_Xi; gsl_matrix_view mv_Xi; double d_rstar_j; double d_s2i; for(j=0;j<i_K;j++){ d_mu_si = mget(m_theta,j,0); d_tau_si = mget(m_theta,j,2); d_rstar_j = 0.; d_sumT_si = 0; for(i=0;i<i_J;i++){ if( vget_int(vi_S,i) == j ){ d_ei = vget(ptr_DPMHC_data->v_e,i); m_factors = a_firm_data[i].m_factors; i_Ti = a_firm_data[i].i_ni; d_s2i = a_firm_data[i].d_s2; m_Xi = gsl_matrix_alloc(i_Ti,i_factors); mv_Xi = gsl_matrix_submatrix(m_factors,0,0,i_Ti,i_factors); gsl_matrix_memcpy(m_Xi,&mv_Xi.matrix); v_betai = a_firm_data[i].v_beta; v_ret = a_firm_data[i].v_ret; v_rstar_i = gsl_vector_alloc(i_Ti); gsl_vector_memcpy(v_rstar_i,v_ret); gsl_blas_dgemv(CblasNoTrans, -1.0, m_Xi, v_betai, 1.0, v_rstar_i); gsl_vector_add_constant(v_rstar_i, -d_mu_si); gsl_vector_scale(v_rstar_i, 1./(sqrt(d_tau_si) * d_ei) ); d_rstar_j += sum(v_rstar_i); d_sumT_si += i_Ti/(d_s2i/(d_tau_si * d_ei * d_ei) ); gsl_matrix_free(m_Xi); gsl_vector_free(v_rstar_i); } } d_var_j = 1./( 1./(d_A * d_A) + d_sumT_si); d_mean_j = d_rstar_j * d_var_j; d_xi_j = d_mean_j + gsl_ran_gaussian_ziggurat(rng, sqrt(d_var_j) ); mset(m_theta, j, 1, d_xi_j); // printf("%d: eta = %g lambda^2 = %g\n",j, mget(m_theta,j,0), mget(m_theta,j,1) ); } return 0; }
void Spectrometer::countAmplitudes_bulk_B(Medium &Osrodek, QString DataName, QProgressBar *Progress, QTextBrowser *Browser, double kx, double ky, double w, int polarisation, double x_lenght, double y_lenght, double precision) { double a=Osrodek.itsBasis.getLatticeConstant(); int RecVec=itsRecVectors; int dimension=3*(2*RecVec+1)*(2*RecVec+1); std::ofstream plik; DataName="results/amplitudes/"+ DataName + ".dat"; QByteArray bytes = DataName.toAscii(); const char * CDataName = bytes.data(); plik.open(CDataName); //inicjalizacje wektorów i macierzy gsl_matrix *gamma=gsl_matrix_calloc(dimension, dimension); gsl_matrix *V=gsl_matrix_calloc(dimension, dimension); gsl_vector *S=gsl_vector_calloc(dimension); gsl_vector *work=gsl_vector_calloc(dimension); //gamma dla Podłoża /* S - numeruje transformaty tensora sprężystoci i gestosci i - numeruje wiersze macierzy j - numeruje kolumny macierzy */ for(int Nx=-RecVec, i=0, S=0; Nx<=RecVec; Nx++) { for(int Ny=-RecVec; Ny<=RecVec; Ny++, i=i+3) { for(int Nx_prim=-RecVec, j=0; Nx_prim<=RecVec; Nx_prim++) { for(int Ny_prim=-RecVec; Ny_prim<=RecVec; Ny_prim++, j=j+3, S++) { double Elasticity[6][6]; itsRecBasisSubstance[S].getElasticity(Elasticity); double Density=itsRecBasisSubstance[S].getDensity(); double gx=2*M_PI*Nx/a; double gy=2*M_PI*Ny/a; double gx_prim=2*M_PI*Nx_prim/a; double gy_prim=2*M_PI*Ny_prim/a; gsl_matrix_set(gamma, i, j, Elasticity[0][0]*(kx+gx)*(kx+gx_prim)+Elasticity[3][3]*(ky+gy)*(ky+gy_prim)-Density*w*w); gsl_matrix_set(gamma, i+1, j, Elasticity[0][1]*(kx+gx_prim)*(ky+gy)+Elasticity[3][3]*(ky+gy_prim)*(kx+gx)); gsl_matrix_set(gamma, i, j+1, Elasticity[0][1]*(ky+gy_prim)*(kx+gx)+Elasticity[3][3]*(kx+gx_prim)*(ky+gy)); gsl_matrix_set(gamma, i+1, j+1, Elasticity[0][0]*(ky+gy_prim)*(ky+gy)+Elasticity[3][3]*(kx+gx_prim)*(kx+gx)-Density*w*w); gsl_matrix_set(gamma, i+2, j+2, Elasticity[3][3]*(ky+gy_prim)*(ky+gy)+Elasticity[3][3]*(kx+gx_prim)*(kx+gx)-Density*w*w); } } } } //rozwiązanie układu równań gsl_linalg_SV_decomp(gamma, V, S, work); gsl_complex u; double Gx, Gy; if (polarisation==3) { gsl_complex ux, uy, uz; for(double x=0; x < x_lenght; x=x+precision) { for(double y=0; y < y_lenght; y=y+precision) { ux = gsl_complex_rect(0, 0); uy = gsl_complex_rect(0, 0); uz = gsl_complex_rect(0, 0); //pasek postepu int postep=int(100*x/x_lenght); Progress->setValue(postep); Progress->update(); QApplication::processEvents(); for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) { for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) { Gx=2*M_PI*Nx/a; Gy=2*M_PI*Ny/a; double Ax = gsl_matrix_get(V, i, dimension-1); double Ay = gsl_matrix_get(V, i+1, dimension-1); double Az = gsl_matrix_get(V, i+2, dimension-1); gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); gsl_complex exp1 = gsl_complex_exp(expin1); gsl_complex multiply = gsl_complex_mul_real(exp1, Ax); ux = gsl_complex_add(ux, multiply); expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); exp1 = gsl_complex_exp(expin1); multiply = gsl_complex_mul_real(exp1, Ay); uy = gsl_complex_add(uy, multiply); expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); exp1 = gsl_complex_exp(expin1); multiply = gsl_complex_mul_real(exp1, Az); uz = gsl_complex_add(uz, multiply); } } double U = sqrt(gsl_complex_abs(ux)*gsl_complex_abs(ux)+gsl_complex_abs(uy)*gsl_complex_abs(uy)+gsl_complex_abs(uz)*gsl_complex_abs(uz)); //zapisanie wartości do pliku QString nazwa = Osrodek.itsBasis.getFillingSubstance().getName(); if(nazwa=="Air") { double rad=Osrodek.itsBasis.getRadius(); if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad) { plik << x << "\t" << y << "\t" << U << "\n"; } } else { plik << x << "\t" << y << "\t" << U << "\n"; } } plik << "\n"; } } else if (polarisation==4) { gsl_complex uxx, uxy, uxz, uyx, uyy, uyz, uzx, uzy, uzz; double Uxx, Uxy, Uxz, Uyx, Uyy, Uyz, Uzx, Uzy, Uzz; for(double x=0; x < x_lenght; x=x+precision) { for(double y=0; y < y_lenght; y=y+precision) { uxx = gsl_complex_rect(0, 0); uxy = gsl_complex_rect(0, 0); uxz = gsl_complex_rect(0, 0); uyx = gsl_complex_rect(0, 0); uyy = gsl_complex_rect(0, 0); uyz = gsl_complex_rect(0, 0); uzx = gsl_complex_rect(0, 0); uzy = gsl_complex_rect(0, 0); uzz = gsl_complex_rect(0, 0); double rad=Osrodek.itsBasis.getRadius(); double Ela[6][6]; if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad) { Osrodek.itsBasis.getSubstance().getElasticity(Ela); } else { Osrodek.itsBasis.getFillingSubstance().getElasticity(Ela); } //pasek postepu int postep=int(100*x/x_lenght); Progress->setValue(postep); Progress->update(); QApplication::processEvents(); for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) { for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) { Gx=2*M_PI*Nx/a; Gy=2*M_PI*Ny/a; double Ax = gsl_matrix_get(V, i, dimension-1); double Ay = gsl_matrix_get(V, i+1, dimension-1); double Az = gsl_matrix_get(V, i+2, dimension-1); gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); gsl_complex exp1 = gsl_complex_exp(expin1); gsl_complex multiply = gsl_complex_mul_real(exp1, Ax); //uxx gsl_complex multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx)); uxx = gsl_complex_add(uxx, multidiff); //uxy multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy)); uxy = gsl_complex_add(uxy, multidiff); expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); exp1 = gsl_complex_exp(expin1); //uy multiply = gsl_complex_mul_real(exp1, Ay); //uyx multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx)); uyx = gsl_complex_add(uyx, multidiff); //uyy multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy)); uyy = gsl_complex_add(uyy, multidiff); expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); exp1 = gsl_complex_exp(expin1); multiply = gsl_complex_mul_real(exp1, Az); //uzx multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx)); uzx = gsl_complex_add(uzx, multidiff); //uzy multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy)); uzy = gsl_complex_add(uzy, multidiff); } } Uxx=gsl_complex_abs(uxx); Uxy=gsl_complex_abs(uxy); Uxz=gsl_complex_abs(uxz); Uyx=gsl_complex_abs(uyx); Uyy=gsl_complex_abs(uyy); Uyz=gsl_complex_abs(uyz); Uzx=gsl_complex_abs(uzx); Uzy=gsl_complex_abs(uzy); Uzz=gsl_complex_abs(uzz); double U = Ela[0][0]*(Uxx*Uxx+Uyy*Uyy+Uzz*Uzz)+2*Ela[0][1]*(Uxx*Uyy+Uxx*Uzz+Uyy*Uzz)+0.25*Ela[3][3]*((Uyz+Uzy)*(Uyz+Uzy)+(Uxz+Uzx)*(Uxz+Uzx)+(Uxy+Uyx)*(Uxy+Uyx)); //zapisanie wartości do pliku QString nazwa = Osrodek.itsBasis.getFillingSubstance().getName(); if(nazwa=="Air") { double rad=Osrodek.itsBasis.getRadius(); if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad) { plik << x << "\t" << y << "\t" << U << "\n"; } } else { plik << x << "\t" << y << "\t" << U << "\n"; } } plik << "\n"; } } else { for(double x=0; x < x_lenght; x=x+precision) { for(double y=0; y < y_lenght; y=y+precision) { u = gsl_complex_rect(0, 0); //pasek postepu int postep=int(100*x/x_lenght); Progress->setValue(postep); Progress->update(); QApplication::processEvents(); for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) { for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) { Gx=2*M_PI*Nx/a; Gy=2*M_PI*Ny/a; double A = gsl_matrix_get(V, i+polarisation, dimension-1); gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y); gsl_complex exp1 = gsl_complex_exp(expin1); gsl_complex multiply = gsl_complex_mul_real(exp1, A); u = gsl_complex_add(u, multiply); } } double U = gsl_complex_abs(u); //zapisanie wartości do pliku plik << x << "\t" << y << "\t" << U << "\n"; } plik << "\n"; } } plik.close(); gsl_matrix_free(gamma); gsl_matrix_free(V); gsl_vector_free(S); gsl_vector_free(work); }
/** * Set up a full multi-dimensional grid-scan. * Currently this only emulates a 'factored' grid-scan with 'sky x Freq x f1dot ...' , but * keeps all details within the DopplerScan module for future extension to real multidimensional * grids. * * NOTE: Use 'XLALNextDopplerPos()' to step through this template grid. * */ DopplerFullScanState * XLALInitDopplerFullScan ( const DopplerFullScanInit *init /**< [in] initialization parameters */ ) { XLAL_CHECK_NULL ( init != NULL, XLAL_EINVAL ); DopplerFullScanState *thisScan; XLAL_CHECK_NULL ( (thisScan = LALCalloc (1, sizeof(*thisScan) )) != NULL, XLAL_ENOMEM ); thisScan->gridType = init->gridType; /* store the user-input spinRange (includes refTime) in DopplerFullScanState */ thisScan->spinRange.refTime = init->searchRegion.refTime; memcpy ( thisScan->spinRange.fkdot, init->searchRegion.fkdot, sizeof(PulsarSpins) ); memcpy ( thisScan->spinRange.fkdotBand, init->searchRegion.fkdotBand, sizeof(PulsarSpins) ); // check that some old metric-codes aren't used with refTime!=startTime, which they don't handle correctly switch ( thisScan->gridType ) { case GRID_METRIC: case GRID_METRIC_SKYFILE: case GRID_SPINDOWN_SQUARE: /* square parameter space */ case GRID_SPINDOWN_AGEBRK: /* age-braking index parameter space */ XLAL_CHECK_NULL ( XLALGPSDiff ( &init->startTime, &init->searchRegion.refTime ) == 0, XLAL_EINVAL, "NOTE: gridType={metric,4,spin-square,spin-age-brk} only work for refTime (%f) == startTime (%f)!\n", XLALGPSGetREAL8(&(init->searchRegion.refTime)), XLALGPSGetREAL8(&(init->startTime)) );; break; default: break; } /* which "class" of template grid to generate?: factored, or full-multidim ? */ switch ( thisScan->gridType ) { /* emulate old 'factored' grids 'sky x f0dot x f1dot x f2dot x f3dot': */ case GRID_FLAT: case GRID_ISOTROPIC: case GRID_METRIC: case GRID_FILE_SKYGRID: case GRID_METRIC_SKYFILE: /* backwards-compatibility mode */ XLAL_CHECK_NULL ( XLALInitFactoredGrid ( thisScan, init ) == XLAL_SUCCESS, XLAL_EFUNC ); break; /* ----- multi-dimensional covering of full parameter space ----- */ case GRID_FILE_FULLGRID: XLAL_CHECK_NULL ( XLALLoadFullGridFile ( thisScan, init ) == XLAL_SUCCESS, XLAL_EFUNC ); break; case GRID_SPINDOWN_SQUARE: /* square parameter space */ case GRID_SPINDOWN_AGEBRK: /* age-braking index parameter space */ { const size_t n = 2 + PULSAR_MAX_SPINS; /* Check that the reference time is the same as the start time */ XLAL_CHECK_NULL ( XLALGPSCmp ( &thisScan->spinRange.refTime, &init->startTime) == 0, XLAL_EINVAL, "\nGRID_SPINDOWN_{SQUARE,AGEBRK}: This option currently restricts the reference time to be the same as the start time.\n"); /* Create a vector to hold lattice tiling parameter-space points */ XLAL_CHECK_NULL ( (thisScan->spindownTilingPoint = gsl_vector_alloc(n)) != NULL, XLAL_ENOMEM, "\nGRID_SPINDOWN_{SQUARE,AGEBRK}: gsl_vector_alloc failed\n"); /* Create a lattice tiling */ XLAL_CHECK_NULL ( (thisScan->spindownTiling = XLALCreateLatticeTiling(n)) != NULL, XLAL_EFUNC ); /* Parse the sky region string and check that it consists of only one point, and set bounds on it */ SkyRegion XLAL_INIT_DECL(sky); XLAL_CHECK_NULL ( XLALParseSkyRegionString ( &sky, init->searchRegion.skyRegionString ) == XLAL_SUCCESS, XLAL_EFUNC ); XLAL_CHECK_NULL ( sky.numVertices == 1, XLAL_EINVAL, "\nGRID_SPINDOWN_{SQUARE,AGEBRK}: This option can only handle a single sky position.\n"); XLAL_CHECK_NULL ( sky.vertices[0].system == COORDINATESYSTEM_EQUATORIAL, XLAL_EINVAL, "\nGRID_SPINDOWN_{SQUARE,AGEBRK}: This option only understands COORDINATESYSTEM_EQUATORIAL\n"); XLAL_CHECK_NULL ( XLALSetLatticeTilingConstantBound(thisScan->spindownTiling, 0, sky.vertices[0].longitude, sky.vertices[0].longitude) == XLAL_SUCCESS, XLAL_EFUNC ); XLAL_CHECK_NULL ( XLALSetLatticeTilingConstantBound(thisScan->spindownTiling, 1, sky.vertices[0].latitude, sky.vertices[0].latitude) == XLAL_SUCCESS, XLAL_EFUNC ); if (sky.vertices) { XLALFree (sky.vertices); } /* Set up parameter space */ if (thisScan->gridType == GRID_SPINDOWN_SQUARE) { /* square parameter space */ /* Set square bounds on the frequency and spindowns */ for (size_t i = 0; i < PULSAR_MAX_SPINS; ++i) { XLAL_CHECK_NULL ( XLALSetLatticeTilingConstantBound(thisScan->spindownTiling, 2 + i, init->searchRegion.fkdot[i], init->searchRegion.fkdot[i] + init->searchRegion.fkdotBand[i]) == XLAL_SUCCESS, XLAL_EFUNC ); } } else if (thisScan->gridType == GRID_SPINDOWN_AGEBRK) { /* age-braking index parameter space */ /* Get age and braking index from extra arguments */ const REAL8 spindownAge = init->extraArgs[0]; const REAL8 minBraking = init->extraArgs[1]; const REAL8 maxBraking = init->extraArgs[2]; /* Set age-braking index parameter space */ XLAL_CHECK_NULL ( XLAL_SUCCESS == XLALSetLatticeTilingConstantBound(thisScan->spindownTiling, 2, init->searchRegion.fkdot[0], init->searchRegion.fkdot[0] + init->searchRegion.fkdotBand[0]), XLAL_EFUNC ); XLAL_CHECK_NULL ( XLAL_SUCCESS == XLALSetLatticeTilingF1DotAgeBrakingBound(thisScan->spindownTiling, 2, 3, spindownAge, minBraking, maxBraking), XLAL_EFUNC ); XLAL_CHECK_NULL ( XLAL_SUCCESS == XLALSetLatticeTilingF2DotBrakingBound(thisScan->spindownTiling, 2, 3, 4, minBraking, maxBraking), XLAL_EFUNC ); /* This current only goes up to second spindown, so bound higher dimensions */ for (size_t i = 3; i < PULSAR_MAX_SPINS; ++i) { XLAL_CHECK_NULL ( XLAL_SUCCESS == XLALSetLatticeTilingConstantBound(thisScan->spindownTiling, 2 + i, init->searchRegion.fkdot[i], init->searchRegion.fkdot[i] + init->searchRegion.fkdotBand[i]), XLAL_EFUNC ); } } /* Create a lattice tiling with Anstar lattice and spindown metric */ gsl_matrix* metric; XLAL_CHECK_NULL ( (metric = gsl_matrix_alloc(n, n)) != NULL, XLAL_ENOMEM ); gsl_matrix_set_identity(metric); gsl_matrix_view spin_metric = gsl_matrix_submatrix(metric, 2, 2, PULSAR_MAX_SPINS, PULSAR_MAX_SPINS); XLAL_CHECK_NULL ( XLALSpindownMetric(&spin_metric.matrix, init->Tspan) == XLAL_SUCCESS, XLAL_EFUNC ); XLAL_CHECK_NULL ( XLALSetTilingLatticeAndMetric(thisScan->spindownTiling, "Ans", metric, init->metricMismatch) == XLAL_SUCCESS, XLAL_EFUNC ); /* Create iterator over flat lattice tiling */ XLAL_CHECK_NULL ( (thisScan->spindownTilingItr = XLALCreateLatticeTilingIterator(thisScan->spindownTiling, n)) != NULL, XLAL_EFUNC ); /* Cleanup */ gsl_matrix_free(metric); } break; default: XLAL_ERROR_NULL ( XLAL_EINVAL, "\nInvalid grid type '%d'\n\n", init->gridType ); break; } /* switch gridType */ /* we're ready */ thisScan->state = STATE_READY; /* return result */ return thisScan; } // XLALInitDopplerFullScan()
//Fitting. Allow fitting multiple q curves simultaneously to decrease the chance of converging to local minimum. void ddm::fitting() { int cnum_fit=num_fit; int ctimeWindow=timeWindow; //Find the truncation time if time window is set for (int itert=0; itert<num_fit; ++itert) { if (tau[itert]>ctimeWindow) { cnum_fit=itert; break; } } //Local variables int cqsize=qsize-qIncreList[num_qCurve-1]; //number of fitting result int cnum_qCurve=num_qCurve; int ctnum_fit=cnum_fit*num_qCurve; int cnumOfPara=numOfPara+2*num_qCurve; //Total number of parameters fittedPara=gsl_matrix_alloc(cqsize, cnumOfPara); //To store the fitting result and error. fitErr=gsl_matrix_alloc(cqsize, cnumOfPara); status = new int[cqsize]; //Record the status of fitting. //Using Levenberg-Marquardt algorithm as implemented in the scaled lmder routine in minpack. Jacobian is given. const gsl_multifit_fdfsolver_type *solverType = gsl_multifit_fdfsolver_lmsder; int progress=0; //Indicator of progress. //Objects to do numerical inverse Laplace transformation #ifdef ISFRTD NILT NILT1(OMP_NUM_THREADS), NILT2(OMP_NUM_THREADS), NILT3(OMP_NUM_THREADS), NILT4(OMP_NUM_THREADS); #endif #ifdef ISFRTDP NILT NILT1(OMP_NUM_THREADS), NILT2(OMP_NUM_THREADS), NILT3(OMP_NUM_THREADS), NILT4(OMP_NUM_THREADS), NILT5(OMP_NUM_THREADS); #endif #ifdef ISFRTDPTT NILT NILT1(OMP_NUM_THREADS), NILT2(OMP_NUM_THREADS), NILT3(OMP_NUM_THREADS), NILT4(OMP_NUM_THREADS), NILT5(OMP_NUM_THREADS), NILT6(OMP_NUM_THREADS); #endif #ifdef ISFRTDPfix NILT NILT1(OMP_NUM_THREADS), NILT2(OMP_NUM_THREADS); const long double vbar=vbarGuess; const long double sigma=sigmaGuess; const long double vbsigma2=vbar/sigma/sigma; const long double vb2sigma2=vbsigma2*vbar; const long double logvbsigma2=log(vbsigma2); const long double logfactor=vb2sigma2*logvbsigma2-gsl_sf_lngamma(vb2sigma2); const long double cpsiz1=logvbsigma2-gsl_sf_psi(vb2sigma2); const long double vb2sigma3=vb2sigma2/sigma; #endif #ifdef ISFRTDPTTfix NILT NILT1(OMP_NUM_THREADS), NILT2(OMP_NUM_THREADS), NILT3(OMP_NUM_THREADS); const long double vbar=vbarGuess; const long double sigma=sigmaGuess; const long double vbsigma2=vbar/sigma/sigma; const long double vb2sigma2=vbsigma2*vbar; const long double logvbsigma2=log(vbsigma2); const long double logfactor=vb2sigma2*logvbsigma2-gsl_sf_lngamma(vb2sigma2); const long double cpsiz1=logvbsigma2-gsl_sf_psi(vb2sigma2); const long double vb2sigma3=vb2sigma2/sigma; #endif #pragma omp parallel for for (int iterq=0; iterq<cqsize; ++iterq) { //Data array which is going to present to the fitting algorithm double* datafit=new double[ctnum_fit]; double* qList=new double[cnum_qCurve]; double* time=new double[ctnum_fit]; //Truncate the data, and put multiple curves into one array for (int iterqc=0; iterqc<cnum_qCurve; ++iterqc) { for (int iterf = 0; iterf < cnum_fit; ++iterf) { datafit[iterf+iterqc*cnum_fit]=(gsl_matrix_get(datag, iterq+qIncreList[iterqc], iterf)); //Fitting in log scale. time[iterf+iterqc*cnum_fit]=tau[iterf]; } qList[iterqc]=qabs[iterq+qIncreList[iterqc]]; } gsl_multifit_function_fdf fitfun; //Pointer of function to fit. dataStruct sdata; //GSL data structure //Data is passed to ISFfun by sdata sdata.data=datafit; sdata.tau=time; sdata.q=qList; sdata.num_fit=cnum_fit; sdata.num_qCurve=cnum_qCurve; #ifdef ISFRTD sdata.ISFILT=&NILT1; sdata.dvISFILT=&NILT2; sdata.dDISFILT=&NILT3; sdata.dlambdaISFILT=&NILT4; #endif #ifdef ISFRTDP sdata.ISFILT=&NILT1; sdata.dvbarISFILT=&NILT2; sdata.dsigmaISFILT=&NILT3; sdata.dDISFILT=&NILT4; sdata.dlambdaISFILT=&NILT5; #endif #ifdef ISFRTDPTT sdata.ISFILT=&NILT1; sdata.dvbarISFILT=&NILT2; sdata.dsigmaISFILT=&NILT3; sdata.dDISFILT=&NILT4; sdata.dlambdaISFILT=&NILT5; sdata.dTTISFILT=&NILT6; #endif #ifdef ISFRTDPfix sdata.alpha=alphaGuess; sdata.D=DGuess; sdata.vbar=vbar; sdata.sigma=sigma; sdata.vbsigma2=vbsigma2; sdata.logfactor=logfactor; sdata.vb2sigma2=vb2sigma2; sdata.cpsiz1=cpsiz1; sdata.vb2sigma3=vb2sigma3; sdata.ISFILT=&NILT1; sdata.dlambdaISFILT=&NILT2; #endif #ifdef ISFRTDPTTfix sdata.alpha=alphaGuess; sdata.D=DGuess; sdata.vbar=vbar; sdata.sigma=sigma; sdata.vbsigma2=vbsigma2; sdata.logfactor=logfactor; sdata.vb2sigma2=vb2sigma2; sdata.cpsiz1=cpsiz1; sdata.vb2sigma3=vb2sigma3; sdata.ISFILT=&NILT1; sdata.dlambdaISFILT=&NILT2; sdata.dTTISFILT=&NILT3; #endif //API fitfun.f=&ISFfun; #ifdef NoJacobian fitfun.df=0; fitfun.fdf=0; #else fitfun.df=&dISFfun; fitfun.fdf=&fdISFfun; #endif fitfun.n=ctnum_fit; fitfun.p=cnumOfPara; fitfun.params=&sdata; //Initialization of the parameters double* localinipara=new double[cnumOfPara]; for (int iterp=0; iterp<numOfPara; ++iterp) { localinipara[iterp]=inipara[iterp]; } //Estimation of A(q) and B(q) for (int iterqc=0; iterqc<num_qCurve; ++iterqc) { localinipara[numOfPara+1+2*iterqc] = gsl_matrix_get(datag, iterq+qIncreList[iterqc], 0); localinipara[numOfPara+2*iterqc] = gsl_matrix_get(datag, iterq+qIncreList[iterqc], num_fit-1)-localinipara[numOfPara+1+2*iterqc]; } //Initiallization of the solver gsl_vector_view para=gsl_vector_view_array(localinipara, cnumOfPara); gsl_multifit_fdfsolver* solver = gsl_multifit_fdfsolver_alloc(solverType, ctnum_fit, cnumOfPara); gsl_multifit_fdfsolver_set(solver, &fitfun, ¶.vector); int iter=0; //gsl_vector* g=gsl_vector_alloc(numOfPara); //For debugging and monitering the iterations // cout << qList[0] << ' ' << qList[1] << '\n'; // for (int iterpara=0; iterpara<cnumOfPara; ++iterpara) // { // cout << gsl_vector_get(solver->x, iterpara) << '\n'; // } // cout << '\n'; int cstatus=GSL_CONTINUE; //Current status do { gsl_multifit_fdfsolver_iterate(solver); //Iterate one step. cstatus = norm0_rel_test(solver->dx, solver->x, 1e-7, 1e-7); //Test the exiting criteria //For debugging and monitering the iterations // for (int iterpara=0; iterpara<cnumOfPara; ++iterpara) // { // cout << gsl_vector_get(solver->x, iterpara) << '\n'; // } // cout << '\n'; //If to use other exiting criteria //gsl_multifit_gradient(solver->J,solver->f, g); //status[iterq-1]=gsl_multifit_test_gradient(g, 1e-5); // status[iterq - 1] = covar_rel_test(solver->J, solver->x, 1e-4); ++iter; //Number of iterations exceed certain limitation if (iter>maxIter) { cstatus=GSL_EMAXITER; } } while (cstatus == GSL_CONTINUE); status[iterq]=cstatus; //gsl_vector_free(g); //Estimating the error. gsl_matrix* covar=gsl_matrix_alloc(cnumOfPara, cnumOfPara); gsl_multifit_covar(solver->J, 0.0, covar); for (int iterpara=0; iterpara<cnumOfPara; ++iterpara) //Record result. { gsl_matrix_set(fittedPara, iterq, iterpara, gsl_vector_get(solver->x, iterpara) ); gsl_matrix_set(fitErr, iterq, iterpara, sqrt(gsl_matrix_get(covar, iterpara, iterpara)) ); //Not presice in log scale } gsl_matrix_free(covar); gsl_multifit_fdfsolver_free(solver); //Output to standard I/O progress+=1; cout << "Fitted q=" << qabs[iterq] << " at iter=" << iter << ", " << 100.0*progress / qsize << "% completed from thread No." << omp_get_thread_num() << ", "<< gsl_strerror(status[iterq]) << "." << '\n'; for (int iterpara=0; iterpara<cnumOfPara; ++iterpara) { cout << gsl_matrix_get(fittedPara, iterq, iterpara) << '\n'; } cout << '\n'; delete [] datafit; delete [] qList; delete [] localinipara; delete [] time; } }
QMap<double, double> SGMResolutionOptimization::curve(QList<QVariant> stateParameters, AMRegionsList* contextParameters){ double _maxenergy = maximumEnergy(contextParameters); double _minenergy = minimumEnergy(contextParameters); double _slit = stateParameters.at(0).toDouble(); double _y1, _y2, _y3, _x1, _x2, _x3; double _maxRes = 0; SGMBeamlineInfo::sgmGrating _grating = (SGMBeamlineInfo::sgmGrating)stateParameters.at(1).toInt(); SGMBeamlineInfo::sgmHarmonic _harmonic = (SGMBeamlineInfo::sgmHarmonic)stateParameters.at(2).toInt(); if(!SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy)) { } else if((_harmonic == 3) && (_grating == 2)){ _y1 = (0.95)*(0.5229*log(_slit)+1.4221); _y2 = (0.95)*(0.4391*log(_slit)+1.2617); _y3 = (0.95)*(0.421*log(_slit)+0.9037); _x1 = 2000; _x2 = 1200; _x3 = 800; _maxRes = 12500; } else{ if( (_grating == 0) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){ _y1 = 0.4568*log(_slit)+1.0199; _y2 = 0.4739*log(_slit)+0.605; _y3 = 0.4257*log(_slit)+0.4438; _x1 = 600; _x2 = 400; _x3 = 250; _maxRes = 17500; } else if( (_grating == 1) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){ _y1 = 0.425*log(_slit)+1.4936; _y2 = 0.4484*log(_slit)+1.0287; _y3 = 0.4029*log(_slit)+0.7914; _x1 = 1200; _x2 = 800; _x3 = 500; _maxRes = 15000; } else if( (_grating == 2) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){ _y1 = 0.5229*log(_slit)+1.4221; _y2 = 0.4391*log(_slit)+1.2617; _y3 = 0.421*log(_slit)+0.9037; _x1 = 2000; _x2 = 1200; _x3 = 800; _maxRes = 13750; } } int i, n; double xi, yi, ei, chisq; gsl_matrix *X, *cov; gsl_vector *y, *w, *c; n = 3; X = gsl_matrix_alloc (n, 3); y = gsl_vector_alloc (n); w = gsl_vector_alloc (n); c = gsl_vector_alloc (3); cov = gsl_matrix_alloc (3, 3); double ix[3]; double iy[3]; double ie[3]; ix[0] = _x1; ix[1] = _x2; ix[2] = _x3; iy[0] = _y1; iy[1] = _y2; iy[2] = _y3; ie[0] = 0.1*iy[0]; ie[1] = 0.1*iy[1]; ie[2] = 0.1*iy[2]; for (i = 0; i < n; i++) { xi = ix[i]; yi = iy[i]; ei = ie[i]; gsl_matrix_set (X, i, 0, 1.0); gsl_matrix_set (X, i, 1, xi); gsl_matrix_set (X, i, 2, xi*xi); gsl_vector_set (y, i, yi); gsl_vector_set (w, i, 1.0/(ei*ei)); } gsl_multifit_linear_workspace * work = gsl_multifit_linear_alloc (n, 3); gsl_multifit_wlinear (X, w, y, c, cov, &chisq, work); gsl_multifit_linear_free (work); #define C(i) (gsl_vector_get(c,(i))) #define COV(i,j) (gsl_matrix_get(cov,(i),(j))) QMap<double, double> rCurve; double tmpStart, tmpEnd, tmpDelta;//, tmpVal; for( int x = 0; x < contextParameters->count(); x++){ tmpStart = contextParameters->start(x); tmpDelta = contextParameters->delta(x); tmpEnd = contextParameters->end(x); if( tmpStart >= 250 && tmpStart <= 2000 && tmpEnd >= 250 && tmpEnd <= 2000 ){ for( double y = tmpStart; ((tmpDelta > 0) ? (y <= tmpEnd) : (y >= tmpEnd)); y += tmpDelta ){ //rCurve[y] = !SGMBeamline::sgm()->energyValidForSettings(_grating, _harmonic, y) ? 0.0 :y/(pow(10, C(2)*y*y + C(1)*y + C(0))*1e-3); if(!SGMBeamlineInfo::sgmInfo()->energyValidForSettings(_grating, _harmonic, y)) rCurve[y] = 0.0; else{ rCurve[y] = y/(pow(10, C(2)*y*y + C(1)*y + C(0))*1e-3); } } } else rCurve[250] = 0; } gsl_matrix_free (X); gsl_vector_free (y); gsl_vector_free (w); gsl_vector_free (c); gsl_matrix_free (cov); return rCurve; }
void freeNbProposals(NbProposals *NbProp) { gsl_matrix_free(NbProp->NbProp_beta); free(NbProp); }
void freeIsAcceptOK(isAcceptOK *acceptOK) { gsl_matrix_free(acceptOK->IsAccOK_beta); free(acceptOK); }
void freeAcceptance(acceptance *accept) { gsl_matrix_free(accept->PourcAcc_beta); free(accept); }
/* Produce a vector of chisquared values as a function of frequency */ void fastChi(const double *sampletimes, const float *vals, const float *stderrs, long ndata, long nharmonics, double deltat, long nrealpoints, long nchivalues, double tstart, float *dovstorage, float *oovstorage, float *chireductionlist) { int d; int i; int h; float invdeltat = 1/deltat; gsl_matrix *alpha = gsl_matrix_alloc(2 * nharmonics + 1,2 * nharmonics + 1); gsl_vector *beta = gsl_vector_alloc(2 * nharmonics + 1); gsl_vector *x = gsl_vector_alloc(2 * nharmonics + 1); float *cosdata = malloc((nharmonics + 1) * sizeof(float)); float *sindata = malloc((nharmonics + 1) * sizeof(float)); float *cosvar = malloc((2*nharmonics + 1) * sizeof(float)); float *sinvar = malloc((2*nharmonics + 1) * sizeof(float)); /* if the pointers point somewhere, assume that they point to the right place */ assert(sampletimes && vals && stderrs && dovstorage && oovstorage && chireductionlist); assert(nchivalues * 2 * nharmonics <= nrealpoints); /* FIXME: change 2 to 1 when */ /* using aliasing */ assert(cosdata && sindata && cosvar && sinvar); memset(dovstorage, 0, nrealpoints * sizeof(float)); memset(oovstorage, 0, nrealpoints * sizeof(float)); for (d = 0 ; d < ndata ; d++) { long tindex = (sampletimes[d] - tstart) * invdeltat; float inv_variance = 1/(stderrs[d] * stderrs[d]); assert(tindex >= 0 && tindex < nrealpoints); /* adding rather than setting averages measurments that */ /* fall in same timebin. It does, however, reduce the d.o.f. */ /* and subsequently improperly reduces the chisquared. */ /* This is a minor point. */ /* dov: _d_ata _o_ver _v_ariance oov: _o_ne _o_ver _v_ariance */ dovstorage[tindex] += vals[d] * inv_variance; oovstorage[tindex] += inv_variance; } gsl_fft_real_float_radix2_transform(dovstorage, 1, nrealpoints); gsl_fft_real_float_radix2_transform(oovstorage, 1, nrealpoints); cosdata[0] = dovstorage[0]; /* The constant (0f) terms are the same for all f */ cosvar[0] = oovstorage[0]; for (i = 1 ; i < nchivalues ; i++) { for (h = 1 ; h <= nharmonics ; h++) { cosdata[h] = dovstorage[i*h]; sindata[h] = dovstorage[nrealpoints - (i * h)] * FFTSIGNCONVENTION; } for (h = 1 ; h <= 2*nharmonics ; h++) { /* put alias wrapping in here */ cosvar[h] = oovstorage[i*h]; sinvar[h] = oovstorage[nrealpoints - (i * h)] * FFTSIGNCONVENTION; } chireductionlist[i] = calcChiReduction(nharmonics, cosdata, sindata, cosvar, sinvar, alpha, beta, x); } gsl_matrix_free(alpha); gsl_vector_free(beta); gsl_vector_free(x); free(cosdata); free(sindata); free(cosvar); free(sinvar); }
void test_eigen_symm(void) { size_t N_max = 20; size_t n, i; gsl_rng *r = gsl_rng_alloc(gsl_rng_default); for (n = 1; n <= N_max; ++n) { gsl_matrix * A = gsl_matrix_alloc(n, n); for (i = 0; i < 5; ++i) { create_random_symm_matrix(A, r, -10, 10); test_eigen_symm_matrix(A, i, "symm random"); } gsl_matrix_free(A); } gsl_rng_free(r); { double dat1[] = { 0, 0, -1, 0, 0, 1, 0, 1, -1, 0, 0, 0, 0, 1, 0, 0 }; double dat2[] = { 1, 0, 0, 0, 0, 2, 0, 0, 0, 0, 3, 0, 0, 0, 0, 4 }; gsl_matrix_view m; m = gsl_matrix_view_array (dat1, 4, 4); test_eigen_symm_matrix(&m.matrix, 0, "symm(4)"); m = gsl_matrix_view_array (dat2, 4, 4); test_eigen_symm_matrix(&m.matrix, 0, "symm(4) diag"); } { double dat[27*27] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1, 0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0, 0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; gsl_matrix_view m; m = gsl_matrix_view_array (dat, 27, 27); test_eigen_symm_matrix(&m.matrix, 0, "symm(27)"); }; } /* test_eigen_symm() */
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 test_eigen_gensymm(void) { size_t N_max = 20; size_t n, i; gsl_rng *r = gsl_rng_alloc(gsl_rng_default); for (n = 1; n <= N_max; ++n) { gsl_matrix * A = gsl_matrix_alloc(n, n); gsl_matrix * B = gsl_matrix_alloc(n, n); gsl_matrix * ma = gsl_matrix_alloc(n, n); gsl_matrix * mb = gsl_matrix_alloc(n, n); gsl_vector * eval = gsl_vector_alloc(n); gsl_vector * evalv = gsl_vector_alloc(n); gsl_vector * x = gsl_vector_alloc(n); gsl_vector * y = gsl_vector_alloc(n); gsl_matrix * evec = gsl_matrix_alloc(n, n); gsl_eigen_gensymm_workspace * w = gsl_eigen_gensymm_alloc(n); gsl_eigen_gensymmv_workspace * wv = gsl_eigen_gensymmv_alloc(n); for (i = 0; i < 5; ++i) { create_random_symm_matrix(A, r, -10, 10); create_random_posdef_matrix(B, r); gsl_matrix_memcpy(ma, A); gsl_matrix_memcpy(mb, B); gsl_eigen_gensymmv(ma, mb, evalv, evec, wv); test_eigen_gensymm_results(A, B, evalv, evec, i, "random", "unsorted"); gsl_matrix_memcpy(ma, A); gsl_matrix_memcpy(mb, B); gsl_eigen_gensymm(ma, mb, eval, w); /* eval and evalv have to be sorted? not sure why */ gsl_vector_memcpy(x, eval); gsl_vector_memcpy(y, evalv); gsl_sort_vector(x); gsl_sort_vector(y); test_eigenvalues_real(y, x, "gensymm, random", "unsorted"); gsl_eigen_gensymmv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_ASC); test_eigen_gensymm_results(A, B, evalv, evec, i, "random", "val/asc"); gsl_eigen_gensymmv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_DESC); test_eigen_gensymm_results(A, B, evalv, evec, i, "random", "val/desc"); gsl_eigen_gensymmv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_ASC); test_eigen_gensymm_results(A, B, evalv, evec, i, "random", "abs/asc"); gsl_eigen_gensymmv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_DESC); test_eigen_gensymm_results(A, B, evalv, evec, i, "random", "abs/desc"); } gsl_matrix_free(A); gsl_matrix_free(B); gsl_matrix_free(ma); gsl_matrix_free(mb); gsl_vector_free(eval); gsl_vector_free(evalv); gsl_vector_free(x); gsl_vector_free(y); gsl_matrix_free(evec); gsl_eigen_gensymm_free(w); gsl_eigen_gensymmv_free(wv); } gsl_rng_free(r); } /* test_eigen_gensymm() */
void experiment::run_experiment() { parameter pdebug = get_param("debugprint"); parameter pdebug_f = get_param("debugprint_file"); pdebug.strvalue=pdebug_f.strvalue; std::string sverbfile=get_param_s("verbose_file"); bool bverbose=(get_param_i("verbose_mode")==1); std::ofstream fverbose; if (sverbfile.compare("cout")==0) gout=&std::cout; else { fverbose.open(sverbfile.c_str()); gout=&fverbose; }; //used algorithms std::string sexp_type=get_param_s("exp_type"); std::string salgo_match=get_param_s("algo"); std::istrstream istr(salgo_match.c_str()); std::vector<std::string>v_salgo_match; std::string stemp; while (istr>>stemp) v_salgo_match.push_back(stemp); //used initialization algorithms std::string salgo_init=get_param_s("algo_init_sol"); std::istrstream istrinit(salgo_init.c_str()); std::vector<std::string>v_salgo_init; while (istrinit>>stemp) v_salgo_init.push_back(stemp); if (v_salgo_init.size()!=v_salgo_match.size()) { printf("Error: algo and algo_init_sol do not have the same size\n"); exit(0); }; double dalpha_ldh=get_param_d("alpha_ldh"); if ((dalpha_ldh<0) ||(dalpha_ldh>1)) { printf("Error:alpha_ldh should be between 0 and 1 \n"); exit(0); }; graph g(get_config()); graph h(get_config()); char cformat1='D',cformat2='D'; if (bverbose) *gout<<"Data loading"<<std::endl; g.load_graph(get_param_s("graph_1"),'A',cformat1); h.load_graph(get_param_s("graph_2"),'A',cformat2); if (get_param_i("graph_dot_print")==1){ g.printdot("g.dot");h.printdot("h.dot");}; // Matrix of local similarities between graph vertices std::string strfile=get_param_s("C_matrix"); int N1 =g.get_adjmatrix()->size1; int N2 =h.get_adjmatrix()->size1; gsl_matrix* gm_ldh=gsl_matrix_alloc(N1,N2); FILE *f=fopen(strfile.c_str(),"r"); if (f!=NULL){ gsl_set_error_handler_off(); int ierror=gsl_matrix_fscanf(f,gm_ldh); fclose(f); gsl_set_error_handler(NULL); if (ierror!=0){ printf("Error: C_matrix is not correctly defined \n"); exit(0);}; } else { if (bverbose) *gout<<"C matrix is set to constant"<<std::endl; dalpha_ldh=0; gsl_matrix_set_all(gm_ldh,1.0/(N1*N2)); }; //inverse the sign if C is a distance matrix if (get_param_i("C_matrix_dist")==1) gsl_matrix_scale(gm_ldh,-1); if (bverbose) *gout<<"Graph synhronization"<<std::endl; synchronize(g,h,&gm_ldh); //Cycle over all algoirthms for (int a=0;a<v_salgo_match.size();a++) { //initialization algorithm* algo_i=get_algorithm(v_salgo_init[a]); algo_i->read_config(get_config_string()); algo_i->set_ldhmatrix(gm_ldh); match_result mres_i=algo_i->gmatch(g,h,NULL,NULL,dalpha_ldh); delete algo_i; //main algorithm algorithm* algo=get_algorithm(v_salgo_match[a]); algo->read_config(get_config_string()); algo->set_ldhmatrix(gm_ldh); match_result mres_a=algo->gmatch(g,h,(mres_i.gm_P_exact!=NULL)?mres_i.gm_P_exact:mres_i.gm_P, NULL,dalpha_ldh); mres_a.vd_trace.clear(); mres_a.salgo=v_salgo_match[a]; v_mres.push_back(mres_a); delete algo; }; gsl_matrix_free(gm_ldh); printout(); }
void ssm_var_free(ssm_var_t *var) { gsl_matrix_free(var); }
void simTransition_Neuro(gsl_rng *random, double *y, int dy, int dx, int time, int N, double *param, double *xh, double *x) { int i,k,s, npx=pow(dx,2), ddx=dx/2; double muI; double *mu=NULL, *wSim=NULL; double **M = (double**)malloc (sizeof (double)*N); for(i=0;i<N;i++) { M[i] = (double*)malloc (sizeof (double)*dx); } gsl_matrix *SIGMA=gsl_matrix_alloc(dx/2,dx/2); //Compute A*X+mux for(i=0;i<N;i++) { for(k=0;k<dx/2;k++) { M[i][k]=param[k]; for(s=0;s<dx;s++) { M[i][k]+=param[dx*(k+1)+s]*(xh[dx*i+s]-param[s]); } } for(k=dx/2;k<dx;k++) { x[dx*i+k]=param[k]; for(s=0;s<dx;s++) { x[dx*i+k]+=param[dx*(k+1)+s]*(xh[dx*i+s]-param[s]); } } } //Choletsky decomposition of Sigma for(k=0;k<dx/2;k++) { for(s=0;s<dx/2;s++) { gsl_matrix_set(SIGMA,k,s,param[dx+npx+dx*k/2+s]); } } //Simulation mu=(double*)malloc(sizeof(double)*(dx/2)); wSim=(double*)malloc(sizeof(double)*(dx/2)); for(i=0;i<N;i++) { for(k=0;k<dx/2;k++) { mu[k]=M[i][k]; } rmnorm(random,ddx, mu, SIGMA, wSim); for(k=0;k<dx/2;k++) { x[dx*i+k]=wSim[k]; } } free(mu); mu=NULL; free(wSim); wSim=NULL; gsl_matrix_free(SIGMA); SIGMA=NULL; for (i = 0; i < N; i++) { free(M[i]); } free (M); }
void ssm_calc_free(ssm_calc_t *calc, ssm_nav_t *nav) { gsl_rng_free(calc->randgsl); if (nav->implementation == SSM_ODE || nav->implementation == SSM_EKF){ gsl_odeiv2_step_free(calc->step); gsl_odeiv2_evolve_free(calc->evolve); gsl_odeiv2_control_free(calc->control); if(nav->implementation == SSM_EKF){ gsl_vector_free(calc->_pred_error); gsl_matrix_free(calc->_St); gsl_matrix_free(calc->_Stm1); gsl_matrix_free(calc->_Rt); gsl_matrix_free(calc->_Ht); gsl_matrix_free(calc->_Kt); gsl_matrix_free(calc->_Tmp_N_SV_N_TS); gsl_matrix_free(calc->_Tmp_N_TS_N_SV); gsl_matrix_free(calc->_Q); gsl_matrix_free(calc->_FtCt); gsl_matrix_free(calc->_Ft); gsl_vector_free(calc->_eval); gsl_matrix_free(calc->_evec); gsl_eigen_symmv_free(calc->_w_eigen_vv); } } else if (nav->implementation == SSM_SDE){ free(calc->y_pred); } else if (nav->implementation == SSM_PSR){ ssm_psr_free(calc); } free(calc->to_be_sorted); free(calc->index_sorted); if(calc->covariates_length){ int k; for(k=0; k< calc->covariates_length; k++) { if(calc->spline[k]){ gsl_spline_free(calc->spline[k]); } if(calc->acc[k]){ gsl_interp_accel_free(calc->acc[k]); } } free(calc->spline); free(calc->acc); } free(calc); }
void infomax(gsl_matrix *x_white, gsl_matrix *weights, gsl_matrix *S, int verbose){ /*Computes ICA infomax in whitened data Decomposes x_white as x_white=AS *Input x_white: whitened data (Use PCAwhiten) *Output A : mixing matrix S : source matrix */ // int verbose = 1; //true size_t NCOMP = x_white->size1; size_t NVOX = x_white->size2; //getting permutation vector const gsl_rng_type * T; gsl_rng * r; gsl_permutation * p = gsl_permutation_alloc (NVOX); // gsl_rng_env_setup(); T = gsl_rng_default; r = gsl_rng_alloc (T); gsl_permutation_init (p); gsl_matrix *old_weights = gsl_matrix_alloc(NCOMP,NCOMP); gsl_matrix *bias = gsl_matrix_calloc(NCOMP, 1); gsl_matrix *d_weights = gsl_matrix_calloc(NCOMP,NCOMP); gsl_matrix *temp_change = gsl_matrix_alloc(NCOMP,NCOMP); gsl_matrix *old_d_weights = gsl_matrix_calloc(NCOMP,NCOMP); gsl_matrix *shuffled_x_white = gsl_matrix_calloc(NCOMP,x_white->size2); gsl_matrix_memcpy(shuffled_x_white, x_white); gsl_matrix_set_identity(weights); gsl_matrix_set_identity(old_weights); double lrate = 0.005/log((double)NCOMP); double change=1; double angle_delta =0; size_t step = 1; int error = 0; while( (step < MAX_STEP) && (change > W_STOP)){ error = w_update(weights, x_white, bias, shuffled_x_white, p, r, lrate); if (error==1 || error==2){ // It blowed up! RESTART! step = 1; // change = 1; error = 0; lrate *= ANNEAL; gsl_matrix_set_identity(weights); gsl_matrix_set_identity(old_weights); gsl_matrix_set_zero(d_weights); gsl_matrix_set_zero(old_d_weights); gsl_matrix_set_zero(bias); if (lrate > MIN_LRATE){ printf("\nLowering learning rate to %g and starting again.\n",lrate); } else{ printf("\nMatrix may not be invertible"); } } else if (error==0){ gsl_matrix_memcpy(d_weights, weights); gsl_matrix_sub(d_weights, old_weights); change = matrix_norm(d_weights); if (step > 2){ // Compute angle delta gsl_matrix_memcpy(temp_change, d_weights); gsl_matrix_mul_elements(temp_change, old_d_weights); angle_delta = acos(matrix_sum(temp_change) / sqrt(matrix_norm(d_weights)*(matrix_norm(old_d_weights)))); angle_delta *= (180.0 / M_PI); } gsl_matrix_memcpy(old_weights, weights); if (angle_delta > 60){ lrate *= ANNEAL; gsl_matrix_memcpy(old_d_weights, d_weights); } else if (step==1) { gsl_matrix_memcpy(old_d_weights, d_weights); } if ((verbose && (step % 10)== 0) || change < W_STOP){ printf("\nStep %zu: Lrate %.1e, Wchange %.1e, Angle %.2f", step, lrate, change, angle_delta); } step ++; } } matrix_mmul(weights, x_white, S); gsl_matrix_free(old_d_weights); gsl_matrix_free(old_weights); gsl_matrix_free(bias); gsl_matrix_free(d_weights); gsl_matrix_free(shuffled_x_white); gsl_rng_free (r); gsl_permutation_free (p); }
int main (int argc, char **argv) { int i=0, j=0, n=0, nl=0, k=0, posi=0, posj=0, posk=0, ncol=0, nrow=0; double xi=0.0, yi=0.0, yy=0.0, ei=0.0, sumsq=0.0, med=0.0; gsl_matrix *X=NULL, *cov=NULL; gsl_vector *y=NULL, *w=NULL, *c=NULL; MRI_IMAGE *im = NULL; double *dar = NULL; gsl_multifit_linear_workspace *work=NULL; if (argc != 2) { fprintf (stderr,"usage: fitanje_1sign data > outfile\n"); exit (-1); } /* slower than specific code you had but more convenient. It allows you to use all the column and row selections we can do with filenames. Also, keeps you fron worrying about dimensions. The problem with your code was assuming you had 13 columns always That was not the case for stat5_fitcoef. OK, that was caused by a problem in the scripts. That is fixed, but I leave this change here anyway. */ fprintf(stderr,"Patience, reading %s... ", argv[1]); im = mri_read_double_1D (argv[1]); if (!im) { fprintf(stderr,"Error: Failed to read matrix data from %s\n", argv[1]); return(-1); } ncol = im->ny; nrow = im->nx; fprintf (stderr,"Have %d cols, %d rows\nNow fitting...", ncol, nrow); n = ncol-3; /* now just get the array and kill the rest */ dar = MRI_DOUBLE_PTR(im); /* make sure that pointer is set to NULL in im, or risk hell */ mri_clear_data_pointer(im) ; if (im) mri_free(im); im = NULL; /* now kill im */ X = gsl_matrix_alloc (n, 5); y = gsl_vector_alloc (n); c = gsl_vector_alloc (5); cov = gsl_matrix_alloc (5, 5); for (i = 0; i < n; i++) { xi = i+1; gsl_matrix_set (X, i, 0, 1.0); gsl_matrix_set (X, i, 1, xi); gsl_matrix_set (X, i, 2, xi*xi); gsl_matrix_set (X, i, 3, xi*xi*xi); gsl_matrix_set (X, i, 4, xi*xi*xi*xi); // printf ("%lg ",xi); } /*make header printf ("matrvola\n"); ZSS: By adding # to the text line, I made the output file be a .1D format */ fprintf(stdout, "#%s_0\t%s_1\t%s_2\t%s_3\t%s_4\n", argv[1],argv[1],argv[1],argv[1],argv[1]); // go by lines - signatures /* pre-allocate, I think this should be just fine, there should be no need to reinitialize work all the time */ work = gsl_multifit_linear_alloc (n, 5); for (nl=0; nl<nrow; ++nl) { posi = (int)dar[nl]; posj = (int)dar[nl+ nrow]; posk = (int)dar[nl+2*nrow]; for (k = 3; k < ncol; k++) { gsl_vector_set (y, k-3, dar[nl+k*nrow]); } gsl_multifit_linear (X, y, c, cov, &sumsq, work); /* printf ( "\n # best fit: Y = %g + %g X + %g X^2 +%g X^3 + %g X^4\n", C(0), C(1), C(2), C(3), C(4)); printf ("# sumsq = %g\n", sumsq); */ fprintf (stdout, "%11g\t%11g\t%11g\t%11g\t%11g\n", C(0), C(1), C(2), C(3), C(4)); /* printf ("# covariance matrix:\n"); printf ("[ %+.5e, %+.5e, %+.5e \n", COV(0,0), COV(0,1), COV(0,2)); printf (" %+.5e, %+.5e, %+.5e \n", COV(1,0), COV(1,1), COV(1,2)); printf (" %+.5e, %+.5e, %+.5e ]\n", COV(2,0), COV(2,1), COV(2,2)); printf ("# chisq = %g\n", chisq); */ } gsl_multifit_linear_free (work); work = NULL; free(dar); dar = NULL; /* done with input array */ gsl_vector_free (y); gsl_vector_free (c); gsl_matrix_free (cov); gsl_matrix_free (X); //gsl_vector_free (w); fprintf (stderr,"\n"); return 0; }
int GMRFLib_gsl_ginv(gsl_matrix * A, double tol, int rankdef) { /* * replace n x n matrix A with its generlized inverse. if TOL > 0, use that tolerance. If rankdef is set, use that. If both are set, give an error. */ assert(A && (A->size1 == A->size2)); gsl_matrix *U = GMRFLib_gsl_duplicate_matrix(A); gsl_matrix *V = gsl_matrix_alloc(A->size1, A->size2); gsl_vector *S = gsl_vector_alloc(A->size1); gsl_vector *work = gsl_vector_alloc(A->size1); gsl_linalg_SV_decomp(U, V, S, work); size_t i; double one = 1.0, zero = 0.0; double s_max = gsl_vector_get(S, 0); gsl_matrix *M1 = gsl_matrix_alloc(A->size1, A->size2); gsl_matrix *M2 = gsl_matrix_alloc(A->size1, A->size2); assert(!(tol > 0.0 && (rankdef >= 0 && rankdef <= (int) A->size1))); if (tol > 0.0){ for(i = 0; i < A->size1; i++){ double s = gsl_vector_get(S, i); if (s < tol * s_max) { gsl_matrix_set(M2, i, i, 0.0); } else { gsl_matrix_set(M2, i, i, 1.0/s); } } } else { assert(rankdef >= 0); assert(rankdef <= (int)A->size1); double first = gsl_vector_get(S, 0); double last = gsl_vector_get(S, A->size1-1); for(i = 0; i < A->size1; i++){ double s = gsl_vector_get(S, i); if (first > last){ // do not use the last 'rdef's if (i < (int) A->size1 - rankdef){ gsl_matrix_set(M2, i, i, 1.0/s); } else { gsl_matrix_set(M2, i, i, 0.0); } } else { // do not use the first 'rdef's if (i < rankdef){ gsl_matrix_set(M2, i, i, 0.0); } else { gsl_matrix_set(M2, i, i, 1.0/s); } } } } gsl_blas_dgemm(CblasNoTrans, CblasTrans, one, M2, U, zero, M1); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, one, V, M1, zero, M2); gsl_matrix_memcpy(A, M2); gsl_matrix_free(U); gsl_matrix_free(V); gsl_matrix_free(M1); gsl_matrix_free(M2); gsl_vector_free(S); gsl_vector_free(work); return GMRFLib_SUCCESS; }
// destructor Matrix::~Matrix() { if ( data ) gsl_matrix_free( data ); }
void checkSLE(const gsl_matrix* A, const gsl_vector* x, const gsl_vector* b, const int N) { // TODO - make complete logging to the file // print("Checking the solution of the SLE ... "); // Checking on condition number of matrix A int signum; gsl_permutation *perm = gsl_permutation_alloc(N); gsl_matrix *LU = gsl_matrix_alloc(N, N); gsl_matrix *invA = gsl_matrix_alloc(N, N); gsl_matrix_memcpy(LU, A); gsl_linalg_LU_decomp(LU, perm, &signum); gsl_linalg_LU_invert(LU, perm, invA); gsl_matrix_free(LU); gsl_permutation_free(perm); gsl_vector *row = gsl_vector_alloc(N); double normA = 0; double normInvA = 0; for(int i = 0; i < N; i++) { gsl_matrix_get_row(row, A, i); double dasum = gsl_blas_dasum(row); if (dasum > normA) normA = dasum; gsl_matrix_get_row(row, invA, i); dasum = gsl_blas_dasum(row); if (dasum > normInvA) normInvA = dasum; } double conditionNumber = normA * normInvA; if (conditionNumber > 1000) //print("Condition number of matrix of SLE is ", conditionNumber); gsl_vector_free(row); // Checking on Ax == b gsl_vector *tmp = gsl_vector_alloc(N); gsl_vector_memcpy(tmp, b); // tmp = A*x - b, i.e. error gsl_blas_dgemv(CblasNoTrans, 1, A, x, -1, tmp); for(int i = 0; i < N; i++) { if (fabs(gsl_vector_get(tmp, i) / gsl_vector_get(b, i)) > 1e-8) { if (gsl_vector_get(b, i) == 0) { if (fabs(gsl_vector_get(tmp, i)) > 1e-8) print("Ax =", gsl_vector_get(tmp, i), "at string", i, ". But b = 0 here."); } else { print("( Ax - b ) / b =", gsl_vector_get(tmp, i) / gsl_vector_get(b, i), "at string", i); } } } // Checking on inv(A)b == x gsl_vector_memcpy(tmp, x); // tmp = inv(A)*b - x, i.e. error gsl_blas_dgemv(CblasNoTrans, 1, invA, b, -1, tmp); for(int i = 0; i < N; i++) { if (fabs(gsl_vector_get(tmp, i) / gsl_vector_get(x, i)) > 1e-8) print("( inv(A)b - x ) / x =", gsl_vector_get(tmp, i) / gsl_vector_get(x, i), "at string ", i); } gsl_vector_free(tmp); gsl_matrix_free(invA); // TODO - make complete logging to the file // print("Checking is done."); }
/* coefficients as well */ double singleChi(const double *sampletimes, const float *vals, const float *stderrs, long ndata, long nharmonics, double tstart, double frequency, float *harmoniccoeffs) { #define MAXHARM 17 int i, j, d; int result; double alpha[2*MAXHARM+1][2*MAXHARM+1]; double beta[2*MAXHARM+1]; double chisqred; gsl_matrix *alpha_gsl = gsl_matrix_alloc(2 * nharmonics + 1,2 * nharmonics + 1); gsl_vector *beta_gsl = gsl_vector_alloc(2 * nharmonics + 1); gsl_vector *x_gsl = gsl_vector_alloc(2 * nharmonics + 1); assert(nharmonics <= MAXHARM); for (i = 0 ; i < 2*nharmonics+1 ; i++) { beta[i] = 0; for (j = 0 ; j < 2*nharmonics+1 ; j++) alpha[i][j] = 0; } for (d = 0 ; d < ndata ; d++) { for (i = 0 ; i < 2*nharmonics+1 ; i++) { double invvar = 1/(stderrs[d] * stderrs[d]); beta[i] += vals[d] * invvar * Mfunc(i, (sampletimes[d] - tstart) * frequency * 2 * M_PI); for (j = 0 ; j < 2*nharmonics+1 ; j++) alpha[i][j] += invvar * Mfunc(i, (sampletimes[d] - tstart) * frequency * 2 * M_PI) * Mfunc(j, (sampletimes[d] - tstart) * frequency * 2 * M_PI); } } for (i = 0 ; i < 2*nharmonics+1 ; i++) { gsl_vector_set(beta_gsl, i, beta[i]); for (j = 0 ; j < 2*nharmonics+1 ; j++) gsl_matrix_set(alpha_gsl, i, j, alpha[i][j]); } result = gsl_linalg_HH_solve(alpha_gsl, beta_gsl, x_gsl); /* x = alpha^-1 beta */ assert(result == 0); gsl_blas_ddot(x_gsl, beta_gsl, &chisqred); if (harmoniccoeffs) { for (i = 0 ; i < 2*nharmonics+1 ; i++) { harmoniccoeffs[i] = gsl_vector_get(x_gsl, i); } } gsl_matrix_free(alpha_gsl); gsl_vector_free(beta_gsl); gsl_vector_free(x_gsl); return chisqred; }
// [[Rcpp::export]] Rcpp::List fitData(Rcpp::DataFrame ds) { const size_t ncoeffs = NCOEFFS; const size_t nbreak = NBREAK; const size_t n = N; size_t i, j; Rcpp::DataFrame D(ds); // construct the data.frame object RcppGSL::vector<double> y = D["y"]; // access columns by name, RcppGSL::vector<double> x = D["x"]; // assigning to GSL vectors RcppGSL::vector<double> w = D["w"]; gsl_bspline_workspace *bw; gsl_vector *B; gsl_vector *c; gsl_matrix *X, *cov; gsl_multifit_linear_workspace *mw; double chisq, Rsq, dof, tss; bw = gsl_bspline_alloc(4, nbreak); // allocate a cubic bspline workspace (k = 4) B = gsl_vector_alloc(ncoeffs); X = gsl_matrix_alloc(n, ncoeffs); c = gsl_vector_alloc(ncoeffs); cov = gsl_matrix_alloc(ncoeffs, ncoeffs); mw = gsl_multifit_linear_alloc(n, ncoeffs); gsl_bspline_knots_uniform(0.0, 15.0, bw); // use uniform breakpoints on [0, 15] for (i = 0; i < n; ++i) { // construct the fit matrix X double xi = gsl_vector_get(x, i); gsl_bspline_eval(xi, B, bw); // compute B_j(xi) for all j for (j = 0; j < ncoeffs; ++j) { // fill in row i of X double Bj = gsl_vector_get(B, j); gsl_matrix_set(X, i, j, Bj); } } gsl_multifit_wlinear(X, w, y, c, cov, &chisq, mw); // do the fit dof = n - ncoeffs; tss = gsl_stats_wtss(w->data, 1, y->data, 1, y->size); Rsq = 1.0 - chisq / tss; Rcpp::NumericVector FX(151), FY(151); // output the smoothed curve double xi, yi, yerr; for (xi = 0.0, i=0; xi < 15.0; xi += 0.1, i++) { gsl_bspline_eval(xi, B, bw); gsl_multifit_linear_est(B, c, cov, &yi, &yerr); FX[i] = xi; FY[i] = yi; } Rcpp::List res = Rcpp::List::create(Rcpp::Named("X")=FX, Rcpp::Named("Y")=FY, Rcpp::Named("chisqdof")=Rcpp::wrap(chisq/dof), Rcpp::Named("rsq")=Rcpp::wrap(Rsq)); gsl_bspline_free(bw); gsl_vector_free(B); gsl_matrix_free(X); gsl_vector_free(c); gsl_matrix_free(cov); gsl_multifit_linear_free(mw); y.free(); x.free(); w.free(); return(res); }
void freeParam(parameters *param) { gsl_matrix_free(param->beta); free(param); }