static gsl_poly_int* mygsl_poly_laguerre(int n)
{
size_t m, k;
int val;
gsl_vector_int *p0;
if (n < 0) rb_raise(rb_eArgError, "order must be >= 0");
p0 = gsl_vector_int_calloc(n + 1);
switch (n) {
case 0:
gsl_vector_int_set(p0, 0, 1);
break;
case 1:
gsl_vector_int_set(p0, 0, 1);
gsl_vector_int_set(p0, 1, -1);
break;
default:
k = gsl_sf_fact(n);
for (m = 0; m <= n; m++) {
val = k*k/gsl_sf_fact(n-m)/gsl_pow_2(gsl_sf_fact(m));
if (m%2 == 1) val *= -1;
gsl_vector_int_set(p0, m, val);
}
break;
}
return p0;
}
static SCM
thit_new_model(SCM s_max_rows, SCM s_bds_disc, SCM s_n_cont, SCM s_dp_weight,
SCM s_init_crosstab, SCM s_lambda_a, SCM s_lambda_b)
{
int max_rows = scm_to_int(s_max_rows);
int n_cont = scm_to_int(s_n_cont);
double dp_weight = scm_to_double(s_dp_weight);
double init_crosstab = scm_to_double(s_init_crosstab);
double lambda_a = scm_to_double(s_lambda_a);
double lambda_b = scm_to_double(s_lambda_b);
int n_disc = scm_to_int(scm_length(s_bds_disc));
gsl_vector_int *bds_disc = gsl_vector_int_alloc(n_disc);
int i, b;
for (i = 0; i < n_disc; i++) {
b = scm_to_int(scm_list_ref(s_bds_disc, scm_from_int(i)));
gsl_vector_int_set(bds_disc, i, b);
}
banmi_model_t *model = new_banmi_model(max_rows, bds_disc, n_cont, dp_weight,
init_crosstab, lambda_a, lambda_b);
SCM smob;
SCM_NEWSMOB(smob, thit_model_tag, model);
return smob;
}
int factorTest(void) {
int i;
gsl_vector_int* f = gsl_vector_int_alloc(3);
if (!f) {
return -1;
}
gsl_vector_int_set(f, 0, 2);
gsl_vector_int_set(f, 1, 4);
gsl_vector_int_set(f, 2, 5);
int n = 3;
int m = factor_size(f);
printf("m:%d\n", m);
int a[3];
int s = 1;
factor_scalar_to_vector(f, s, a);
printf("s:%d\n", s);
for (i = 0; i < n; i++) {
printf("a[%d]:%d\n", i, a[i]);
}
s = factor_vector_to_scalar(f, a);
printf("s:%d\n\n", s);
s = 39;
factor_scalar_to_vector(f, s, a);
printf("s:%d\n", s);
for (i = 0; i < n; i++) {
printf("a[%d]:%d\n", i, a[i]);
}
s = factor_vector_to_scalar(f, a);
printf("s:%d\n\n", s);
s = 25;
factor_scalar_to_vector(f, s, a);
printf("s:%d\n", s);
for (i = 0; i < n; i++) {
printf("a[%d]:%d\n", i, a[i]);
}
s = factor_vector_to_scalar(f, a);
printf("s:%d\n\n", s);
return 0;
}
static VALUE rb_GSL_FFT_Wavetable_factor(VALUE obj)
{
GSL_FFT_Wavetable *table;
gsl_vector_int *v;
size_t i;
Data_Get_Struct(obj, GSL_FFT_Wavetable, table);
v = gsl_vector_int_alloc(table->nf);
for (i = 0; i < table->nf; i++) gsl_vector_int_set(v, i, table->factor[i]);
return Data_Wrap_Struct(cgsl_vector_int, 0, gsl_vector_int_free, v);
}
static gsl_poly_int* mygsl_poly_bessel(int n)
{
size_t k;
gsl_vector_int *p0;
if (n < 0) rb_raise(rb_eArgError, "order must be >= 0");
p0 = gsl_vector_int_calloc(n + 1);
for (k = 0; k <= n; k++) {
gsl_vector_int_set(p0, k, gsl_sf_fact(n+k)/gsl_sf_fact(n-k)/gsl_sf_fact(k)/((int) pow(2, k)));
}
return p0;
}
VALUE rb_gsl_multiset_data(VALUE mm)
{
gsl_multiset *m;
size_t *p;
gsl_vector_int *v;
size_t i;
Data_Get_Struct(mm, gsl_multiset, m);
p = gsl_multiset_data(m);
v = gsl_vector_int_alloc(m->k);
for (i = 0; i < v->size; i++) gsl_vector_int_set(v, i, p[i]);
return Data_Wrap_Struct(cgsl_vector_int, 0, gsl_vector_int_free, v);
}
int main(int argc, char ** argv) {
unsigned int i;
unsigned int ndim;
double exactness;
gsl_vector * start;
if (argc < 2 + 4 * 1) {
usage(argv[0]);
return 1;
}
exactness = atof(argv[1]);
if ((argc - 2) % 4) {
fprintf(stderr, "%s: wrong number of arguments\n", argv[0]);
usage(argv[0]);
}
ndim = (argc - 2) / 4;
round = gsl_vector_int_alloc(ndim);
min = gsl_vector_alloc(ndim);
max = gsl_vector_alloc(ndim);
start = gsl_vector_alloc(ndim);
for (i = 0; i < ndim; i++) {
if (strcmp(argv[2 + i * 4], "i") == 0)
gsl_vector_int_set(round, i, 1);
else if (strcmp(argv[2 + i * 4], "d") == 0)
gsl_vector_int_set(round, i, 0);
else
usage(argv[0]);
gsl_vector_set(min, i, atof(argv[2 + i * 4 + 1]));
gsl_vector_set(max, i, atof(argv[2 + i * 4 + 2]));
gsl_vector_set(start, i, (atof(argv[2 + i * 4 + 3]) - gsl_vector_get(
min, i)) / (gsl_vector_get(max, i) - gsl_vector_get(min, i)));
}
setup_rng();
find_local_maximum(ndim, exactness, start);
fprintf(stderr, "--- best: ---");
print_real_vector(start);
return 0;
}
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;
}
bool RPeaksDetector::hilbertRPeaksDetection(ECGSignalChannel *signal)
{
TRI_LOG_STR(__FUNCTION__);
ECGSignalChannel sig = *signal;
if(sig->signal->size < 1)
{
#ifdef DEBUG
qDebug() << "Input signal size is 0";
#endif
TRI_LOG_STR("Input signal size is 0");
return false;
}
int n = sig->signal->size;
std::vector<double> sygnal(n);
int i = 0;
for ( ; i < n ; ++i)
sygnal[i] = gsl_vector_get (sig->signal, i);
signalAbs(sygnal);
std::vector<int> pozycje;
int czestotliwosc = 360;
hilbertDetection(sygnal, czestotliwosc, pozycje);
IntSignal rs;
rs = IntSignal(new WrappedVectorInt);
n = pozycje.size();
rs->signal = gsl_vector_int_alloc(n);
for (i = 0; i < n; ++i)
gsl_vector_int_set(rs->signal, i, pozycje.at(i));
rsPositions->setRs(rs);
#ifdef DEBUG
qDebug() << "Number of detected R-peaks:" << n;
#endif
rsDetected = true;
LOG_END;
return true;
}
/*
Document-method: <i>GSL::Rng#get</i>
Returns a random integer from the generator.
The minimum and maximum values depend on the algorithm used,
but all integers in the range [min,max] are equally likely.
The values of min and max can determined using the auxiliary
methodss GSL::Rng#max and GSL::Rng#min.
*/
static VALUE rb_gsl_rng_get(int argc, VALUE *argv, VALUE obj)
{
gsl_rng *r = NULL;
gsl_vector_int *v;
size_t n, i;
Data_Get_Struct(obj, gsl_rng, r);
switch (argc) {
case 0:
return UINT2NUM(gsl_rng_get(r));
break;
case 1:
n = NUM2INT(argv[0]);
v = gsl_vector_int_alloc(n);
for (i = 0; i < n; i++) gsl_vector_int_set(v, i, (int) gsl_rng_get(r));
return Data_Wrap_Struct(cgsl_vector_int, 0, gsl_vector_int_free, v);
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments (%d for 0 or 1)", argc);
break;
}
}
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;
}
gsl_vector_int* vector2gsl_int( const vector< int >& v )
{
gsl_vector_int* result = gsl_vector_int_alloc( v.size() );
for ( int i = 0; i < v.size(); i++ ) gsl_vector_int_set( result, i, v[ i ] );
return result;
}
void WrappedVectorInt::set(size_t it, int value)
{
gsl_vector_int_set(signal, it, value);
}
bool RPeaksDetector::panTompkinsRPeaksDetection(ECGSignalChannel *signal)
{
TRI_LOG_STR(__FUNCTION__);
ECGSignalChannel sig;
sig = *signal;
int sigSize = 0;
if(sig->signal->size < 1)
{
#ifdef DEBUG
qDebug() << "Input signal size is 0";
#endif
TRI_LOG_STR("Input signal size is 0");
return false;
}
else
{
sigSize = sig->signal->size;
#ifdef DEBUG_SIGNAL
qDebug() << "Input signal";
for(int i = 0; i < sigSize; i++)
{
double inputValue = gsl_vector_get (sig->signal, i);
qDebug() << inputValue;
}
#endif
}
//Convolution [-0.125 -0.25 0.25 0.125] (Here we lose 4 signal samples)
#ifdef DEBUG
qDebug() << "Convolution [-0.125 -0.25 0.25 0.125]" << endl << "Orginal signal size: " << sigSize;
#endif
int newSigSize = 0;
ECGSignalChannel diffSig;
diffSig = ECGSignalChannel(new WrappedVector);
diffSig->signal = gsl_vector_alloc(sigSize);
double filter[] = {-0.125, -0.25, 0.25, 0.125};
int filterSize = 4;
for(int i = 0; i < sigSize - filterSize; i++)
{
double tmpSum = 0;
for(int j = 0; j < filterSize; j++)
{
double inputValue = gsl_vector_get (sig->signal, i + j);
tmpSum += inputValue * filter[j];
#ifdef DEBUG_SIGNAL_DETAILS
qDebug() << "Signal: " << inputValue << " Filter: " << filter[j] << " Sum: " << tmpSum;
#endif
}
#ifdef DEBUG_SIGNAL
qDebug() << "Final val: " << tmpSum << " at index: " << i;
#endif
gsl_vector_set(diffSig->signal, i, tmpSum);
newSigSize++;
}
//Exponentiation
sigSize = newSigSize;
#ifdef DEBUG
qDebug() << "Exponentiation ^2" << endl << "Signal size after convolution: " << sigSize;
#endif
ECGSignalChannel powSig;
powSig = ECGSignalChannel(new WrappedVector);
powSig->signal = gsl_vector_alloc(sigSize);
for(int i = 0; i < sigSize; i++)
{
double inputValue = gsl_vector_get (diffSig->signal, i);
double powVal = pow(inputValue, 2);
gsl_vector_set(powSig->signal, i, powVal);
#ifdef DEBUG_SIGNAL
qDebug() << " Pow: "<< powVal << " at index: " << i;
#endif
}
//Calculae moving window lenght or use custom value
// N=30 for f=200Hz - from literature
// N=24 for f=360Hz - from literature and tests
// Linear function for calculating window lenght
// wl = -0.0375 * fs + 37.5
if(panTompkinsMovinghWindowLenght == 0)
{
panTompkinsMovinghWindowLenght = -0.0375 * signalFrequency + 37.5;
}
//Moving window integration (Here we lose "movinghWindowLenght" signal samples)
#ifdef DEBUG
qDebug() << "Moving window integration" << endl << "Window size: " << panTompkinsMovinghWindowLenght << endl
<< "Signal size after exponentiation: " << sigSize;
#endif
ECGSignalChannel integrSig;
integrSig = ECGSignalChannel(new WrappedVector);
integrSig->signal = gsl_vector_alloc(sigSize);
newSigSize = 0;
int movinghWindowLenght = panTompkinsMovinghWindowLenght;
double tmpSum = 0;
for(int i = movinghWindowLenght; i < sigSize; i++)
{
for(int j = movinghWindowLenght - 1; j >= 0 ; j--)
{
double inputValue = gsl_vector_get (powSig->signal, i - j);
tmpSum += inputValue;
#ifdef DEBUG_SIGNAL_DETAILS
qDebug() << "Signal: " << inputValue << " Sum: " << tmpSum;
#endif
}
int index = i - movinghWindowLenght;
// TODO Why this is not working? (To small values and all are save as zero)
//double mwico = (1/movinghWindowLenght) * tmpSum;
double mwico = tmpSum;
#ifdef DEBUG_SIGNAL
qDebug() << "Final val: " << mwico << " at index: " << index;
#endif
gsl_vector_set(integrSig->signal, index, mwico);
tmpSum = 0;
newSigSize++;
}
//Calculating detection threshold
//TODO (Not important now) Try to find another way to calcutale threshold position, maybe dynamic threshold?
sigSize = newSigSize;
#ifdef DEBUG
qDebug() << "Calculating detection threshold" << endl << "After moving window integration signal size: " << sigSize;
#endif
double sigMaxVal = 0;
double meanVal = 0;
for(int i = 0; i < sigSize; i++)
{
double inputValue = gsl_vector_get (integrSig->signal, i);
if(inputValue > sigMaxVal)
{
sigMaxVal = inputValue;
#ifdef DEBUG_SIGNAL
qDebug() << "New max signal value: " << inputValue;
#endif
}
meanVal += inputValue;
}
meanVal = meanVal / sigSize;
#ifdef DEBUG
qDebug() << "Final max value for channel one: " << sigMaxVal << endl
<< "Final mean value: " << meanVal << endl;
#endif
// Select automatic or manual thersold
double threshold = 0;
if( this->panTompkinsThershold == 0)
{
threshold = meanVal + (sigMaxVal * 0.04);
}
else
{
threshold = this->panTompkinsThershold;
}
//Looking for points over thersold
#ifdef DEBUG
qDebug() << "Current thresold value: " << threshold << endl << "Looking for points over thersold";
#endif
ECGSignalChannel overThersold;
overThersold = ECGSignalChannel(new WrappedVector);
overThersold->signal = gsl_vector_alloc(sigSize);
for(int i = 0; i < sigSize; i++)
{
double inputValue = gsl_vector_get (integrSig->signal, i);
if(inputValue > threshold * sigMaxVal)
{
gsl_vector_set(overThersold->signal, i, 1);
#ifdef DEBUG_SIGNAL
qDebug() << "Value over thersold at index: " << i;
#endif
}
else
{
gsl_vector_set(overThersold->signal, i, 0);
}
}
#ifdef DEBUG_SIGNAL
qDebug() << "Signal with points over thersold";
for(int i = 0; i < sigSize; i++)
{
qDebug() << gsl_vector_get(overThersold->signal, i);
}
#endif
#ifdef DEBUG
qDebug() << "Detect begin and end of QRS complex";
#endif
ECGSignalChannel leftPoints;
ECGSignalChannel tmpRightPoints;
leftPoints = ECGSignalChannel(new WrappedVector);
tmpRightPoints = ECGSignalChannel(new WrappedVector);
leftPoints->signal = gsl_vector_alloc(sigSize);
tmpRightPoints->signal = gsl_vector_alloc(sigSize);
int leftPointsCount = 0;
int rightPointsCount = 0;
gsl_vector* copiedSig = gsl_vector_calloc(sigSize);
gsl_vector_memcpy(copiedSig, overThersold->signal);
// Boundary values
if(gsl_vector_get (copiedSig, 0) == 1)
{
gsl_vector_set(leftPoints->signal, leftPointsCount, 0);
leftPointsCount++;
#ifdef DEBUG_SIGNAL
qDebug() << "QRS complex left point at index: " << 0;
#endif
}
if(gsl_vector_get (copiedSig, sigSize - 1) == 1)
{
gsl_vector_set(tmpRightPoints->signal, rightPointsCount, sigSize - 1);
rightPointsCount++;
#ifdef DEBUG_SIGNAL
qDebug() << "QRS complex right point at index: " << sigSize - 1;
#endif
}
// Left points of QRS complex
for(int i = 0; i < sigSize - 1; i++)
{
double inputValue = gsl_vector_get (copiedSig, i);
double inputValueIndexPlus = gsl_vector_get (copiedSig, i + 1);
if((inputValueIndexPlus - inputValue) == 1)
{
gsl_vector_set(leftPoints->signal, leftPointsCount, i);
leftPointsCount++;
#ifdef DEBUG_SIGNAL
qDebug() << "QRS complex left point at index: " << i;
#endif
}
}
// Rights points of QRS complex
for(int i = sigSize - 1; i > 0; i--)
{
double reversedInput = gsl_vector_get(copiedSig, i);
double reversedInputIndexMinus = gsl_vector_get (copiedSig, i - 1);
if((reversedInputIndexMinus - reversedInput) == 1)
{
gsl_vector_set(tmpRightPoints->signal, rightPointsCount, i);
rightPointsCount++;
#ifdef DEBUG_SIGNAL
qDebug() << "QRS complex right at index: " << i;
#endif
}
}
#ifdef DEBUG_SIGNAL
cout << "Vector with left points:" << endl;
for(int i = 0; i < leftPointsCount; i++)
{
qDebug() << gsl_vector_get(leftPoints->signal, i);
}
qDebug() << endl << "Vector with right points:";
for(int i = 0; i < rightPointsCount; i++)
{
qDebug() << gsl_vector_get(tmpRightPoints->signal, i);
}
cout << endl;
#endif
// Invert vector with rightPoints
ECGSignalChannel rightPoints;
rightPoints = ECGSignalChannel(new WrappedVector);
rightPoints->signal = gsl_vector_alloc(sigSize);
for(int i = 0; i < rightPointsCount; i++)
{
double tmp = gsl_vector_get(tmpRightPoints->signal, rightPointsCount - i - 1);
gsl_vector_set(rightPoints->signal, i, tmp );
}
for(int i = 0; i < rightPointsCount; i++)
{
double tmp = gsl_vector_get(tmpRightPoints->signal, rightPointsCount - i - 1);
gsl_vector_set(rightPoints->signal, i, tmp );
}
#ifdef DEBUG_SIGNAL
qDebug() << "After vector invertion" << endl;
qDebug() << "Vector with left points:" << endl;
for(int i = 0; i < leftPointsCount; i++)
{
qDebug() << gsl_vector_get(leftPoints->signal, i);
}
qDebug() << endl << "Vector with right points:" << endl;
for(int i = 0; i < rightPointsCount; i++)
{
qDebug() << gsl_vector_get(rightPoints->signal, i);
}
#endif
#ifdef DEBUG
qDebug() << "Number of left points: " << leftPointsCount << endl
<< "Number of right points: " << rightPointsCount;
#endif
//Final R peaks detection
#ifdef DEBUG
qDebug() << "Final R peaks detection";
#endif
int partLength;
IntSignal rs;
int numberRs = 0;
if(leftPointsCount > 0 )
{
rs = IntSignal(new WrappedVectorInt);
rs->signal = gsl_vector_int_alloc(leftPointsCount);
for(int i = 0; i < leftPointsCount; i++)
{
partLength = gsl_vector_get (rightPoints->signal, i) - gsl_vector_get(leftPoints->signal, i);
double tmpMax = 0;
int tmpMaxIndex = 0;
for(int j = 0; j < partLength; j++)
{
int sigIndex = gsl_vector_get (leftPoints->signal, i) + j;
double sigVal = gsl_vector_get(sig->signal, sigIndex);
if(sigVal > tmpMax)
{
tmpMax = sigVal;
tmpMaxIndex = sigIndex;
}
}
gsl_vector_int_set(rs->signal, i, tmpMaxIndex);
numberRs++;
#ifdef DEBUG_SIGNAL
qDebug() << "R point at index: " << tmpMaxIndex
<< " signal value: " << gsl_vector_get(sig->signal, tmpMaxIndex);
#endif
}
rsPositions->setRs(rs);
#ifdef DEBUG
qDebug() << "Number of detected R-peaks:" << numberRs;
#endif
}
else
{
#ifdef DEBUG
qDebug() << "R peaks not detected. Check input signal.";
#endif
TRI_LOG_STR("R peaks not detected. Check input signal.");
return false;
}
gsl_vector_free(copiedSig);
rsDetected = true;
#ifdef DEBUG
qDebug() << "Done";
#endif
LOG_END;
return true;
}
/**
* The function analyzes the fluximages in a
* fluxcube structure and sorts their indices in
* ascending wavelength. The vector with the
* ordered indices is given back.
*
* @param fcube - the pointer to the fluxcube structure
*
*/
gsl_vector_int *
order_fluxims(flux_cube *fcube)
{
gsl_vector *fimage_wavelength;
gsl_vector_int *fimage_order;
int i, j, k;
// allocate space for the order vector
fimage_order = gsl_vector_int_alloc(fcube->n_fimage);
// put a default order in the vector
for (i=0; i<fcube->n_fimage; i++)
gsl_vector_int_set(fimage_order, i, i);
// order the wavelength
if (fcube->n_fimage > 1)
{
// create a vector for the wavelengths
fimage_wavelength = gsl_vector_alloc(fcube->n_fimage);
// set the first entry for the wavelength
gsl_vector_set(fimage_wavelength, 0, fcube->fluxims[0]->wavelength);
// go over all fluximages
for (i=1; i<fcube->n_fimage; i++)
{
// find the correct position of the fluximage
j=0;
while (j < i && gsl_vector_get(fimage_wavelength, j) <= fcube->fluxims[i]->wavelength)
j++;
// check whether the correct poition of the fluximage is at the end
if (j == i)
{
// append the fluximage at the end
gsl_vector_set(fimage_wavelength, j, fcube->fluxims[i]->wavelength);
gsl_vector_int_set(fimage_order, j, i);
}
else
{
// move all fluximages one index up
for (k=i; k > j; k--)
{
gsl_vector_set(fimage_wavelength, k, gsl_vector_get(fimage_wavelength, k-1));
gsl_vector_int_set(fimage_order, k, gsl_vector_int_get(fimage_order, k-1));
}
// place the flux image at the correct position
gsl_vector_set(fimage_wavelength, j, fcube->fluxims[i]->wavelength);
gsl_vector_int_set(fimage_order, j, i);
}
}
// release the space for the wavelength vector
gsl_vector_free(fimage_wavelength);
}
// return the order vector
return fimage_order;
}
/** **************************************************************************************************************/
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;
}