void sort_mask_resolution(gsl_vector_int *resolution_array,
gsl_vector_ulong *pixnum_array, unsigned long n_mask)
{
gsl_permutation *pixel_index;
gsl_vector_ulong *tmp_pixnum_array;
gsl_vector_int *tmp_resolution_array;
unsigned long i, j;
/* Given a list of masks and resolutions, return each list sorted by the
resolution. This routine is needed to make the resolution structure. */
tmp_pixnum_array = gsl_vector_ulong_alloc(n_mask);
tmp_resolution_array = gsl_vector_int_alloc(n_mask);
pixel_index = gsl_permutation_alloc(n_mask);
gsl_sort_vector_int_index(pixel_index,resolution_array);
for (i=0;i<n_mask;i++) {
j = pixel_index->data[i];
tmp_pixnum_array->data[i] = pixnum_array->data[j];
tmp_resolution_array->data[i] = resolution_array->data[j];
}
for (i=0;i<n_mask;i++) {
pixnum_array->data[i] = tmp_pixnum_array->data[i];
resolution_array->data[i] = tmp_resolution_array->data[i];
}
gsl_vector_int_free(tmp_resolution_array);
gsl_vector_ulong_free(tmp_pixnum_array);
gsl_permutation_free(pixel_index);
}
/**
* The function releases the space allocated
* for a fluxcube structure.
*
* @param fcube - the pointer to the fluxcube structure
*
*/
void
free_fluxcube(flux_cube *fcube)
{
int i;
// free the segmentation matrix
gsl_matrix_int_free(fcube->segmentation);
// free the wavelength order vector
gsl_vector_int_free(fcube->fimage_order);
// go over the fluximages, and free them
for (i=0; i < fcube->n_fimage; i++)
free_fluximage(fcube->fluxims[i]);
// free the fluximage vector
free(fcube->fluxims);
// free the fluximage order vector
// gsl_vector_int_free(fcube->fimage_order);
// free the fluxcube
free(fcube);
// set the fluxcube to NULL
fcube=NULL;
}
void make_resolution_struct(gsl_vector_ulong *pixnum_array,
gsl_vector_int *resolution_array,
unsigned long n_pixel,
resolution_struct *res_struct, int n_res)
{
unsigned long i,j;
gsl_vector_ulong *resolution_start_array, *resolution_finish_array;
gsl_vector_int *resolution_region_array;
int k;
/* Given input arrays of resolutions and masks, this routine puts
together the resolution structure. Each element of this structure
contains an array of masks at the same resolution as well as information
about the number of masks and the common resolution. This allows for
efficient searching of the masks at the desired resolution, while
avoiding those of different resolution.
*/
resolution_region_array = gsl_vector_int_alloc(n_res);
resolution_start_array = gsl_vector_ulong_alloc(n_res);
resolution_finish_array = gsl_vector_ulong_alloc(n_res);
find_resolution_bounds(resolution_array,n_pixel,resolution_region_array,
resolution_start_array,resolution_finish_array);
sort_mask_pixnum(pixnum_array,resolution_array,n_pixel,
resolution_region_array,resolution_start_array,
resolution_finish_array,n_res);
for (k=0;k<n_res;k++) {
res_struct[k].start = resolution_start_array->data[k];
res_struct[k].finish = resolution_finish_array->data[k];
res_struct[k].n_pixel =
res_struct[k].finish - res_struct[k].start + 1;
res_struct[k].resolution = resolution_region_array->data[k];
res_struct[k].area = pix_area(res_struct[k].resolution,
pixnum_array->data[res_struct[k].start]);
/* printf("%u pixels with resolution of %i\n",res_struct[k].n_pixel,
res_struct[k].resolution); */
res_struct[k].pixnum = gsl_vector_ulong_alloc(res_struct[k].n_pixel);
j = res_struct[k].start;
for (i=0;i<res_struct[k].n_pixel;i++) {
res_struct[k].pixnum->data[i] = pixnum_array->data[j];
j++;
}
}
gsl_vector_int_free(resolution_region_array);
gsl_vector_ulong_free(resolution_start_array);
gsl_vector_ulong_free(resolution_finish_array);
}
static gsl_poly_int* mygsl_poly_hermite(int n1)
{
size_t n;
gsl_vector_int *p1, *p2, *p0;
int coef1[2] = {0, 2};
int coef2[3] = {-2, 0, 4};
if (n1 < 0) rb_raise(rb_eArgError, "order must be >= 0");
p0 = gsl_vector_int_calloc(n1 + 1);
switch (n1) {
case 0:
gsl_vector_int_set(p0, 0, 1);
break;
case 1:
memcpy(p0->data, coef1, 2*sizeof(int));
break;
case 2:
memcpy(p0->data, coef2, 3*sizeof(int));
break;
default:
p1 = gsl_vector_int_calloc(n1 + 1);
p2 = gsl_vector_int_calloc(n1 + 1);
memcpy(p1->data, coef2, 3*sizeof(int));
memcpy(p2->data, coef1, 2*sizeof(int));
for (n = 2; n < n1; n++) {
gsl_vector_int_memcpy(p0, p1);
mygsl_vector_int_shift_scale2(p0, n);
gsl_vector_int_scale(p2, 2*n);
gsl_vector_int_sub(p0, p2);
/* save for the next iteration */
gsl_vector_int_memcpy(p2, p1);
gsl_vector_int_memcpy(p1, p0);
}
gsl_vector_int_free(p2);
gsl_vector_int_free(p1);
break;
}
return p0;
}
static gsl_poly_int* mygsl_poly_bell(int n1)
{
size_t n, j;
gsl_vector_int *p1, *p0;
int coef1[2] = {0, 1};
int coef2[3] = {0, 1, 1};
if (n1 < 0) rb_raise(rb_eArgError, "order must be >= 0");
p0 = gsl_vector_int_calloc(n1 + 1);
switch (n1) {
case 0:
gsl_vector_int_set(p0, 0, 1);
break;
case 1:
memcpy(p0->data, coef1, 2*sizeof(int));
break;
case 2:
memcpy(p0->data, coef2, 3*sizeof(int));
break;
default:
p1 = gsl_vector_int_calloc(n1 + 1);
memcpy(p1->data, coef2, 3*sizeof(int));
for (n = 2; n < n1; n++) {
gsl_vector_int_memcpy(p0, p1);
mygsl_vector_int_shift(p0, n);
for (j = 0; j < n; j++) {
gsl_vector_int_set(p1, j, gsl_vector_int_get(p1, j+1)*(j+1));
}
gsl_vector_int_set(p1, n, 0);
mygsl_vector_int_shift(p1, n);
gsl_vector_int_add(p0, p1);
/* save for the next iteration */
gsl_vector_int_memcpy(p1, p0);
}
gsl_vector_int_free(p1);
break;
}
return p0;
}
static size_t
thit_free_model(SCM s_model) {
banmi_model_t *model = (banmi_model_t*) SCM_SMOB_DATA(s_model);
gsl_matrix_int_free(model->disc);
gsl_matrix_int_free(model->disc_imp);
gsl_matrix_free(model->cont);
gsl_matrix_free(model->cont_imp);
gsl_matrix_int_free(model->x);
gsl_matrix_free(model->mu);
gsl_vector_free(model->lambda);
gsl_vector_free(model->sigma);
free_tab(model->crosstab);
gsl_vector_free(model->mu_a);
gsl_vector_free(model->mu_b);
gsl_vector_free(model->sigma_a);
gsl_vector_free(model->sigma_b);
gsl_vector_int_free(model->bds_disc);
free(model->mis_pat);
free(model);
return 0;
}
void make_superpix_struct(int superpix_resolution,
gsl_vector_ulong *pixnum_array,
gsl_vector_int *resolution_array,
unsigned long n_pixel,
superpixnum_struct *superpix_struct,
unsigned long n_superpix)
{
unsigned long i,j, k;
gsl_vector_ulong *superpix_start_array, *superpix_finish_array;
gsl_vector_ulong *superpix_region_array, *tmp_pixnum_array, *superpix_array;
gsl_vector_ulong *tmp_superpix_array;
gsl_vector_int *tmp_resolution_array;
gsl_permutation *pixel_index;
/* Similar to the resolution structure, the superpix structure groups a
list of masks by common superpixel index. These masks are then stored
in a resolution structure, futher sorting them by resolution. The
combination of these two structures allows one to quickly exclude the
vast majority of the masks for any sort of filtering algorithm and check
only those masks most likely to contain a given point.
This routine serves as a wrapper for the various steps required to fill
in the superpixel structure, requiring only that the user call
find_n_superpix first (in order to allocate the superpixel structure),
and then call this routine.
*/
superpix_region_array = gsl_vector_ulong_alloc(n_superpix);
superpix_start_array = gsl_vector_ulong_alloc(n_superpix);
superpix_finish_array = gsl_vector_ulong_alloc(n_superpix);
superpix_array = gsl_vector_ulong_alloc(n_pixel);
tmp_superpix_array = gsl_vector_ulong_alloc(n_pixel);
tmp_pixnum_array = gsl_vector_ulong_alloc(n_pixel);
tmp_resolution_array = gsl_vector_int_alloc(n_pixel);
pixel_index = gsl_permutation_alloc(n_pixel);
for (i=0;i<n_pixel;i++) {
superpix(resolution_array->data[i],pixnum_array->data[i],
superpix_resolution,&superpix_array->data[i]);
/* printf("%d\n",superpix_array->data[i]); */
}
gsl_sort_vector_ulong_index(pixel_index,superpix_array);
for (i=0;i<n_pixel;i++) {
k = pixel_index->data[i];
tmp_resolution_array->data[i] = resolution_array->data[k];
tmp_pixnum_array->data[i] = pixnum_array->data[k];
tmp_superpix_array->data[i] = superpix_array->data[k];
}
for (i=0;i<n_pixel;i++) {
resolution_array->data[i] = tmp_resolution_array->data[i];
pixnum_array->data[i] = tmp_pixnum_array->data[i];
superpix_array->data[i] = tmp_superpix_array->data[i];
}
gsl_vector_ulong_free(tmp_superpix_array);
gsl_vector_ulong_free(tmp_pixnum_array);
gsl_vector_int_free(tmp_resolution_array);
gsl_permutation_free(pixel_index);
/* printf("Finding superpix bounds...\n"); */
find_superpix_bounds(superpix_array,n_pixel,superpix_region_array,
superpix_start_array,superpix_finish_array);
for (k=0;k<n_superpix;k++) {
/* printf("%d %d %d\n",superpix_start_array->data[k],
superpix_finish_array->data[k],superpix_region_array->data[k]); */
superpix_struct[k].n_pixel =
superpix_finish_array->data[k] - superpix_start_array->data[k] + 1;
superpix_struct[k].resolution = superpix_resolution;
superpix_struct[k].superpixnum = superpix_region_array->data[k];
tmp_pixnum_array = gsl_vector_ulong_alloc(superpix_struct[k].n_pixel);
tmp_resolution_array = gsl_vector_int_alloc(superpix_struct[k].n_pixel);
pixel_index = gsl_permutation_alloc(superpix_struct[k].n_pixel);
j = 0;
for (i=superpix_start_array->data[k];
i<=superpix_finish_array->data[k];i++) {
tmp_resolution_array->data[j] = resolution_array->data[i];
j++;
}
gsl_sort_vector_int_index(pixel_index,tmp_resolution_array);
for (i=0;i<superpix_struct[k].n_pixel;i++) {
j = pixel_index->data[i] + superpix_start_array->data[k];
tmp_pixnum_array->data[i] = pixnum_array->data[j];
tmp_resolution_array->data[i] = resolution_array->data[j];
/* printf("%i %u\n",tmp_resolution_array->data[i],
tmp_pixnum_array->data[i]); */
}
superpix_struct[k].n_res =
find_n_res(tmp_resolution_array, superpix_struct[k].n_pixel);
/* printf("Found %i resolutions in superpixel %u\n",
superpix_struct[k].n_res,k); */
if (!(superpix_struct[k].res_struct=
malloc(superpix_struct[k].n_res*sizeof(resolution_struct)))) {
printf("Couldn't allocate memory...\n");
exit(1);
}
make_resolution_struct(tmp_pixnum_array, tmp_resolution_array,
superpix_struct[k].n_pixel,
superpix_struct[k].res_struct,
superpix_struct[k].n_res);
gsl_vector_ulong_free(tmp_pixnum_array);
gsl_vector_int_free(tmp_resolution_array);
gsl_permutation_free(pixel_index);
}
gsl_vector_ulong_free(superpix_region_array);
gsl_vector_ulong_free(superpix_start_array);
gsl_vector_ulong_free(superpix_finish_array);
gsl_vector_ulong_free(superpix_array);
}
int DPMHC_S_smplr(struct str_DPMHC *ptr_DPMHC_data)
{
int i_K = ptr_DPMHC_data->i_K;
gsl_vector *v_y = ptr_DPMHC_data->v_y;
gsl_vector *v_w = ptr_DPMHC_data->v_w;
gsl_vector *v_u = ptr_DPMHC_data->v_u;
gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S;
gsl_vector_int *vi_n = ptr_DPMHC_data->vi_n;
gsl_matrix *m_DPtheta = ptr_DPMHC_data->m_DPtheta;
size_t i_n=v_y->size;
gsl_vector *v_p = gsl_vector_calloc (i_K);
gsl_vector_int *vi_cnt = gsl_vector_int_calloc (i_K);
int i,j,st,ism;
double sm,dn;
double d_yi,d_muj,d_xij,d_tauj;
gsl_vector_int_set_zero ( vi_cnt );
gsl_vector_int_set_zero ( vi_n );
for(i=0;i<i_n;i++){
//printf("i=%d\n",i);
d_yi = v_y->data[i];
sm=0.0;
for(j=0;j<i_K;j++){
if( vget(v_w,j) <= vget(v_u,i) ){
vset(v_p,j,0.0);
// printf("w_j,u_i %g %g",vget(w,j),vget(u,i));
}else{
// printf("K=%d\n",i_K);
// dn = den_norm_prec ( vget(y,i), mget(theta,j,0), mget(theta,j,1) );
d_muj = mget(m_DPtheta,j,0);
d_xij = mget(m_DPtheta,j,1);
d_tauj = mget(m_DPtheta,j,2);
dn = exp( log_nor(d_yi, d_muj, fabs(d_xij) * fabs(d_xij) / d_tauj ));
vset(v_p,j,dn);
sm+=dn;
//printf("p>0\n");
}
}
/* standardize */
gsl_vector_scale( v_p, 1.0/sm );
// pvec(p);
/* take draw */
st = (int)ran_multinomial( v_p, i_K-1 );
vset_int(vi_S,i,st);
vset_int(vi_cnt,st,1);
(vi_n->data[st])++;
}
/* find number of clusters with at least one observation assigned to it */
ism=0;
for(j=0;j<i_K;j++){
if( vget_int(vi_cnt,j) == 1)ism++;
}
ptr_DPMHC_data->i_m = ism;
gsl_vector_free (v_p);
gsl_vector_int_free (vi_cnt);
return 0;
}
WrappedVectorInt::~WrappedVectorInt()
{
if (signal) gsl_vector_int_free (signal);
}
int main(int argc, char *argv[])
{
extern long n_masks, n_bbox, n_superpix, n_bbox, bbox_iter;
extern superpixnum_struct *mask_struct;
extern bbox_struct *bbox;
extern int superpix_resolution;
extern gsl_rng *mt19937_rand;
double LAM, ETA,dLAM,mag,LAMMIN,ETAMAX,LAMMAX,ETAMIN;
double ra, dec, temp_lam, temp_eta, temp_r, temp_abs_r, temp_z, temp_type;
double temp_covar_zz, temp_covar_tz, temp_covar_tt, temp_prob;
double tmp_lammin, tmp_lammax, tmp_etamin, tmp_etamax;
double upper_mag, lower_mag, prob,LAM_length,ETA_length;
double z_min, z_max, z_length, z, temp_u, temp_g, temp_i;
double temp_redshift, temp_redshifterr, temp_red, max_seg, x, y;
double lammin, lammax, etamin, etamax;
long run, col, fld, id, bit, i, j, k, c, not_masked, nkeep, n;
gsl_vector_int *stripe_array, *mask_resolution_array;
gsl_vector_ulong *mask_pixnum_array, *mask_superpixnum_array;
long idum1, idum2, southern_stripe, n_stripe, pixnum;
long bbox_finder, n_masks_old, jlo, ilo, stripe_iter;
int resolution;
gsl_vector_char *output_type;
FILE *MaskFile;
assign_parameters();
superpix_resolution = 4;
if (argc < 2) {
fprintf(stderr,"example usage:\n");
fprintf(stderr," ./filter maskfile < radec_file > output\n");
fprintf(stderr," cat radec_file | ./filter maskfile > output\n");
fprintf(stderr,"radec_file should be columns of ra dec\n");
fprintf(stderr,"only rows that pass the mask are output\n");
fprintf(stderr,"output columns are ra dec\n");
exit(1);
}
MaskFile = fopen(argv[1],"r");
n_masks = 0;
while ((c = getc(MaskFile)) != EOF) {
if (c == '\n') n_masks++;
}
rewind(MaskFile);
n_stripe = 0;
bbox_finder = 1;
n_masks_old = n_masks;
while ((bbox_finder == 1) && (n_stripe < n_masks_old)) {
fscanf(MaskFile,"%ld %i\n", &pixnum, &resolution);
if (resolution < 0) {
n_stripe++;
n_masks--;
} else {
bbox_finder = 0;
}
}
rewind(MaskFile);
stripe_array = gsl_vector_int_alloc(n_stripe);
for (i=0;i<n_stripe;i++)
fscanf(MaskFile,"%i %i\n",&stripe_array->data[i],&resolution);
gsl_sort_vector_int(stripe_array);
n_bbox = 1;
for (i=1;i<n_stripe;i++) {
if ((stripe_array->data[i] < 50) || (stripe_array->data[i-1] < 50)) {
if (stripe_array->data[i] > stripe_array->data[i-1]+1) n_bbox++;
}
}
if (!(bbox=malloc(n_bbox*sizeof(bbox_struct)))) {
fprintf(stderr,"Couldn't allocate bbox_struct memory...\n");
exit(1);
}
fprintf(stderr,"Found %ld bounding regions...\n",n_bbox);
for (i=0;i<n_bbox;i++) bbox[i].n_stripe = 1;
j = 0;
for (i=1;i<n_stripe;i++) {
if ((stripe_array->data[i] < 50) || (stripe_array->data[i-1] < 50)) {
if (stripe_array->data[i] == stripe_array->data[i-1]+1) {
bbox[j].n_stripe++;
} else {
j++;
}
} else {
bbox[j].n_stripe++;
}
}
for (i=0;i<n_bbox;i++) {
if (!(bbox[i].stripe_bound=
malloc(bbox[i].n_stripe*sizeof(stripe_struct)))) {
fprintf(stderr,"Couldn't allocate stripe_struct memory...\n");
exit(1);
}
bbox[i].n_obj = bbox[i].n_keep = 0;
}
j = k = 0;
bbox[0].stripe_bound[0].stripe = stripe_array->data[0];
for (i=1;i<n_stripe;i++) {
if ((stripe_array->data[i] < 50) || (stripe_array->data[i-1] < 50)) {
if (stripe_array->data[i] == stripe_array->data[i-1]+1) {
k++;
bbox[j].stripe_bound[k].stripe = stripe_array->data[i];
} else {
j++;
k = 0;
bbox[j].stripe_bound[k].stripe = stripe_array->data[i];
}
} else {
k++;
bbox[j].stripe_bound[k].stripe = stripe_array->data[i];
}
}
for (i=0;i<n_bbox;i++) {
fprintf(stderr,"BBOX %ld:\n\t",i+1);
primary_bound(bbox[i].stripe_bound[0].stripe,
&lammin,&lammax,&etamin,&etamax);
bbox[i].stripe_bound[0].lammin = lammin;
bbox[i].stripe_bound[0].lammax = lammax;
bbox[i].stripe_bound[0].etamin = etamin;
bbox[i].stripe_bound[0].etamax = etamax;
bbox[i].lammin = lammin;
bbox[i].lammax = lammax;
bbox[i].etamin = etamin;
bbox[i].etamax = etamax;
for (j=0;j<bbox[i].n_stripe;j++) {
fprintf(stderr,"%i ",bbox[i].stripe_bound[j].stripe);
primary_bound(bbox[i].stripe_bound[j].stripe,
&lammin,&lammax,&etamin,&etamax);
bbox[i].stripe_bound[j].lammin = lammin;
bbox[i].stripe_bound[j].lammax = lammax;
bbox[i].stripe_bound[j].etamin = etamin;
bbox[i].stripe_bound[j].etamax = etamax;
if (lammax > bbox[i].lammax) bbox[i].lammax = lammax;
if (lammin < bbox[i].lammin) bbox[i].lammin = lammin;
if (etamax > bbox[i].etamax) bbox[i].etamax = etamax;
if (etamin < bbox[i].etamin) bbox[i].etamin = etamin;
}
fprintf(stderr,"\n");
}
fprintf(stderr,"There are %ld masks\n",n_masks);
mask_pixnum_array = gsl_vector_ulong_alloc(n_masks);
mask_resolution_array = gsl_vector_int_alloc(n_masks);
for (i=0;i<n_masks;i++)
fscanf(MaskFile,"%lu %i\n",&mask_pixnum_array->data[i],
&mask_resolution_array->data[i]);
fclose(MaskFile);
n_superpix = find_n_superpix(superpix_resolution, mask_pixnum_array,
mask_resolution_array, n_masks);
if (!(mask_struct=malloc(n_superpix*sizeof(superpixnum_struct)))) {
fprintf(stderr,"Couldn't allocate superpixnum_struct memory...\n");
exit(1);
}
mask_superpixnum_array = gsl_vector_ulong_alloc(n_superpix);
make_superpix_struct(superpix_resolution,mask_pixnum_array,
mask_resolution_array,n_masks,mask_struct,n_superpix);
for (i=0;i<n_superpix;i++)
mask_superpixnum_array->data[i] = mask_struct[i].superpixnum;
gsl_vector_ulong_free(mask_pixnum_array);
gsl_vector_int_free(mask_resolution_array);
nkeep = 0;
while (2==fscanf(stdin,"%lf %lf\n",&ra,&dec)) {
eq2csurvey(ra, dec, &temp_lam, &temp_eta);
not_masked = 0;
bbox_iter = -1;
stripe_iter = -1;
for (j=0;j<n_bbox;j++) {
if ((temp_lam <= bbox[j].lammax) &&
(temp_lam >= bbox[j].lammin) &&
(temp_eta <= bbox[j].etamax) &&
(temp_eta >= bbox[j].etamin)) {
bbox_iter = j;
j = n_bbox;
}
}
if (bbox_iter >= 0) {
bbox[bbox_iter].n_obj++;
for (k=0;k<bbox[bbox_iter].n_stripe;k++) {
if ((temp_eta <= bbox[bbox_iter].stripe_bound[k].etamax) &&
(temp_eta >= bbox[bbox_iter].stripe_bound[k].etamin)) {
stripe_iter = k;
k = bbox[bbox_iter].n_stripe;
}
}
if (stripe_iter >= 0) {
if ((temp_lam <=
bbox[bbox_iter].stripe_bound[stripe_iter].lammax) &&
(temp_lam >= bbox[bbox_iter].stripe_bound[stripe_iter].lammin))
not_masked = 1;
}
}
if (not_masked == 1) {
ang2pix(superpix_resolution,temp_lam,temp_eta,&pixnum);
lhunt(mask_superpixnum_array,pixnum,&jlo);
if (jlo <= n_superpix-1) {
if (pixnum == mask_superpixnum_array->data[jlo]) {
for (k=0;k<mask_struct[jlo].n_res;k++) {
ang2pix(mask_struct[jlo].res_struct[k].resolution,
temp_lam,temp_eta,&pixnum);
if (mask_struct[jlo].res_struct[k].n_pixel == 1) {
ilo = 0;
} else {
lhunt(mask_struct[jlo].res_struct[k].pixnum,pixnum,&ilo);
}
if (ilo < mask_struct[jlo].res_struct[k].n_pixel) {
if (mask_struct[jlo].res_struct[k].pixnum->data[ilo] ==
pixnum) not_masked = 0;
}
}
}
}
}
if (not_masked == 1) {
bbox[bbox_iter].n_keep++;
printf("%.16g %.16g\n", ra, dec);
nkeep++;
}
}
fprintf(stderr,"Kept %ld points\n",nkeep);
return 0;
}
/** **************************************************************************************************************/
void build_designmatrix_gaus_rv(network *dag,datamatrix *obsdata, double priormean, double priorsd,const double priorgamshape, const double priorgamscale,datamatrix *designmatrix, int nodeid, int storeModes)
{
int i,j,k;
int numparents=0;
gsl_vector_int *parentindexes=0;
int num_unq_grps=0;
int *groupcnts;
int *curindex;
gsl_matrix **array_of_designs;
gsl_vector **array_of_Y;
if(dag->maxparents>0){
parentindexes=gsl_vector_int_alloc(dag->maxparents);
/** collect parents of this node **/
for(j=0;j<dag->numNodes;j++){
if( dag->defn[nodeid][j]==1 /** got a parent so get its index **/
&& numparents<dag->maxparents /** if numparents==dag->maxparents then we are done **/
){
gsl_vector_int_set(parentindexes,numparents++,j);/** store index of parent **/
}
}
} /** check for maxparent=0 */
/** this part is new and just for posterior param est - it does not affect Laplace approx in any way****/
/** setup matrix where each non DBL_MAX entry in a row is for a parameter to be estimated and the col is which param
first col is for the intercept */
if(storeModes){
for(k=0;k<dag->numNodes+3;k++){gsl_matrix_set(dag->modes,nodeid,k,DBL_MAX);} /** initialise row to DBL_MAX n.b. +2 here is need in fitabn.R part**/
gsl_matrix_set(dag->modes,nodeid,0,1);/** the intercept term - always have an intercept - but not in dag.m definition */
for(k=0;k<numparents;k++){gsl_matrix_set(dag->modes,nodeid,gsl_vector_int_get(parentindexes,k)+1,1);} /** offset is 1 due to intercept */
gsl_matrix_set(dag->modes,nodeid,dag->numNodes+1,1);/** the residual precision **/
gsl_matrix_set(dag->modes,nodeid,dag->numNodes+2,1);/** the group level precision term put at end of other params */
}
/** ****************************************************************************************************/
designmatrix->datamatrix=gsl_matrix_alloc(obsdata->numDataPts,numparents+1+1);/** +1=intercept +1=rv_precision - note this is just for the mean so no extra term for gaussian node **/
designmatrix->Y=gsl_vector_alloc(obsdata->numDataPts);
designmatrix->priormean=gsl_vector_alloc(numparents+1);
designmatrix->priorsd=gsl_vector_alloc(numparents+1);
designmatrix->priorgamshape=gsl_vector_alloc(1); /** only 1 of these per node - NOTE: use same prior for group precision and overall precision */
designmatrix->priorgamscale=gsl_vector_alloc(1); /** only 1 of these per node - NOTE: use same prior for group precision and overall precision */
designmatrix->datamatrix_noRV=gsl_matrix_alloc(obsdata->numDataPts,numparents+1);/** drop the last col - used for initial value estimation only**/
/** create design matrix - ALL DATA POINTS - copy relevant cols from the observed data **/
/** int** designmatrix is just used as storage space, fill up from left cols across until as far as needed */
for(i=0;i<obsdata->numDataPts;i++){/** for each observed data point **/
gsl_matrix_set(designmatrix->datamatrix,i,0,1.0); /** set first column - intercept - to 1's **/
gsl_matrix_set(designmatrix->datamatrix_noRV,i,0,1.0);/** build matrix same as datamatrix just without the last col (which contains 1's for epsilon rv term */
gsl_matrix_set(designmatrix->datamatrix,i,(designmatrix->datamatrix)->size2-1,1.0);/** set last column - rv precision to 1.0 **/
gsl_vector_set(designmatrix->Y,i,obsdata->defn[i][nodeid]);/** copy values at node - response values - into vector Y */
for(k=0;k<numparents;k++){/** now build design matrix of explanatories other than intercept*/
gsl_matrix_set(designmatrix->datamatrix,i,k+1,obsdata->defn[i][gsl_vector_int_get(parentindexes,k)]);
gsl_matrix_set(designmatrix->datamatrix_noRV,i,k+1,obsdata->defn[i][gsl_vector_int_get(parentindexes,k)]);
} /** end of explanatories **/
} /** end of data point loop */
designmatrix->numparams=numparents+1;/** +1 for intercept - excludes precisions **/
/** now set the priormean and priorsd vector */
for(k=0;k<designmatrix->numparams;k++){/** num params does NOT include precision term **/
gsl_vector_set(designmatrix->priormean,k,priormean);
gsl_vector_set(designmatrix->priorsd,k,priorsd);
}
/** set prior for precision **/
gsl_vector_set(designmatrix->priorgamshape,0,priorgamshape);/** prior for precision term */
gsl_vector_set(designmatrix->priorgamscale,0,priorgamscale);/** prior for precision term */
gsl_vector_int_free(parentindexes);/** finished with this **/
/** ***********************************************************************************************************************/
/** ***********************************************************************************************************************/
/** DOWN HERE is splitting the single single design matrix and Y into separate chunks *************************************/
/** we now want to split designmatrix->datamatrix and designmatrix->Y into grouped blocks **/
/** ***********************************************************************************************************************/
/** get number of unique groups - equal to max int since using R factors **/
num_unq_grps=0;for(i=0;i<obsdata->numDataPts;i++){if(obsdata->groupIDs[i]>num_unq_grps){num_unq_grps=obsdata->groupIDs[i];}}
groupcnts=(int *)R_alloc(num_unq_grps,sizeof(int));/** will hold n_j's e.g. counts of how many obs in each group **/
curindex=(int *)R_alloc(num_unq_grps,sizeof(int));
for(i=0;i<num_unq_grps;i++){groupcnts[i]=0;curindex[i]=0;}
for(i=0;i<num_unq_grps;i++){/** for each unique group of data **/
for(j=0;j<obsdata->numDataPts;j++){/** for each observation **/
if( (obsdata->groupIDs[j]-1)==i){groupcnts[i]++;/** increment count **/}
}
}
/** create an array of gsl_matrix where each one is the design matrix for a single group of data **/
array_of_designs=(gsl_matrix **)R_alloc(num_unq_grps,sizeof(gsl_matrix*));/** a list of design matrix, one for each group */
array_of_Y=(gsl_vector **)R_alloc(num_unq_grps,sizeof(gsl_vector*)); /** a list of Y vectors,, one for each group */
for(i=0;i<num_unq_grps;i++){array_of_designs[i]=gsl_matrix_alloc(groupcnts[i],(designmatrix->datamatrix)->size2);
array_of_Y[i]=gsl_vector_alloc(groupcnts[i]);}
/** now loop through group j; for fixed j loop through each record in total design matrix and copying group members into new group design matrix **/
for(j=0;j<num_unq_grps;j++){/** for each group **/
for(i=0;i<obsdata->numDataPts;i++){/** for each data point **/
if( (obsdata->groupIDs[i]-1)==j){/** if current data point is for group j then store **/
for(k=0;k<(designmatrix->datamatrix)->size2;k++){/** for each member of the row in design matrix **/
gsl_matrix_set(array_of_designs[j],curindex[j],k,gsl_matrix_get(designmatrix->datamatrix,i,k));}
gsl_vector_set(array_of_Y[j],curindex[j],gsl_vector_get(designmatrix->Y,i));/** copy relevant Ys for fixed j */
curindex[j]++;
}
}
}
/** uncomment to print out array of design matrices - one for each data group **/
/* Rprintf("no cols=%d\n",array_of_designs[0]->size2);
for(j=0;j<num_unq_grps;j++){Rprintf("-------group %d------\n",j);
for(i=0;i<array_of_designs[j]->size1;i++){
Rprintf("Y=%f\t",gsl_vector_get(array_of_Y[j],i));
for(k=0;k<array_of_designs[j]->size2;k++){
Rprintf("%f ",gsl_matrix_get(array_of_designs[j],i,k));
}
Rprintf("\n");
}
}
*/
/** down to here we now have a split the design matrix and Y up into separate matrices and vectors, one for each observational group */
/** so we can free the previous datamatrix as this is not needed, also the previous Y **/
gsl_matrix_free(designmatrix->datamatrix);
/*gsl_vector_free(designmatrix->Y);*/ /** need to keep y*/
/** copy addresses */
designmatrix->numUnqGrps=num_unq_grps;
designmatrix->array_of_designs=array_of_designs;
designmatrix->array_of_Y=array_of_Y;
}